The Supermarket Pricing Kata in Haskell

Tom Moertel — Fri, 28 Apr 2006 16:30:00 -0400

At last night’s meeting of the Pittsburgh Coding Dojo, we worked on the Supermarket Pricing Kata. This particular kata was intended to be food for thought – a “shower kata” – but our goal was to do some coding, so we made the problem more concrete:

Come up with a sensible way to represent common supermarket pricing rules such as “buy one, get one free,” “three for a dollar,” ”$0.34 per ounce,” and so on
Implement a method to check out a shopping cart full of goods, applying all applicable pricing rules, and computing the total price for the cart’s contents

Most people paired up, but I worked alone because I wasn’t ready to code right away. (Laptop issues.) At the end of the meeting, nobody had a working solution. (I guess it was a shower kata for a reason.) I had a partial solution, but I didn’t like my internal representation of prices because it conflated goods and their pricing rules.

Over lunch today I came up with a more sensible representation and finished off my implementation. Now I’m happy with it.

The code

Here’s my solution. I stripped the comments to emphasize the code itself (a forest and trees thing). If you want to see the comments, see the unstripped source.

{-
   My solution to "The Supermarket Pricing Kata" 
   http://blogs.pragprog.com/cgi-bin/pragdave.cgi/Practices/Kata/KataOne.rdoc

   Tom Moertel <tom@moertel.com>
   2006-04-27
-}

module SupermarketPricing where

import Control.Arrow ((&&&))
import Data.List (groupBy, sort)
import Test.HUnit

type Portion  = Double      
type Count    = Portion     
type Price    = Double      
type Name     = String      

data PricingRule
    = Per Portion Price     
    | For Count Price Price 
  deriving (Eq, Ord, Read, Show)

data Good
    = G { name :: Name, quantity :: !Portion, rule :: PricingRule }
  deriving (Eq, Ord, Read, Show)

per nm y x p  = G nm y (Per x p)     
each nm p     = G nm 1 (For 1 p p)   
for nm n p    = G nm 1 (For n p p)   
bogo          = flip bngo 1          
btgo          = flip bngo 2          
bngo nm n p   = G nm 1 (For n' np p) 
                where (n', np) = (n + 1, p * n)

checkout :: [Good] -> Price
checkout =
    checkoutBy $ sum . map price

subtotal :: [Good] -> [((Portion, Name), Price)]
subtotal =
    checkoutBy $ map ((quantity &&& name) &&& price)

checkoutBy :: ([Good] -> a) -> [Good] -> a
checkoutBy f =
    f . map (foldl1 combine) . groupByName . sort
  where
    groupByName = groupBy (\g1 g2 -> name g1 == name g2)

price :: Good -> Price
price (G nm y (Per x p))    =  y * p / x
price (G nm m (For n p p2)) = (m - r) * p / n + r * p2
  where
    r = fromIntegral $ round m `rem` round n

combine :: Good -> Good -> Good
combine g1@(G nm x rule) g2@(G nm2 x2 rule2)
    | nm /= nm2 || rule /= rule2
    = error $ "can't combine incompatible goods " ++ show [g1, g2]
    | otherwise
    = G nm (x + x2) rule

Read on for an explanation of the code and my unit tests.

What’s going on in there

Pricing rules are represented by the PricingRule data type, which has two forms. The Per form is used to price continuous goods (like bulk oats) at a rate of x portions per price p. The For form is used to price discrete goods, m goods for price p, with the remaining goods priced at p2 each. This form handles “x-each,” “three-for-a-dollar,” and “buy-one-get-one-free” pricing styles.

To simplify use of the pricing rules, I defined a small collection of helpers to construct goods: per, each, for, bogo, btgo, bngo. (The last two are buy-two-get-one and buy-n-get-one.) Each takes a good’s name as its first parameter and then takes the appropriate price parameters. The result is a newly constructed Good.

The main function of interest is checkout, which takes a list of goods and then computes its checkout price. A variant of checkout is subtotal, which computes the subtotals for each kind of item. Both of these are specializations of the generalized checkout function checkoutBy, which collects the goods into like-kinded groups, combines each group into a representative composite good, and then calls the provided checkout-rule function f to price the list of composite goods. One definition of f gives checkout; another gives subtotal.

Goods are priced using the price function, which applies a good’s pricing rule to the good’s quantity. My version of price interprets the rules strictly. You must purchase three of the same good, for example, to earn a discount on a buy-two-get-one-free rule. (A more generous person could define a lenientPrice function to interpret the rules more charitably.)

Finally, the combine function takes two goods of the same kind and returns an equivalent composite good. (It is an error to combine goods of different kinds.) For instance, if you combine 1.5 portions of oats with 0.5 portions of oats, you will get back 2.0 portions of oats.

And that’s all there is to it.

Unit tests

These are my unit tests:

{-
                      *** Unit tests ***

             *SupermarketPricing> runTestTT tests
             Cases: 16  Tried: 16  Errors: 0  Failures: 0
-}

tests = test
    [ {- Checkout tests -}

   -- test name               computed result           expected

      "1x e99"             ~: corep 1 e99           ~?=   0.99
    , "2x e99"             ~: corep 2 e99           ~?=   1.98
    , "e99 e100"           ~: co [e99, e100]        ~?=   1.99
    , "1x bogo99"          ~: corep 1 b99           ~?=   0.99
    , "2x bogo99"          ~: corep 2 b99           ~?=   0.99
    , "3x bogo99"          ~: corep 3 b99           ~?=   1.98
    , "2x bogo99, split"   ~: co [b99, e100, b99]   ~?=   1.99
    , "1x btgo33"          ~: corep 1 t33           ~?=   0.33
    , "2x btgo33"          ~: corep 2 t33           ~?=   0.66
    , "3x btgo33"          ~: corep 3 t33           ~?=   0.66
    , "4x btgo33"          ~: corep 4 t33           ~?=   0.99
    , "1.0 bulk"           ~: co [bulk 1]           ~?=   1.00
    , "1.5 bulk"           ~: co [bulk 1.5]         ~?=   1.50
    , "1.0 + 1.5 bulk"     ~: co [bulk 1, bulk 1.5] ~?=   2.50

      {- Subtotal tests -}

    , "sub(e99, 1.5 oats)" ~: subtotal [e99, bulk 1.5]
                                 ~?= [ ((1.0, "e99"),  0.99)
                                     , ((1.5, "oats"), 1.50) ]
    , "sub(1 oats, e99, 1.5 oats)"
                           ~: subtotal [bulk 1, e99, bulk 1.5]
                                 ~?= [ ((1.0, "e99"),  0.99)
                                     , ((2.5, "oats"), 2.50) ]
    ]
  where

    -- shorthand defs for functions used commonly in testing

    co       = checkout
    rep      = replicate
    corep n  = co . rep n

    -- goods used in testing

    e99      = each "e99" 0.99      
    e100     = each "e100" 1.00     
    b99      = bogo "bogo99" 0.99   
    t33      = btgo "btgo33" 0.33   
    bulk x   = per "oats" x 1 1.00

Tom Moertel's Weblog: Tag supermarket

The Supermarket Pricing Kata in Haskell

The code

What’s going on in there

Unit tests