[Haskell-beginners] Request for Another State Monad Example

Daniel Fischer daniel.is.fischer at web.de
Thu Sep 18 23:05:41 EDT 2008


Am Freitag, 19. September 2008 03:58 schrieb Mike Sullivan:
>
> Thank you, Daniel, for responding so quickly. I've played around with your
> Fibonacci generator, but I'm afraid I'm not yet confident enough with
> monads to get it to give me a meaningful answer. How do you seed its state,
> and how would you go about printing out (for example) the first 5 numbers
> in the Fibonacci sequence?

The state is provided when runState, evalState or execState are called (mostly 
evalState in my experience), you can provide any state you like, if previous 
and current are consecutive Fibonacci numbers, you get (part of) the 
Fibonacci sequence, otherwise some other sequence of Fibonacci type.
To get the next n Fibonacci numbers, one could define

getNFibs :: Int -> State FibState Integer
getNFibs n
	| n < 1	= return []
	| otherwise = do
		fib <- nextFib
		fibs <- getNFibs (n-1)
		return (fib:fibs)

or, simpler,
getNFibs n = replicateM n nextFib

Example:
module FibState where

import Control.Monad.State
import Control.Monad

data FibState = F {previous, current :: Integer}
fibState0 = F {previous = 1, current = 0}

currentFib :: State FibState Integer
currentFib = gets current

nextFib :: State FibState Integer
nextFib = do
    F p c <- get
    let n = p+c
    put (F c n)
    return n

getNFibs :: Int -> State FibState [Integer]
getNFibs k = replicateM k nextFib

main :: IO ()
main = print $ evalState (liftM2 (:) currentFib (getNFibs 5) ) fibState0

*FibState> main
Loading package mtl-1.1.0.1 ... linking ... done.
[0,1,1,2,3,5]
*FibState> evalState (getNFibs 15) fibState0
[1,1,2,3,5,8,13,21,34,55,89,144,233,377,610]


However, this is a bit anaemic, a good exercise to get familiar with the State 
monad (or its transformations) is to write a parser (or even a parser 
combinator library) for a simple language (arithmetic expressions is a common 
example). The state would be the remaining input,
type Parser a = StateT String [] a

HTH,
Daniel
>
> Mike
>
> On Wed, Sep 17, 2008 at 1:39 PM, Daniel Fischer 
<daniel.is.fischer at web.de>wrote:
> > Am Mittwoch, 17. September 2008 20:05 schrieb Mike Sullivan:
> > > Hi All,
> > >
> > > As I'm sure all Haskell beginners do, I'm having a bit of a struggle
> > > wrapping my head around all of the uses for monads. My current
> >
> > frustration
> >
> > > is trying to figure out how to use the state monad to attach some
> > > persistent state between different calls to a function. I have two
> > > questions that I would appreciate it if somebody could help me with.
> > >
> > > The ubiquitous state monad example for Haskell tutorials seems to be a
> > > random number generator, with a function like the following (from
> > > http://www.haskell.org/all_about_monads/html/statemonad.html#example):
> > >
> > > getAny :: (Random a) => State StdGen a
> > > getAny = do g      <- get
> > >             (x,g') <- return $ random g
> > >             put g'
> > >             return x
> > >
> > > My first question is very basic, but here it goes: I see it everywhere,
> >
> > but
> >
> > > what does the "=>" signify? Specifically, in this example what does
> > > "(Random a) =>" do in the type signature?
> >
> > It describes a required context, here it means "for any type 'a' which is
> > an
> > instance of the typeclass Random, getAny has the type State StdGen a".
> >
> > > My second question is more of a request, I suppose. I think it would be
> > > useful to get another example that does not have the added
> > > complications
> >
> > of
> >
> > > dealing with the Random package, and saves more than one piece of data
> > > as state. How would one go about (for example) creating a Fibonacci
> > > sequence generator that saves the last state, such that on each call it
> > > returns
> >
> > the
> >
> > > next number in the Fibonacci sequence?
> >
> > data FibState = F {previous, current :: Integer}
> > fibState0 = F {previous = 1, current = 0}
> >
> > currentFib :: State FibState Integer
> > currentFib = gets current
> >
> > nextFib :: State FibState Integer
> > nextFib = do
> >        F p c <- get
> >        let n = p+c
> >        put (F c n)
> >        return n
> >
> > does that help?
> >
> > > Thank you,
> > > Mike
> >
> > Cheers,
> > Daniel



More information about the Beginners mailing list