Last active
August 29, 2015 14:05
-
-
Save mrb/dafcda4479cf330e02d6 to your computer and use it in GitHub Desktop.
Markov Chain in Haskell
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
module Chain where | |
import Data.Map.Strict(Map,insertWith,empty,member,(!)) | |
import System.Random(randomRIO) | |
data Chain = Chain (Map String [String]) Int deriving (Show) | |
build :: [String] -> [String] -> Chain -> Chain | |
build [] _ chain = chain | |
build [_] _ chain = chain | |
build (w:ws) p (Chain c l) = | |
let prefix = if length p < l then p ++ [w] else (tail p) ++ [w] | |
m = (insertWith (++) (unwords prefix) [head ws] c) | |
chain = (Chain m l) in | |
build ws prefix chain | |
generate :: Int -> Chain -> [String] -> IO [String] | |
generate 0 _ _ = return [] | |
generate n (Chain c l) ws = | |
do | |
let k = (unwords ws) | |
choice <- if member k c then pick (c ! k) else return [] | |
let prefix = if length ws < l then ws ++ [choice] else (tail ws) ++ [choice] | |
next <- (generate (n - 1) (Chain c l) prefix) | |
return (choice:next) | |
pick :: [a] -> IO a | |
pick xs = randomRIO (0, length xs - 1) >>= return . (xs !!) | |
main :: IO () | |
main = do | |
let c = (build ["", "a", "man", "a", "plan", "a", "canal", "panama"] [] (Chain empty 1)) | |
out <- (generate 10 c [""]) | |
print out | |
-- ["a","plan","a","plan","a","man","a","man","a","plan"] |
Here's the change after removing redundant brackets:
module Chain where
import Data.Map.Strict(Map,insertWith,empty,member,(!))
import System.Random(randomRIO)
data Chain = Chain (Map String [String]) Int deriving (Show)
build :: [String] -> [String] -> Chain -> Chain
build [_] _ chain = chain
build (w:ws) p (Chain c l) = build ws prefix chain
where prefix = if length p < l then p ++ [w] else tail p ++ [w]
m = insertWith (++) (unwords prefix) [head ws] c
chain = Chain m l
generate :: Int -> Chain -> [String] -> IO [String]
generate 0 _ _ = return []
generate n (Chain c l) ws =
do
let k = unwords ws
choice <- if member k c then pick (c ! k) else return []
let prefix = if length ws < l then ws ++ [choice] else tail ws ++ [choice]
next <- generate (n - 1) (Chain c l) prefix
return (choice:next)
pick :: [a] -> IO a
pick xs = randomRIO (0, length xs - 1) >>= return . (xs !!)
main :: IO ()
main = do
let c = build ["", "a", "man", "a", "plan", "a", "canal", "panama"] [] (Chain empty 1)
out <- generate 10 c [""]
print out
Then, ghc-mod
tells us:
/Users/jfuentes/code/oss/swim/markov.hs: line 26, column 11:
Warning: Use liftM
Found:
randomRIO (0, length xs - 1) >>= return . (xs !!)
Why not:
Control.Monad.liftM (xs !!) (randomRIO (0, length xs - 1))
So, let's change that:
import Control.Monad (liftM)
pick :: [a] -> IO a
pick xs = liftM (xs !!) (randomRIO (0, length xs - 1))
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
What editor are you using?
ghc-mod
has integration for Sublime via SublimeHaskell, vim, and Emacs. It will lint and do other nice things to your file.Here's some output from linting:
In short: you should drop a bunch of empty "brackets."