2
votes

I'm writing a program to allocate pizzas to people; each person will get one pizza, ideally of their favorite type, unless stock has run out, in which case they are given their next favorite type recursively.

My approach is to compute a ((User, Pizza), Int) for the amount a person would like said pizza, sort those, and recurse through using a state monad to keep inventory counts.

The program is written and type checks:

allocatePizzasImpl :: [((User, Pizza), Int)] 
                   -> State [(Pizza, Int)] [(User, Pizza)]
allocatePizzasImpl [] = return []
allocatePizzasImpl ((user, (flavor, _)):ranks) =
    do inventory <- get
       -- this line is never hit
       put $ updateWith inventory (\i -> if i <= 0
                                         then Nothing
                                         else Just $ i - 1) flavor
       next <- allocatePizzasImpl $ filter ((/= user) . fst) ranks
       return $ (user, flavor) : next

and I have a helper function to extract the result:

allocatePizzas :: [Pizza] 
               -> [((User, Pizza), Int)] 
               -> [(User, Pizza)]
allocatePizzas pizzas rank = fst 
                           . runState (allocatePizzasImpl rank) 
                           $ buildQuotas pizzas

but the line indicated by -- this line is never hit is... never hit by any GHCI breakpoints; furthermore, if I break on the return call, GHCI says inventory isn't in scope.

When run, the result is assigning the same pizza (with one inventory count) to all users. Something is going wrong, but I have absolutely no idea how to proceed. I'm new to Haskell, so any comments on style would be appreciated as well =)

Thanks!

PS: For completeness, updateWith is defined as:

updateWith :: (Eq a, Eq b) 
           => [(a, b)]        -- inventory
           -> (b -> Maybe b)  -- update function; Nothing removes it
           -> a               -- key to update
           -> [(a, b)]
updateWith set update key =
    case lookup key set of
      Just b -> replace set
                        (unwrapPair (key, update b))
                        (fromMaybe 0 $ elemIndex (key, b) set)
      Nothing -> set
  where replace :: [a] -> Maybe a -> Int -> [a]
        replace [] _ _ = []
        replace (_:xs) (Just val) 0 = val:xs
        replace (_:xs) Nothing 0 = xs
        replace (x:xs) val i = x : (replace xs val $ i - 1)

        unwrapPair :: Monad m => (a, m b) -> m (a, b)
        unwrapPair (a, mb) = do b <- mb
                                return (a, b)
2
Can you include the definition for buildQuotas? Or preferably you could reduce your code to a MCVE.bheklilr
Also, allocatePizzasImpl doesn't typecheck (trying to match (flavor, _) pattern with type Int).András Kovács

2 Answers

1
votes

I think your function replace is broken:

replace (_:xs) (Just val) 0 = val:xs

This doesn't pay any attention to the value it's replacing. Wasn't your intention to replace just the pair corresponding to key?

I think you want

updateWith [] e k = []
updateWith ((k', v):kvs) e k
    | k' == k = case e v of
        Just v' -> (k, v'):kvs
        Nothing -> kvs
    | otherwise = (k', v) : updateWith kvs e k
0
votes

The issue (ignoring other conceptual things mentioned by the commenters) turned out to be using fst to extract the result from the State would for some reason not cause the State to actually be computed. Running the result through seq fixed it.

I'd be interested in knowing why this is the case, though!

Edit: As Daniel Wagner pointed out in the comments, I wasn't actually using inventory, which turned out to be the real bug. Marking this as accepted.