[Haskell-cafe] [] vs [()]
Ryan Ingram
ryani.spam at gmail.com
Fri Oct 10 09:33:02 EDT 2008
(This is a literate haskell post, save into SMM.lhs and load in ghci!)
Here's one place you might use [()] and []:
> guard :: Bool -> [()]
> guard True = [()]
> guard False = []
You can then use "guard" in monadic list computations to abort the
computation on some branches:
> sendmoney :: [[Int]]
> sendmoney = do
> choice@[s,e,n,d,m,o,r,y] <- generate 8 [0..9]
> guard (s /= 0)
> guard (m /= 0)
> guard (val [s,e,n,d] + val [m,o,r,e] == val [m,o,n,e,y])
> return choice
(evaluating this in ghci takes a little while, but it does succeed!
You can easily optimize by noticing that m must be equal to 1 and
therefore s must be 8 or 9.)
Using guard in this way works because of the definition of bind on lists:
xs >>= f = concatMap f xs = concat (map f xs)
Consider a simpler example:
> simple = do
> x <- [1,2,3]
> guard (x /= 2)
> return x
This is the same as
[1,2,3] >>= \x ->
guard (x /= 2) >>= \_ ->
return x
= mapConcat (\x -> mapConcat (\_ -> return x) (guard (x /= 2))) [1,2,3]
= concat
[ mapConcat (\_ -> return 1) (guard (1 /= 2))
, mapConcat (\_ -> return 2) (guard (2 /= 2))
, mapConcat (\_ -> return 3) (guard (3 /= 2))
]
= concat
[ mapConcat (\_ -> return 1) [()]
, mapConcat (\_ -> return 2) []
, mapConcat (\_ -> return 3) [()]
]
= concat
[ concat [ [1] ]
, concat []
, concat [ [3] ]
]
= concat [ [1], [], [3] ]
= [1,3]
Another fun example:
> double :: [()]
> double = [(), ()]
> sixteen:: Int
> sixteen = length $ do
> double
> double
> double
> double
Helper code for "send more money" follows...
> generate :: Int -> [a] -> [[a]]
> generate 0 _ = return []
> generate n as = do
> (x,xs) <- select as
> rest <- generate (n-1) xs
> return (x:rest)
> select :: [a] -> [(a,[a])]
> select [] = []
> select [x] = return (x,[])
> select (x:xs) = (x,xs) : [ (y, x:ys) | (y,ys) <- select xs ]
> val xs = val' 0 xs where
> val' v [] = v
> val' v (x:xs) = val' (10*v + x) xs
More information about the Haskell-Cafe
mailing list