1
\$\begingroup\$

From Simple IO to Monad Transformers presents the following exercise:

The guts of our algorithm will be a function next_coin which does something like this

(amt,coins) -> (amt,coins)

Each transition either dispenses a coin and decreases amt accordingly, or removes the largest coin from coins. The first alternative takes precedence whenever amt is not smaller than the largest coin. Here is an example of how this sequence of pairs represents coin dispensing. Start with (11,[10,1]) which means we must make change for 11 cents with a dime and a penny.

The first step is to (1,[10,1]) representing that a dime has been dispensed. The second step is to (1,[1]) representing that we have recognized dimes are no longer useful. The last step is to (0,[1]) representing that a penny has been dispensed.

Code

import Control.Monad.State
import Data.List

type Coins = [Int]

type StMach a = StateT Coins IO a

main :: IO ()
main = 
  let 
    coins = [1,5,10,25]
  in
    do 
      putStrLn "Enter an amount: "
      input  <- getLine
      number <- return $ read input 
      make_change coins number

make_change :: Coins -> Int -> IO () -- IO (Int, Coins) 
make_change coins amt = runStateT (recurs amt) coins *> return ()

-- author: Monad Book
recurs :: Int -> StMach Int
recurs amt = 
    if amt == 0
        then return amt
        else next_coin amt >>= recurs

data CoinState a = CoinLargerThanAmount a | FoundChange a | PennyMatch

--if amount is less than (max coins), then delete the max from coins
--otherwise subtract amount and delete that elem from coins (unless it's 1)
next_coin :: Int -> StMach Int
next_coin amt = do 
  coinsLeft <- get
  dispense amt coinsLeft
  state $ \coins -> 
            case coinState coins amt of
        PennyMatch             -> (amt-1, coins)
        FoundChange a          -> (amt-a, delete a coins)
        CoinLargerThanAmount a -> (amt,   delete a coins)

coinState :: Ord a => [a] -> a -> CoinState a
coinState xs a =  
 let 
  largerCoinInChange = find (> a) xs
 in 
  case largerCoinInChange of 
    Just a  -> CoinLargerThanAmount a
    Nothing -> case  filter (<= a) xs of
        [] -> PennyMatch
        as -> FoundChange (maximum as) 

-- author: Monad Book
dispense :: Int -> Coins -> StMach ()
dispense i coins = 
   ( lift $ 
      putStrLn ( "dispense "
                  ++(show i)
                  ++" cents"
                  ++ remaining)
    )
   where 
     cents = (if i==1  
                then " cent" 
                else " cents") ++ remaining
     remaining = " with remaining coins: " ++ (show coins)

Code

*Main Control.Monad.State> main
Enter an amount: 
16
dispense 16 cents with remaining coins: [1,5,10,25]
dispense 16 cents with remaining coins: [1,5,10]
dispense 6 cents with remaining coins: [1,5]
dispense 1 cents with remaining coins: [1]

*Main Control.Monad.State> main
Enter an amount: 
10
dispense 10 cents with remaining coins: [1,5,10,25]
dispense 10 cents with remaining coins: [1,5,10]

*Main Control.Monad.State> main
Enter an amount: 
1
dispense 1 cents with remaining coins: [1,5,10,25]
dispense 1 cents with remaining coins: [1,10,25]
dispense 1 cents with remaining coins: [1,25]
dispense 1 cents with remaining coins: [1]
\$\endgroup\$
  • \$\begingroup\$ Could you replace that screenshot with a proper quote? \$\endgroup\$ – Zeta May 19 '17 at 9:16
  • \$\begingroup\$ Sure - done, @Zeta! \$\endgroup\$ – Kevin Meredith May 19 '17 at 10:56

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Browse other questions tagged or ask your own question.