4
\$\begingroup\$

I'm new to Haskell, and here is my first not-totally-trivial program. It's the first program I tend to write in any language -- a Markov text generator. I'm wondering what I can change to make it more idiomatic, or what language features I could make better use of.

import Data.List
import System.Environment
import qualified Data.Map as Map
import Control.Monad.State
import System.Random
type MarkovMap = Map.Map String String
type MarkovState = (MarkovMap, StdGen, String)
transition :: State MarkovState Char
transition = do 
 (m, gen, sofar) <- get
 let options = m Map.! sofar
 (index, newGen) = randomR (0, length options - 1) gen
 next = options !! index
 put (m, newGen, tail sofar ++ [next])
 return next
generateText :: State MarkovState Char -> State MarkovState String
generateText s = do
 x <- s
 xs <- generateText s
 return (x:xs)
getWords :: MarkovMap -> Int -> [String]
getWords m n =
 let keys = filter ((==) ' ' . last) $ Map.keys m 
 (r, gen) = randomR (0, length keys - 1) $ mkStdGen 137
 startState = keys !! r 
 markovChars = evalState (generateText transition) (m, gen, startState)
 in take n . words $ markovChars
printWords :: [String] -> IO ()
printWords ws = mapM_ putStrLn $ makeLines ws
 where makeLines [] = []
 makeLines ws = unwords (take 10 ws) : makeLines (drop 10 ws)
main :: IO ()
main = do
 (n:nwords:fileName:[]) <- getArgs
 contents <- readFile fileName
 let chainMap = chain (read n :: Int) . unwords . words $ contents
 printWords $ getWords chainMap (read nwords :: Int)
chain :: Int -> String -> Map.Map String String
chain n xs = 
 let from = map (take n) . tails $ xs ++ " " ++ xs
 to = drop n . map (:[]) $ xs ++ " " ++ take n xs
 in Map.fromListWith (++) $ zip from to

Example usage:

Keep track of the last 3 characters, take 100 words from tobeornottobe.txt

> runhaskell markov.hs 3 100 tobeornottobe.txt
delay, the law's count with who would bear things all;
and that make and sweary life; fortal shocks the hue
of returns tural consience of somethis againsolution. To die, thers
the he law's the have, or nobler retus resolence to
troublesh is noblesh is sicklied of regards of some will,
and arrows of? To beary from who would by a
life; for inst give spurns, and, but to sleep: perchan
flesh is heir thing afterprises us for no mortal shocks
turns of action devoutly to dreathe sleep: perchance thance the
ills we hue of time, to suffled of great pith
200_success
145k22 gold badges190 silver badges478 bronze badges
asked Apr 6, 2013 at 4:58
\$\endgroup\$

2 Answers 2

3
\$\begingroup\$

First of all, it seems like you never change the MarkovMap in your States. So, why don't you take it out of MarkovState and change the type of, say, transition, to MarkovMap -> State MarkovState Char?

Try to use more combinators and less pattern-matching. For example, the generate function is something like sequence . repeat.

answered Apr 6, 2013 at 19:18
\$\endgroup\$
0
1
\$\begingroup\$

The code is already quite Haskell-ish. I might have used unfoldr on plain functions instead of 'sequence' on the state monad, but that's just a matter of taste. Nevertheless, your implementation could be more efficient, as it looks up an entry of the MarkovMap for every character that is emitted. The Haskell way would be to exploit laziness, so that at most one lookup per map entry is performed. Define the map as

type MarkovMap = Map.Map String (StdGen -> String)

and you can move the map lookup into the map entries by "tying the knot". It's a bit tricky if you try to re-implement this from scratch, but you can get there by small-step refactorings of your code.

p.s.w.g
1,9712 gold badges15 silver badges30 bronze badges
answered Apr 9, 2013 at 22:35
\$\endgroup\$
0

Your Answer

Draft saved
Draft discarded

Sign up or log in

Sign up using Google
Sign up using Email and Password

Post as a guest

Required, but never shown

Post as a guest

Required, but never shown

By clicking "Post Your Answer", you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.