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"] |
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:
Build FAILED
/Users/jfuentes/code/oss/swim/markov.hs: line 11, column 53:
Warning: Redundant bracket
Found:
(tail p) ++ [w]
Why not:
tail p ++ [w]
/Users/jfuentes/code/oss/swim/markov.hs: line 12, column 18:
Warning: Redundant bracket
Found:
(insertWith (++) (unwords prefix) [head ws] c)
Why not:
insertWith (++) (unwords prefix) [head ws] c
/Users/jfuentes/code/oss/swim/markov.hs: line 13, column 18:
Warning: Redundant bracket
Found:
(Chain m l)
Why not:
Chain m l
/Users/jfuentes/code/oss/swim/markov.hs: line 18, column 3:
Warning: Redundant bracket
Found:
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)
Why not:
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)
/Users/jfuentes/code/oss/swim/markov.hs: line 18, column 3:
Warning: Redundant bracket
Found:
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)
Why not:
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)
/Users/jfuentes/code/oss/swim/markov.hs: line 21, column 60:
Warning: Redundant bracket
Found:
(tail ws) ++ [choice]
Why not:
tail ws ++ [choice]
/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))
/Users/jfuentes/code/oss/swim/markov.hs: line 29, column 8:
Warning: Redundant bracket
Found:
do let c = (build
["", "a", "man", "a", "plan", "a", "canal", "panama"]
[]
(Chain empty 1))
out <- (generate 10 c [""])
print out
Why not:
do let c = build
["", "a", "man", "a", "plan", "a", "canal", "panama"]
[]
(Chain empty 1)
out <- (generate 10 c [""])
print out
/Users/jfuentes/code/oss/swim/markov.hs: line 29, column 8:
Warning: Redundant bracket
Found:
do let c = (build
["", "a", "man", "a", "plan", "a", "canal", "panama"]
[]
(Chain empty 1))
out <- (generate 10 c [""])
print out
Why not:
do let c = (build
["", "a", "man", "a", "plan", "a", "canal", "panama"]
[]
(Chain empty 1))
out <- generate 10 c [""]
print out
In short: you should drop a bunch of empty "brackets."
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
xs ++ [x]
,length
and!!
are O(n) operations for lists (though appending an element to the front is O(1)), perhaps it would be worthwhile to take a look at Data.Sequence as it has much better amortized time for the operations you're doing here.