Personal tools

Haskell Quiz/Text Munger/Solution Tel

From HaskellWiki

< Haskell Quiz | Text Munger(Difference between revisions)
Jump to: navigation, search
m
m
 
(3 intermediate revisions by one user not shown)
Line 16: Line 16:
 
main = getStdGen >>= evalStateT loop
 
main = getStdGen >>= evalStateT loop
   
loop :: StateT StdGen IO ()
+
loop :: (MonadState StdGen m, MonadIO m) => m ()
loop = do l <- lift getLine
+
loop = do l <- liftIO getLine
gen <- get
+
munge <- mungeLine l
let (munge, gen2) = runState (mungeLine l) gen
+
liftIO $ putStrLn munge
put gen2
+
loop
lift $ putStrLn munge
+
loop
+
mungeLine :: MonadState StdGen m => String -> m String
 
mungeLine :: String -> State StdGen String
 
 
mungeLine = liftM unwords . mapM mungeWord . words
 
mungeLine = liftM unwords . mapM mungeWord . words
   
mungeWord :: String -> State StdGen String
+
mungeWord :: MonadState StdGen m => String -> m String
mungeWord str = do gen <- get
+
mungeWord str = do (randPairs :: [(Int, Char)]) <- zipWithRand (,) mid
let (randPairs :: [(Int, Char)], gen2) = runState (zipWithRand (,) mid) gen
+
return (first ++ map snd (sortBy (comparing fst) randPairs) ++ last)
put gen2
 
return ([first]++(map snd $ sortBy (comparing fst) randPairs)++last)
 
 
where (first, mid, last) = splitEnds str
 
where (first, mid, last) = splitEnds str
   
splitEnds :: Eq a => [a] -> (a, [a], [a])
+
splitEnds :: Eq a => [a] -> ([a], [a], [a])
splitEnds (x:[]) = (x, [], [])
+
splitEnds (x:[]) = ([x], [], [])
splitEnds xs = (head xs, (init . tail) xs, [last xs])
+
splitEnds xs = ([head xs], (init . tail) xs, [last xs])
   
 
-- zip across a list, passing a (Random t => t) in
 
-- zip across a list, passing a (Random t => t) in
zipWithRand :: (Random a) => (a -> b -> c) -> [b] -> State StdGen [c]
+
zipWithRand :: (Random a, MonadState StdGen m) => (a -> b -> c) -> [b] -> m [c]
zipWithRand fn xs = do rands <- sequence $ map (const randomST) xs
+
zipWithRand fn xs = do rands <- mapM (const randomST) xs
 
return $ zipWith fn rands xs
 
return $ zipWith fn rands xs
   
-- random promoted inside the State monad for threading the StdGen
+
-- random promoted inside some MonadState for threading the StdGen
randomST :: Random a => State StdGen a
+
randomST :: (MonadState StdGen m, Random a) => m a
 
randomST = do gen <- get
 
randomST = do gen <- get
 
let (x, gen2) = random gen
 
let (x, gen2) = random gen
 
put gen2
 
put gen2
return x
+
return x</haskell>
</haskell>
 

Latest revision as of 06:04, 21 February 2010


A somewhat naive solution using State transformers to pass StdGen through the process. Doesn't handle punctuation correctly.

{-# OPTIONS -fglasgow-exts #-}
 
module Main where
 
import System.Random
import Data.Ord (comparing)
import Data.List (sortBy)
import Control.Monad.State.Lazy
 
main :: IO ()
main = getStdGen >>= evalStateT loop
 
loop :: (MonadState StdGen m, MonadIO m) => m ()
loop = do l <- liftIO getLine
          munge <- mungeLine l
          liftIO $ putStrLn munge
          loop
 
mungeLine :: MonadState StdGen m => String -> m String
mungeLine = liftM unwords . mapM mungeWord . words
 
mungeWord :: MonadState StdGen m => String -> m String
mungeWord str = do (randPairs :: [(Int, Char)]) <- zipWithRand (,) mid
                   return (first ++ map snd (sortBy (comparing fst) randPairs) ++ last)
    where (first, mid, last) = splitEnds str
 
splitEnds :: Eq a => [a] -> ([a], [a], [a])
splitEnds (x:[]) = ([x], [], [])
splitEnds xs = ([head xs], (init . tail) xs, [last xs]) 
 
-- zip across a list, passing a (Random t => t) in
zipWithRand :: (Random a, MonadState StdGen m) => (a -> b -> c) -> [b] -> m [c]
zipWithRand fn xs = do rands <- mapM (const randomST) xs 
                       return $ zipWith fn rands xs
 
-- random promoted inside some MonadState for threading the StdGen
randomST :: (MonadState StdGen m, Random a) => m a
randomST = do gen <- get
              let (x, gen2) = random gen
              put gen2
              return x