Complete chapter 23

23-state/23.5-roll-your-own.md

@@ -0,0 +1,2 @@
+# Exercises: Roll Your Own
+see src/RandomExample2.hs

23-state/23.8-chapter-exercises.md

@@ -0,0 +1,2 @@
+# Chapter Exercises
+see src/chapter.hs

23-state/src/Moi.hs

@@ -0,0 +1,26 @@
+{-# LANGUAGE InstanceSigs #-}
+module Moi where
+
+newtype Moi s a = Moi { runMoi :: s -> (a, s) }
+
+instance Functor (Moi s) where
+    fmap :: (a -> b) -> Moi s a -> Moi s b
+    fmap f (Moi g) = Moi $ \s -> let (a, s') = g s
+                                 in (f a, s')
+
+instance Applicative (Moi s) where
+    pure :: a -> Moi s a
+    pure a = Moi $ \s -> (a, s)
+    
+    (<*>) :: Moi s (a -> b) -> Moi s a -> Moi s b
+    (Moi f) <*> (Moi g) = Moi $ \s -> let (a, s') = g s
+                                          (f', s'') = f s'
+                                      in (f' a, s'')
+
+instance Monad (Moi s) where
+    return :: a -> Moi s a
+    return = pure
+
+    (>>=) :: Moi s a -> (a -> Moi s b) -> Moi s b
+    (Moi f) >>= g = Moi $ \s -> let (a, s') = f s
+                                in runMoi (g a) s'

23-state/src/RandomExample.hs

@@ -0,0 +1,32 @@
+module RandomExample where
+
+import System.Random
+
+-- Six-sided die
+data Die =
+    DieOne
+  | DieTwo
+  | DieThree
+  | DieFour
+  | DieFive
+  | DieSix
+  deriving (Eq, Show)
+
+intToDie :: Int -> Die
+intToDie n = case n of
+    1 -> DieOne
+    2 -> DieTwo
+    3 -> DieThree
+    4 -> DieFour
+    5 -> DieFive
+    6 -> DieSix
+    -- Use 'error' _extremely_ sparingly
+    x -> error $ "intToDie got non 1-6 integer: " ++ show x
+
+rollDieThreeTimes :: (Die, Die, Die)
+rollDieThreeTimes = do
+    let s = mkStdGen 0
+        (d1, s1) = randomR (1, 6) s
+        (d2, s2) = randomR (1, 6) s1
+        (d3,  _) = randomR (1, 6) s2
+    (intToDie d1, intToDie d2, intToDie d3)

23-state/src/RandomExample2.hs

@@ -0,0 +1,57 @@
+module RandomExample2 where
+
+import Control.Applicative (liftA3)
+import Control.Monad (replicateM)
+import Control.Monad.Trans.State
+import System.Random
+import RandomExample
+
+
+rollDie :: State StdGen Die
+rollDie = state $ do
+    (n, s) <- randomR (1, 6)
+    return (intToDie n, s)
+
+rollDie' :: State StdGen Die
+rollDie' = intToDie <$> state (randomR (1, 6))
+
+rollDieThreeTimes' :: State StdGen (Die, Die, Die)
+rollDieThreeTimes' = liftA3 (,,) rollDie' rollDie' rollDie'
+
+infiniteDie :: State StdGen [Die]
+infiniteDie = repeat <$> rollDie'
+
+nDie :: Int -> State StdGen [Die]
+nDie n = replicateM n rollDie
+
+rollsToGetTwenty :: StdGen -> Int
+rollsToGetTwenty g = go 0 0 g
+    where go :: Int -> Int -> StdGen -> Int
+          go sum' count gen
+            | sum' >= 20 = count
+            | otherwise = let (die, nextGen) = randomR (1, 6) gen
+                          in go (sum' + die) (count + 1) nextGen
+
+-- Exercises: Roll Your Own
+-- 1
+rollsToGetN :: Int -> StdGen -> Int
+rollsToGetN n g = go 0 0 g
+    where go :: Int -> Int -> StdGen -> Int
+          go sum' count gen
+            | sum' >= n = count
+            | otherwise = let (die, nextGen) = randomR (1, 6) gen
+                          in go (sum' + die) (count + 1) nextGen
+
+                          -- 2
+rollsCountLogged :: Int -> StdGen -> (Int, [Die])
+rollsCountLogged n g = go 0 (0, []) g
+    where go :: Int -> (Int, [Die]) -> StdGen -> (Int, [Die])
+          go sum' r@(count, dice) gen
+            | sum' >= n = r
+            | otherwise = let (die, nextGen) = randomR (1, 6) gen
+                          in go (sum' + die) 
+                                ((count + 1), intToDie die : dice) 
+                                nextGen
+
+rollsToGetN' :: Int -> StdGen -> Int
+rollsToGetN' n = fst . rollsCountLogged n

23-state/src/chapter.hs

@@ -0,0 +1,35 @@
+module Chapter where
+
+newtype State s a = State { runState :: s -> (a, s) }
+instance Functor (State s) where
+    fmap f k = State $ \s -> let (a, s') = runState k s
+                             in (f a, s')
+instance Applicative (State s) where
+    pure a = State $ \s -> (a, s)
+    (State f) <*> k = State $ \s -> let (a, s') = runState k s
+                                        (f', s'') = f s'
+                                    in (f' a, s'')
+instance Monad (State s) where
+    return = pure
+    (State f) >>= k = State $ \s -> let (a, s') = f s
+                                    in runState (k a) s'
+
+-- 1
+get :: State s s
+get = State $ \s -> (s,s)
+
+-- 2
+put :: s -> State s ()
+put s = State $ \_ -> ((),s)
+
+-- 3
+exec :: State s a -> s -> s
+exec st = snd . runState st
+
+-- 4
+eval :: State s a -> s -> a
+eval st = fst . runState st
+
+-- 5
+modify :: (s -> s) -> State s ()
+modify f = State $ \s -> ((), f s)

23-state/src/fizzbuzz.hs

@@ -0,0 +1,52 @@
+module FizzBuzz where
+
+import Control.Monad
+import Control.Monad.Trans.State
+-- http://hackage.haskell.org/package/dlist
+-- import qualified Data.DList as DL
+
+fizzBuzz :: Integer -> String
+fizzBuzz n | n `mod` 15 == 0 = "FizzBuzz"
+           | n `mod` 5  == 0 = "Buzz"
+           | n `mod` 3  == 0 = "Fizz"
+           | otherwise = show n
+
+-- fizzbuzzlist :: [Integer] -> DL.DList String
+-- fizzbuzzlist list = execState (mapM_ addResult list) DL.empty
+
+-- addResult :: Integer -> State (DL.DList String) ()
+-- addResult n = do
+--     xs <- get
+--     let result = fizzBuzz n
+--     put (DL.snoc xs result)
+
+-- main :: IO ()
+-- main = mapM_ putStrLn $ fizzbuzzlist [1..100]
+
+fizzbuzzlist :: [Integer] -> [String]
+fizzbuzzlist list = execState (mapM_ addResult list) []
+
+addResult :: Integer -> State [String] ()
+addResult n = do
+    xs <- get
+    let result = fizzBuzz n
+    put (result : xs)
+
+-- they all seem to take about the same amount of time...
+main :: IO ()
+-- main = mapM_ putStrLn $ reverse $ fizzbuzzlist [1..100]
+main = mapM_ putStrLn $ fizzbuzzFromTo 1 500000
+-- main = mapM_ putStrLn $ fizzbuzzFromTo' 1 500000
+
+fizzbuzzFromTo :: Integer -> Integer -> [String]
+fizzbuzzFromTo from to = go from to []
+    where go f t st
+            | f >= t = st
+            | otherwise = execState (addResult f) (go (f+1) t st)
+
+fizzbuzzFromTo' :: Integer -> Integer -> [String]
+fizzbuzzFromTo' from to = execState (mapM_ addResult list) []
+    where list = go from to []
+          go f t l
+                | f >= t = l
+                | otherwise = go (f+1) t (f:l)