Markov Chain in Haskell

Chain.hs

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"]

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.

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))

I made a fork of this to provide some algorithmic and stylistic feedback: see here (along with the accompanying comment).