I'm trying to understand what happens in the following code, the code behaves properly, but I'm trying to understand why.
import Control.Monad.State
import System.IO
import System.Environment
echoArgs :: [String] -> State Int [String]
echoArgs x = loopArgs x >> return x
where loopArgs [] = return ()
loopArgs s#(x':xs') = modify (+1) >> loopArgs xs'
main :: IO ()
main = do
argv <- getArgs
let s = echoArgs argv
mapM_ putStr' (evalState s 0)
putStrLn $ "\nNum Args = " ++ show (execState s 0)
where putStr' x = putStr $ x ++ " "
What I'm not understanding is why the state of the State monad does not get 'reset' with each successive call to loopArgs. Does the state get passed as a variable, with each >> and if so could someone show me how?
Does the state get passed as a variable, with each >> and if so could someone show me how?
It does indeed. It's helpful to look at a toy implementation of the State monad.
newtype State s a = State { runState :: s -> (a,s) }
instance Monad (State s) where
return a = State $ \s -> (a, s)
State act >>= k = State $ \s ->
let (a, s') = act s
in runState (k a) s'
get :: State s s
get = State $ \s -> (s, s)
put :: s -> State s ()
put s = State $ \_ -> ((), s)
modify :: (s -> s) -> State s ()
modify f = get >>= \x -> put (f x)
When you bind using >>= or >> the accumulated state is threaded through as an argument to the function on the right hand side.
When you run execState or evalState it then just extracts either the resulting value or the state from the resulting tuple.
execState :: State s a -> s -> s
execState act = snd . runState act
evalState :: State s a -> s -> a
evalState act = fst . runState act
Related
I have the following code
newtype State s a = State { runState :: s -> (s,a) }
evalState :: State s a -> s -> a
evalState sa s = snd $ runState sa s
instance Functor (State s) where
fmap f sa = State $ \s ->
let (s',a) = runState sa s in
(s',f a)
instance Applicative (State s) where
pure a = State $ \s -> (s,a)
sf <*> sa = State $ \s ->
let (s',f) = runState sf s
(s'',a) = runState sa s' in
(s'', f a)
instance Monad (State s) where
sa >>= k = State $ \s ->
let (s',a) = runState sa s in
runState (k a) s'
get :: State s s
get = State $ \s -> (s,s)
set :: s -> State s ()
set s = State $ \_ -> (s,())
bar (acc,n) = if n <= 0
then return ()
else
set (n*acc,n-1)
f x = factLoop
factLoop = get >>= bar >>= f
And
runState factLoop (1,7)
gives ((5040,0),())
I'm trying to write the function
factLoop = get >>= bar >>= f
using the do notation
I tried
factLoop' = do
(x,y) <- get
h <- bar (x,y)
return ( f h)
But that does not give the correct type which should be State (Int, Int) ()
Any idea ?
Thanks!
Just remove the return on the final line :
factLoop' = do
(x,y) <- get
h <- bar (x,y)
f h
There is no return in your original code, so there should be none in the do notation version either. do notation simply "translates" uses of >>=, as you've already done.
>>= is infixl 1 (left-associating binary operator), so what you really have is
f x = factLoop
factLoop = get >>= bar >>= f
= (get >>= bar) >>= f
= (get >>= bar) >>= (\x -> f x)
= do { x <- (get >>= bar)
; f x }
= do { _ <- (get >>= bar)
; factLoop }
= do { _ <- (get >>= (\x -> bar x))
; factLoop }
= do { _ <- do { x <- get
; bar x }
; factLoop }
= do { x <- get
; _ <- bar x
; factLoop }
the last one is because of the monad associativity law ("Kleisli composition forms a category").
Doing this in the principled way you don't need to guess. After a little while you get a feeling for it of course, but until you do, being formal helps.
Can someone show a simple example where state monad can be better than passing state directly?
bar1 (Foo x) = Foo (x + 1)
vs
bar2 :: State Foo Foo
bar2 = do
modify (\(Foo x) -> Foo (x + 1))
get
State passing is often tedious, error-prone, and hinders refactoring. For example, try labeling a binary tree or rose tree in postorder:
data RoseTree a = Node a [RoseTree a] deriving (Show)
postLabel :: RoseTree a -> RoseTree Int
postLabel = fst . go 0 where
go i (Node _ ts) = (Node i' ts', i' + 1) where
(ts', i') = gots i ts
gots i [] = ([], i)
gots i (t:ts) = (t':ts', i'') where
(t', i') = go i t
(ts', i'') = gots i' ts
Here I had to manually label states in the right order, pass the correct states along, and had to make sure that both the labels and child nodes are in the right order in the result (note that naive use of foldr or foldl for the child nodes could have easily led to incorrect behavior).
Also, if I try to change the code to preorder, I have to make changes that are easy to get wrong:
preLabel :: RoseTree a -> RoseTree Int
preLabel = fst . go 0 where
go i (Node _ ts) = (Node i ts', i') where -- first change
(ts', i') = gots (i + 1) ts -- second change
gots i [] = ([], i)
gots i (t:ts) = (t':ts', i'') where
(t', i') = go i t
(ts', i'') = gots i' ts
Examples:
branch = Node ()
nil = branch []
tree = branch [branch [nil, nil], nil]
preLabel tree == Node 0 [Node 1 [Node 2 [],Node 3 []],Node 4 []]
postLabel tree == Node 4 [Node 2 [Node 0 [],Node 1 []],Node 3 []]
Contrast the state monad solution:
import Control.Monad.State
import Control.Applicative
postLabel' :: RoseTree a -> RoseTree Int
postLabel' = (`evalState` 0) . go where
go (Node _ ts) = do
ts' <- traverse go ts
i <- get <* modify (+1)
pure (Node i ts')
preLabel' :: RoseTree a -> RoseTree Int
preLabel' = (`evalState` 0) . go where
go (Node _ ts) = do
i <- get <* modify (+1)
ts' <- traverse go ts
pure (Node i ts')
Not only is this code more succinct and easier to write correctly, the logic that results in pre- or postorder labeling is far more transparent.
PS: bonus applicative style:
postLabel' :: RoseTree a -> RoseTree Int
postLabel' = (`evalState` 0) . go where
go (Node _ ts) =
flip Node <$> traverse go ts <*> (get <* modify (+1))
preLabel' :: RoseTree a -> RoseTree Int
preLabel' = (`evalState` 0) . go where
go (Node _ ts) =
Node <$> (get <* modify (+1)) <*> traverse go ts
As an example to my comment above, you can write code using the State monad like
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
import Data.Text (Text)
import qualified Data.Text as Text
import Control.Monad.State
data MyState = MyState
{ _count :: Int
, _messages :: [Text]
} deriving (Eq, Show)
makeLenses ''MyState
type App = State MyState
incrCnt :: App ()
incrCnt = modify (\my -> my & count +~ 1)
logMsg :: Text -> App ()
logMsg msg = modify (\my -> my & messages %~ (++ [msg]))
logAndIncr :: Text -> App ()
logAndIncr msg = do
incrCnt
logMsg msg
app :: App ()
app = do
logAndIncr "First step"
logAndIncr "Second step"
logAndIncr "Third step"
logAndIncr "Fourth step"
logAndIncr "Fifth step"
Note that using additional operators from Control.Lens also lets you write incrCnt and logMsg as
incrCnt = count += 1
logMsg msg = messages %= (++ [msg])
which is another benefit of using State in combination with the lens library, but for the sake of comparison I'm not using them in this example. To write the equivalent code above with just argument passing it would look more like
incrCnt :: MyState -> MyState
incrCnt my = my & count +~ 1
logMsg :: MyState -> Text -> MyState
logMsg my msg = my & messages %~ (++ [msg])
logAndIncr :: MyState -> Text -> MyState
logAndIncr my msg =
let incremented = incrCnt my
logged = logMsg incremented msg
in logged
At this point it isn't too bad, but once we get to the next step I think you'll see where the code duplication really comes in:
app :: MyState -> MyState
app initial =
let first_step = logAndIncr initial "First step"
second_step = logAndIncr first_step "Second step"
third_step = logAndIncr second_step "Third step"
fourth_step = logAndIncr third_step "Fourth step"
fifth_step = logAndIncr fourth_step "Fifth step"
in fifth_step
Another benefit of wrapping this up in a Monad instance is that you can use the full power of Control.Monad and Control.Applicative with it:
app = mapM_ logAndIncr [
"First step",
"Second step",
"Third step",
"Fourth step",
"Fifth step"
]
Which allows for much more flexibility when processing values calculated at runtime compared to static values.
The difference between manual state passing and using the State monad is simply that the State monad is an abstraction over the manual process. It also happens to fit several other widely used more general abstractions, like Monad, Applicative, Functor, and a few others. If you also use the StateT transformer then you can compose these operations with other monads, such as IO. Can you do all of this without State and StateT? Of course you can, and there's no one stopping you from doing so, but the point is that State abstracts this pattern out and gives you access to a huge toolbox of more general tools. Also, a small modification to the types above makes the same functions work in multiple contexts:
incrCnt :: MonadState MyState m => m ()
logMsg :: MonadState MyState m => Text -> m ()
logAndIncr :: MonadState MyState m => Text -> m ()
These will now work with App, or with StateT MyState IO, or any other monad stack with a MonadState implementation. It makes it significantly more reusable than simple argument passing, which is only possible through the abstraction that is StateT.
In my experience, the point of many Monads doesn't really click until you get into larger examples, so here is an example use of State (well, StateT ... IO) to parse an incoming request to a web service.
The pattern is that this web service can be called with a bunch of options of different types, though all except for one of the options have decent defaults. If I get a incoming JSON request with an unknown key value, I should abort with an appropriate message. I use the state to keep track of what the current config is, and what the remainder of the JSON request is, along with a bunch of accessor methods.
(Based on code currently in production, with the names of everything changed and the details of what this service actually does obscured)
{-# LANGUAGE OverloadedStrings #-}
module XmpConfig where
import Data.IORef
import Control.Arrow (first)
import Control.Monad
import qualified Data.Text as T
import Data.Aeson hiding ((.=))
import qualified Data.HashMap.Strict as MS
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Trans.State (execStateT, StateT, gets, modify)
import qualified Data.Foldable as DF
import Data.Maybe (fromJust, isJust)
data Taggy = UseTags Bool | NoTags
newtype Locale = Locale String
data MyServiceConfig = MyServiceConfig {
_mscTagStatus :: Taggy
, _mscFlipResult :: Bool
, _mscWasteTime :: Bool
, _mscLocale :: Locale
, _mscFormatVersion :: Int
, _mscJobs :: [String]
}
baseWebConfig :: IO (IORef [String], IORef [String], MyServiceConfig)
baseWebConfig = do
infoRef <- newIORef []
warningRef <- newIORef []
let cfg = MyServiceConfig {
_mscTagStatus = NoTags
, _mscFlipResult = False
, _mscWasteTime = False
, _mscLocale = Locale "en-US"
, _mscFormatVersion = 1
, _mscJobs = []
}
return (infoRef, warningRef, cfg)
parseLocale :: T.Text -> Maybe Locale
parseLocale = Just . Locale . T.unpack -- The real thing does more
parseJSONReq :: MS.HashMap T.Text Value ->
IO (IORef [String], IORef [String], MyServiceConfig)
parseJSONReq m = liftM snd
(baseWebConfig >>= (\c -> execStateT parse' (m, c)))
where
parse' :: StateT (MS.HashMap T.Text Value,
(IORef [String], IORef [String], MyServiceConfig))
IO ()
parse' = do
let addWarning s = do let snd3 (_, b, _) = b
r <- gets (snd3 . snd)
liftIO $ modifyIORef r (++ [s])
-- These two functions suck a key/value off the input map and
-- pass the value on to the handler "h"
onKey k h = onKeyMaybe k $ DF.mapM_ h
onKeyMaybe k h = do myb <- gets fst
modify $ first $ MS.delete k
h (MS.lookup k myb)
-- Access the "lns" field of the configuration
config setter = modify (\(a, (b, c, d)) -> (a, (b, c, setter d)))
onKey "tags" $ \x -> case x of
Bool True -> config $ \c -> c {_mscTagStatus = UseTags False}
String "true" -> config $ \c -> c {_mscTagStatus = UseTags False}
Bool False -> config $ \c -> c {_mscTagStatus = NoTags}
String "false" -> config $ \c -> c {_mscTagStatus = NoTags}
String "inline" -> config $ \c -> c {_mscTagStatus = UseTags True}
q -> addWarning ("Bad value ignored for tags: " ++ show q)
onKey "reverse" $ \x -> case x of
Bool r -> config $ \c -> c {_mscFlipResult = r}
q -> addWarning ("Bad value ignored for reverse: " ++ show q)
onKey "spin" $ \x -> case x of
Bool r -> config $ \c -> c {_mscWasteTime = r}
q -> addWarning ("Bad value ignored for spin: " ++ show q)
onKey "language" $ \x -> case x of
String s | isJust (parseLocale s) ->
config $ \c -> c {_mscLocale = fromJust $ parseLocale s}
q -> addWarning ("Bad value ignored for language: " ++ show q)
onKey "format" $ \x -> case x of
Number 1 -> config $ \c -> c {_mscFormatVersion = 1}
Number 2 -> config $ \c -> c {_mscFormatVersion = 2}
q -> addWarning ("Bad value ignored for format: " ++ show q)
onKeyMaybe "jobs" $ \p -> case p of
Just (Array x) -> do q <- parseJobs x
config $ \c -> c {_mscJobs = q}
Just (String "test") ->
config $ \c -> c {_mscJobs = ["test1", "test2"]}
Just other -> fail $ "Bad value for jobs: " ++ show other
Nothing -> fail "Missing value for jobs"
m' <- gets fst
unless (MS.null m') (fail $ "Unrecognized key(s): " ++ show (MS.keys m'))
parseJobs :: (Monad m, DF.Foldable b) => b Value -> m [String]
parseJobs = DF.foldrM (\a b -> liftM (:b) (parseJob a)) []
parseJob :: (Monad m) => Value -> m String
parseJob (String s) = return (T.unpack s)
parseJob q = fail $ "Bad job value: " ++ show q
import Control.Monad.State.Lazy
type Queue a = [a]
push :: a -> State (Queue a) ()
push x = state (\xs -> ((),xs++[x]))
pop :: State (Queue a) a
pop = state (\(x:xs) -> (x,xs))
queueManip :: State (Queue Int) Int
queueManip =
do
mapM_ push [1..]
a <- pop
return a
main :: IO()
main = do
let (a,_) = runState queueManip []
print a
Shouldn't the mapM_ be lazy ? Besides for implementing a queue shouldn't the complexity be O(1)?
Because the append (++) itself is lazy ...
What if I'm evil and use
push' :: Int -> State (Queue Int) ()
push' 1052602983 = state $ \_ -> ((), []) -- "Muarhar!"
push' x = state $ \xs -> ((),xs++[x])
Then mapM push' [1..] should clearly render the state as [1052602983, 1052602984 ..]. It would be wrong for pop to yield 1. But mapM can't possibly know this, without first evaluating a billion other numbers. Actually pushing them to the state is irrelevant here, and it also doesn't matter that push could be completely lazy: mapM at least has to give it a chance to check any given number, before handing on the monadic program flow.
Note that do mapM_ push [1..3]; something is the same as:
do push 1; push 2; push 3; something
so that should explain why
do mapM_ push [1..]; something
never gets around to executing something.
If you look at the definition of the State monad:
type State s a = s -> (a, s)
instance Monad (State s) where
return a = \s -> (a,s)
m >>= g = wpAB
where
wpAB = \s1 -> let (v2, s2) = m s1
(v3, s3) = g v2 s2
in (v3, s3)
-- (newtypes and such have been removed to declutter the code)
you see that the value of m >>= g always depends on g. Contrast that with the definition of Maybe monad:
instance Monad Maybe where
return x = Just x
(>>=) m g = case m of
Nothing -> Nothing
Just x -> g x
where m >>= g can be independent of g which explains how the Maybe monad can short-circuit a do-chain.
I would like to generate random sequences from a Markov chain. To generate the Markov chain I use the following code.
module Main where
import qualified Control.Monad.Random as R
import qualified Data.List as L
import qualified Data.Map as M
type TransitionMap = M.Map (String, String) Int
type MarkovChain = M.Map String [(String, Int)]
addTransition :: (String, String) -> TransitionMap -> TransitionMap
addTransition k = M.insertWith (+) k 1
fromTransitionMap :: TransitionMap -> MarkovChain
fromTransitionMap m =
M.fromList [(k, frequencies k) | k <- ks]
where ks = L.nub $ map fst $ M.keys m
frequencies a = map reduce $ filter (outboundFor a) $ M.toList m
outboundFor a k = fst (fst k) == a
reduce e = (snd (fst e), snd e)
After collecting the statistics and generating a Markov Chain object I would like to generate random sequences. I could imagine this method could look something like that (pseudo-code)
generateSequence mc s
| s == "." = s
| otherwise = s ++ " " ++ generateSequence mc s'
where s' = drawRandomlyFrom $ R.fromList $ mc ! s
I would greatly appreciate if someone could explain to me, how I should implement this function.
Edit
If anyone's interested it wasn't as difficult as I thought.
module Main where
import qualified Control.Monad.Random as R
import qualified Data.List as L
import qualified Data.Map as M
type TransitionMap = M.Map (String, String) Rational
type MarkovChain = M.Map String [(String, Rational)]
addTransition :: TransitionMap -> (String, String) -> TransitionMap
addTransition m k = M.insertWith (+) k 1 m
fromTransitionMap :: TransitionMap -> MarkovChain
fromTransitionMap m =
M.fromList [(k, frequencies k) | k <- ks]
where ks = L.nub $ map fst $ M.keys m
frequencies a = map reduce $ filter (outboundFor a) $ M.toList m
outboundFor a k = fst (fst k) == a
reduce e = (snd (fst e), snd e)
generateSequence :: (R.MonadRandom m) => MarkovChain -> String -> m String
generateSequence m s
| not (null s) && last s == '.' = return s
| otherwise = do
s' <- R.fromList $ m M.! s
ss <- generateSequence m s'
return $ if null s then ss else s ++ " " ++ ss
fromSample :: [String] -> MarkovChain
fromSample ss = fromTransitionMap $ foldl addTransition M.empty $ concatMap pairs ss
where pairs s = let ws = words s in zipWith (,) ("":ws) ws
sample :: [String]
sample = [ "I am a monster."
, "I am a rock star."
, "I want to go to Hawaii."
, "I want to eat a hamburger."
, "I have a really big headache."
, "Haskell is a fun language."
, "Go eat a big hamburger."
, "Markov chains are fun to use."
]
main = do
s <- generateSequence (fromSample sample) ""
print s
The only tiny annoyance is the fake "" starting node.
Not sure if this is what you're looking for. This compiles though:
generateSequence :: (R.MonadRandom m) => MarkovChain -> String -> m String
generateSequence mc s | s == "." = return s
| otherwise = do
s' <- R.fromList $ rationalize (mc M.! s)
s'' <- generateSequence mc s'
return $ s ++ " " ++ s''
rationalize :: [(String,Int)] -> [(String,Rational)]
rationalize = map (\(x,i) -> (x, toRational i))
All random number generation needs to happen in either the Random monad or the IO monad. For your purpose, it's probably easiest to understand how to do that in the IO monad, using evalRandIO. In the example below, getRandom is the function we want to use. Now getRandom operates in the Random monad, but we can use evalRandIO to lift it to the IO monad, like this:
main :: IO ()
main = do
x <- evalRandIO getRandom :: IO Double
putStrLn $ "Your random number is " ++ show x
Note: The reason we have to add the type signature to the line that binds x is because in this particular example there are no other hints to tell the compiler what type we want x to be. However, if we used x in some way that makes it clear that we want it to be a Double (e.g., multiplying by another Double), then the type signature wouldn't be necessary.
Using your MarkovChain type, for a current state you can trivially get the available transitions in the form [(nextState,probability)]. (I'm using the word "probability" loosely, it doesn't need to be a true probability; any numeric weight is fine). This is what fromList in Control.Monad.Random is designed for. Again, it operates in the Random monad, but we can use evalRandIO to lift it to the IO monad. Suppose transitions is your list of transitions, having the type [(nextState,probability)]. Then, in the IO monad you can call:
nextState <- evalRandIO $ fromList transitions
You might instead want to create your own function that operates in the Random monad, like this:
getRandomTransition :: RandomGen g => MarkovChain -> String -> Rand g String
getRandomTransition currState chain = do
let transitions = lookup currState chain
fromList transitions
Then you can call this function in the IO monad using evalRandIO, e.g.
nextState <- evalRandIO $ getRandomTransition chain
I need to wrap my head around the state monad in haskell and I have some problems with that.
The task is to implement a function countConcat which concatenates string with the state monad and a function extractCC which gets the result of this function.
So extractCC ((return 0) >>= countConcat "a" >>= countConcat "b" >>= countConcat "c") would yield (3,"abc")
As far as I understand countConcat would be kind of a manipulator function and extractCC should contain some kind of runState, right?
Any tipps or ressources getting me into the right direction are highly appreciated.
(I´ve been through the wiki and the learnyouahaskell section, but still feeling quite stupid with this)
Try this first
concat' :: String -> State (Int,String) ()
concat' s = do
(c,st) <- get
put (c+1, st ++ s)
You can run this by
> runState ( concat' "A" >> concat' "B" >> concat' "C" ) (0,"")
((),(3,"ABC"))
I think if you understand state monad you can modify the above example for your need.
Thanks to Satvik I was able to solve the Problem. Here is my final solution:
newtype State s a = State {runState :: s -> (a,s)}
instance Monad (State s) where
return x = State (\s -> (x,s))
(State h) >>= f = State (\s -> let (a, newState) = h s
(State g) = f a
in g newState)
-- Save new state
countConcat :: String -> Int -> State String Int
countConcat s i =do
st <- get -- get current string
put ((st ++ s)) -- put conc. string
return (i+1) -- return new counter
extractCC f =(runState f ("")) --run the function, staring with an empty string
-- Helper from the wiki
put newState = State $ \_ -> ((), newState)
get = State $ \st -> (st, st)
-- extractCC ((return 0) >>= countConcat "a" >>= countConcat "b" >>= countConcat "c")
-- (3,"abc")
If you use the first combinator from Control.Arrow, then:
countConcat :: String -> State (String,Int) ()
countConcat s = modify ((<> s) *** (+1))