Markov algorithm simulator (Ocaml)

From LiteratePrograms

Jump to: navigation, search
Other implementations: Haskell | Ocaml | Python

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


You will need to load the Str (regular expressions) library somehow, which is usually given as an option to the compiler. The following directive will load it while in the toplevel interpreter.

#load "str.cma";;
open Str

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.

type word = string
type rule = word * word * bool
type algor = rule list

The successor algorithm is encoded as a list of rules.

let 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.

let rec contains (s:string) (sub:string) : bool =
    ignore(search_forward (regexp_string sub) s 0);
  with Not_found -> false

The find_rule 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. If no matching rule is found then the exception Not_found is raised.

let find_rule (a:algor) (w:word) : rule =
  List.find (fun (l,_,_) -> contains w l) a

The apply_rule 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.

let apply_rule (l,r,_:rule) (s:word) : word =
  replace_first (regexp_string l) r s

The apply_alg function takes a list of rules and a word and applies the first matching rule. The find_rule function is used to find the first matching rule then the apply_rule 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. Not_found is raised if no rule matches.

let apply_alg (a:algor) (w:word) : word * bool =
  let _,_,b as r = find_rule a w in
  apply_rule r w, b

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 recursively with the result of the previous call to apply-alg.

let rec run (a:algor) (w:word) : word list =
  try let w', flg = apply_alg a w in
    if not flg then w :: run a w' (* Normal rule was applied *)
    else            [w; w']       (* Halting rule was applied *)
  with Not_found -> [w]           (* No rule was applied *)


# run successor "L0LL";;
- : word list =
["L0LL"; "aL0LL"; "La0LL"; "L0aLL"; "L0LaL"; "L0LLa"; "L0LLb"; "L0Lb0";
 "L0b00"; "LL00"]
Download code