Difference between revisions of "Haskell Quiz/Text Munger/Solution Tel"
< Haskell Quiz | Text Munger
Jump to navigation
Jump to search
m |
m |
||
(One intermediate revision by one other user not shown) | |||
Line 26: | Line 26: | ||
mungeWord :: MonadState StdGen m => String -> m String |
mungeWord :: MonadState StdGen m => String -> m String |
||
− | mungeWord str = do |
+ | mungeWord str = do (randPairs :: [(Int, Char)]) <- zipWithRand (,) mid |
− | let (randPairs :: [(Int, Char)]) = evalState (zipWithRand (,) mid) gen |
||
return (first ++ map snd (sortBy (comparing fst) randPairs) ++ last) |
return (first ++ map snd (sortBy (comparing fst) randPairs) ++ last) |
||
where (first, mid, last) = splitEnds str |
where (first, mid, last) = splitEnds str |
||
Line 37: | Line 36: | ||
-- zip across a list, passing a (Random t => t) in |
-- zip across a list, passing a (Random t => t) in |
||
zipWithRand :: (Random a, MonadState StdGen m) => (a -> b -> c) -> [b] -> m [c] |
zipWithRand :: (Random a, MonadState StdGen m) => (a -> b -> c) -> [b] -> m [c] |
||
− | zipWithRand fn xs = do rands <- |
+ | zipWithRand fn xs = do rands <- mapM (const randomST) xs |
return $ zipWith fn rands xs |
return $ zipWith fn rands xs |
||
Line 45: | Line 44: | ||
let (x, gen2) = random gen |
let (x, gen2) = random gen |
||
put gen2 |
put gen2 |
||
− | return x |
+ | return x</haskell> |
− | |||
− | -- split promoted inside some MonadState for generating new a StdGen |
||
− | splitST :: MonadState StdGen m => m StdGen |
||
− | splitST = do gen <- get |
||
− | let (newgen, gen2) = split gen |
||
− | put gen2 |
||
− | return newgen |
||
− | </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