[Haskell-cafe] A question about "threading" state
michael rice
nowgate at yahoo.com
Thu Sep 16 12:21:02 EDT 2010
I've been playing around with State Monads. Two I looked at earlier used *sequence* and *replicate* but when I came to this one I found myself puzzling over how to structure the problem when there was no predetermined count of how many times to thread the state.
============== Program 1 =============
import Control.Monad
import Control.Monad.State
type GeneratorState = State (Int, Int)
-- lcf (largest common factor)
-- lcf :: (Int, Int) -> ((Int, Int), Int)
lcf (x, y)
| x == y = ((x, y), x)
| x < y = ((y, x), 0)
| otherwise = ((y, x-y), 0)
lcfstate :: GeneratorState Int
lcfstate = State (\st -> lcf st)
============== Some output =========
{-
*Main> runState lcfstate (24,18)
(0,(18,6))
*Main> runState lcfstate (18,6)
(0,(6,12))
*Main> runState lcfstate (6,12)
(0,(12,6))
*Main> runState lcfstate (12,6)
(0,(6,6))
*Main> runState lcfstate (6,6)
(6,(6,6))
*Main> runState (sequence $ replicate 5 lcfstate) (24,18)
([0,0,0,0,6],(6,6))
-}
{-
*Main> evalState (sequence $ replicate 2 lcfstate) (24,18)
[0,0]
*Main> evalState (sequence $ replicate 3 lcfstate) (24,18)
[0,0,0]
*Main> evalState (sequence $ replicate 4 lcfstate) (24,18)
[0,0,0,0]
*Main> evalState (sequence $ replicate 5 lcfstate) (24,18)
[0,0,0,0,6]
-}
===================================
Then I saw the same problem solved here
http://www.engr.mun.ca/~theo/Misc/haskell_and_monads.htm
============== Program 2 =============
import Control.Monad
import Control.Monad.ST
newtype StateTrans s a = ST( s -> (s, a) )
instance Monad (StateTrans s)
where
-- (>>=) :: StateTrans s a -> (a -> StateTrans s b) -> StateTrans s b
(ST p) >>= k = ST( \s0 -> let (s1, a) = p s0
(ST q) = k a
in q s1 )
-- return :: a -> StateTrans s a
return a = ST( \s -> (s, a) )
applyST :: StateTrans s a -> s -> (s, a)
applyST (ST p) s = p s
type ImpState = (Int, Int)
getX, getY :: StateTrans ImpState Int
getX = ST(\(x,y)-> ((x,y), x))
getY = ST(\(x,y)-> ((x,y), y))
putX, putY :: Int -> StateTrans ImpState ()
putX x' = ST(\(x,y)->((x',y),()))
putY y' = ST(\(x,y)->((x,y'),()))
gcdST :: StateTrans ImpState Int
gcdST = do x <- getX
y <- getY
(if x == y
then
return x
else if x < y
then
do putY (y-x)
gcdST
else
do putX (x-y)
gcdST)
greatestCommonDivisor x y = snd( applyST gcdST (x,y) )
============== Some output =========
{-
*Main> greatestCommonDivisor 24 18
6-}
====================================
Very impressive. Is this solution typical for problems where the number of times the state must be threaded is dependent on the state itself?
Michael
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://www.haskell.org/pipermail/haskell-cafe/attachments/20100916/19879c99/attachment.html
More information about the Haskell-Cafe
mailing list