[Haskell-beginners] How to solve this using State Monad?

kak dod kak.dod2008 at gmail.com
Wed May 30 21:17:48 CEST 2012


Hello Henry,

But I guess you are not asking about advantages/disadvantages, but how the
> hell it works ;-)


Yes, the first thing I want to know is how it works?

thank you very much for your example. It has helped me a lot to begin with.
You have simplified the general DFA problem to a specific one.

Your example seems more helpful to me, but can you please remove the IO
stuff from your first (non-state monadic) example and repost the same
example again?

More specifically, I want to see a definition like:
     mystatemachine :: String -> String
in the first example too.

The IO stuff is adding to my confusion as I am unable to compare the exact
difference between the two examples. I could remove the IO part from the
second example very easily by directly executing the function  "mystatemachine"
at the GHCi prompt.

The IO stuff more scarier for me. Till now I have not used any IO in
Haskell. I think, if I cannot use State Monad then I cannot use the more
scarier IO monad.

Thanks again for the help.
kak

On Wed, May 30, 2012 at 8:44 PM, Henry Lockyer
<henry.lockyer at ntlworld.com>wrote:

> I should have gone back and cleaned up my original 'Version 1' example so
> that both examples use exactly the same 'stateMC' function.
> I have now made this small improvement below FWIW.
> /Henry
>
> On 30 May 2012, at 15:31, Henry Lockyer wrote:
>
> Hi kak,
>
> On 28 May 2012, at 19:49, kak dod wrote:
>
> Hello,
> A very good morning to all.
>
> I am a Haskell beginner. And although I have written fairly complicated
> programs and have understood to some extent the concepts like pattern
> matching, folds, scans, list comprehensions, but I have not satisfactorily
> understood the concept of Monads yet. I have partially understood and used
> the Writer, List and Maybe monads but the State monad completely baffles me.
>
> I wanted to write a  program for the following problem: A DFA simulator.
> This I guess is a right candidate for State monad as it mainly deals with
> state changes.
>
> What the program is supposed to do is:
>
>
> . . .
>
>
> I wrote a recursive program to do this without using any monads. I simply
> send the entire dfa, the input string and its partial result in the
> recursive calls.
>
> How to do this using State Monad?
>
> . . .
>
> Please note that I wish your solution to use the Control.Monad.State.
>
>
> I coincidentally included something like this in another post I recently
> made.
> I have quickly tweaked my example slightly and added a complete
> alternative example using the State monad below.
> Both programs now have the same external behaviour.
> It is a simpler example than the DFA that you are proposing. If I have
> time I'll look at your specific version of
> the problem, but I am assuming that your main aim here is to understand
> the State monad better - rather than the DFA
> exactly as you have specified it -  so perhaps the following simple
> examples may help a little:
>
> ---------------------------------------------------
> --
> -- "aha!"
> --
> -- An exciting game that requires the string "aha!" to
> -- be entered in order to reach the exit, rewarded with a "*".
> --
> -- A simple state machine.
> --
> -- Version 1 - not using the State monad...
> --
>
> import System.IO
>
> type MyState = Char
>
> initstate, exitstate :: MyState
> initstate = 'a'
> exitstate = 'z'
>
> main = do hSetBuffering stdin NoBuffering -- (just so it responds char by
> char on the terminal)
>           stateIO initstate
>
> stateIO :: MyState -> IO ()
> stateIO s = do c_in <- getChar
>
>                    let (str_out, s') = stateMC' c_in s
>                    putStr str_out  -- (newline flushes the output)
>
>                 stateIO s'
>
> -- now uses exactly the same stateMC func as in version 2 below...
> -- ('Y' = Yes, 'N' = No, '*' = congratulations game over, blank responses
> after game over)
>
> stateMC' :: Char -> MyState -> (String, MyState)
> stateMC' 'a' 'a' = (" Y\n", 'b')
> stateMC' 'h' 'b' = (" Y\n", 'c')
> stateMC' 'a' 'c' = (" Y\n", 'd')
> stateMC' '!' 'd' = (" *\n", 'z')
> stateMC'  _  'z' = ("  \n", 'z')
> stateMC'  _   _  = (" N\n", 'a')
>
>
>
>
> ------------------------------------------------------------
>
> --
> -- Version 2 - using the State monad...
> -- This time it treats the input as one long lazy String of chars
> -- rather than char-by-char reading as in version 1
> --
>
> import System.IO
> import Control.Monad.State
>
> type MyState = Char
>
> initstate, exitstate :: MyState
> initstate = 'a'
> exitstate = 'z'
>
> main = do hSetBuffering stdin NoBuffering
>           interact mystatemachine
>
> mystatemachine :: String -> String
> mystatemachine str = concat $ evalState ( mapM charfunc str ) initstate
>
> charfunc :: Char -> State MyState String
> charfunc c = state $ stateMC' c     -- wrap the stateMC' func in the state
> monad
>
>
> <snip - remove previous comment>
>
> stateMC' :: Char -> MyState -> (String, MyState)
> stateMC' 'a' 'a' = (" Y\n", 'b')
> stateMC' 'h' 'b' = (" Y\n", 'c')
> stateMC' 'a' 'c' = (" Y\n", 'd')
> stateMC' '!' 'd' = (" *\n", 'z')
> stateMC'  _  'z' = ("  \n", 'z')
> stateMC'  _   _  = (" N\n", 'a')
>
> -------------------------------------------------------------
>
> Advantages of using the State monad are not really obvious in this
> example, but perhaps it will help in clarifying
> what it is doing.  It is just wrapping the stateMC' function in a monadic
> wrapper so that you can make convenient use of the
> monadic operations >>= etc. and associated functions like mapM etc. for
> sequencing state computations.
> 'evalState' takes the chained sequence of state computations, produced by
> mapM in this case, feeds the initial value into the
> beginning of the chain, takes the output from the end (which is a pair
> ([String], MyState) in this case) throws away the final MyState as we are
> not interested in it here and keeps the [String]  (which is then flattened
> to a single string with concat).
> +Thanks to the wonders of laziness it works on it char by char as we go
> along :-)
>
> In less trivial cases it helps keep the clutter of the common state
> handling away from the specifics of what you
> are doing, like in the Real World Haskell parser example where it nicely
> handles the parse state.
> But I guess you are not asking about advantages/disadvantages, but how the
> hell it works ;-)
> I have found it confusing too...
> /Henry
>
>
> _______________________________________________
> Beginners mailing list
> Beginners at haskell.org
> http://www.haskell.org/mailman/listinfo/beginners
>
>
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://www.haskell.org/pipermail/beginners/attachments/20120531/889e01e6/attachment-0001.htm>


More information about the Beginners mailing list