Markov algorithm simulator (Haskell)

From LiteratePrograms

Other implementations: Haskell | Ocaml | Python

The following is an implementation of a Markov Algorithm system written in Haskell.

First we create a new module named Markov.

<<Markov.hs>>=
module Markov where
Markov

Three functions from the List module will be needed: isPrefixOf, find and \\.

<<Markov>>=
import List

A Markov algorithm is a string rewriting system consisting of rewrite rules. Each rule is a triple consisting of the word to match, the word to use as a replacement and a boolean flag. If the flag is true then the rule is a halting rule.

<<Markov>>=
type Rule = (Word, Word, Bool)
type Algor = [Rule]
type Word = [Char]

The successor algorithm is encoded as a list of rules.

<<Markov>>=
successor = [("aL", "La", False),
             ("a0", "0a", False),
             ("a" , "b" , False),
             ("Lb", "b0", False),
             ("0b", "L" , True ),
             ("b" , "L" , True ),
             (""  , "a" , False)]

The contains function returns true if the second argument is a substring of the first argument. The list module function isPrefixOf is used to test if the first argument starts with the second argument, if it does not then the tail of the first argument is recursively checked.

<<Markov>>=
contains :: Word -> Word -> Bool
contains s@(x:xs) sub = sub `isPrefixOf` s || xs `contains` sub
contains [] _ = False

The findRule function takes a list of Rules and a Word and returns the first Rule that matches. The contains function defined above is used to test for the match. The return value is wrapped in the Maybe datatype (as returned by the find function), if no matching rule is found then Nothing is returned.

<<Markov>>=
findRule :: Algor -> Word -> Maybe Rule
findRule a w = find (\(l,_,_) -> w `contains` l) a

The applyRule function applies a single Rule to a Word. This function searches the Word until it matches the left side of the rule. Once the match is found the text is replaced with the right side of the rule and the resulting Word is returned.

<<Markov>>=
applyRule :: Rule -> Word -> Word
applyRule (l,r,b) s@(x:xs) | l `isPrefixOf` s = r ++ (s \\ l)
                           | otherwise        = x : applyRule (l,r,b) xs

The applyAlg function takes a list of Rules and a Word and applies the first matching Rule. The findRule function is used to find the first matching rule then the applyRule function is used to apply the rule. A pair is returned containing the resulting Word and a Bool flag, the flag is True if the rule that was applied was a halting rule. Nothing is returned if no rule matches.

  
<<Markov>>=
applyAlg :: Algor -> Word -> Maybe (Word, Bool)
applyAlg a w = case findRule a w of 
               Just r@(_,_,b) -> Just (applyRule r w, b)
               Nothing        -> Nothing

The run function applies the Markov algorithm continuously until either a halting rule is matched or no rule is matched. The word sequence that results from applying the algorithm is returned. This function calls itself recursivley with the result of the previous call to applyAlg.

       
<<Markov>>=                            
run :: Algor -> Word -> [Word]
run a w = case applyAlg a w of
          Just (w', False) -> w : run a w'  -- Normal rule was applied
          Just (w', True)  -> [w, w']       -- Halting rule was applied
          Nothing          -> [w]           -- No rule was applied                

When the command run successor "L0LL" is executed in GHCI the following output is produced.

["L0LL","aL0LL","La0LL","L0aLL","L0LaL","L0LLa","L0LLb","L0Lb0","L0b00","LL00"]

Download code