(* A sample of Markov Algorithms *) (* First, the implemenation. You may want to jump directly to examples below *) (* pattern final replacement *) type rule = string * bool * string (* Search for the first occurrence of a pat in a string Return the position of that occurrence within the string, or None *) let ssearch : string -> string -> int option = fun p s -> let rec loop (pi:int) (si:int) = if pi = String.length p then Some si else if si + pi = String.length s then None else if p.[pi] = s.[si + pi] then loop (pi + 1) si else loop 0 (si + 1) in loop 0 0 (* Run the algorithm, given a rulesequence and the string *) let run : rule array -> string -> string = fun rules str -> Printf.printf "\n(start) %s\n" str; let rec loop : int -> string -> string = fun idx str -> if idx >= Array.length rules then begin Printf.printf "(no match) %s\n" str; str end else let (pat,final,repl) = rules.(idx) in match ssearch pat str with | None -> loop (idx+1) str | Some pos -> let len = String.length pat in let str' = String.sub str 0 pos ^ repl ^ String.sub str (pos+len) (String.length str - pos - len) in Printf.printf "(%d%s) %s\n" idx (if final then " final" else "") str'; if final then str' else loop 0 str' in loop 0 str (* A helper to make writing rules easier *) let rule ?(final=false) str replacement = (str,final,replacement) (* Examples *) (* Ruleset 1 from Wikipedia *) let rwiki1 = [| rule "A" "apple"; rule "B" "bag"; rule "S" "shop"; rule "T" "the"; rule "the shop" "my brother"; |];; let _ = run rwiki1 "I bought a B of As from T S." (* (start) I bought a B of As from T S. (0) I bought a B of apples from T S. (1) I bought a bag of apples from T S. (2) I bought a bag of apples from T shop. (3) I bought a bag of apples from the shop. (4) I bought a bag of apples from my brother. (no match) I bought a bag of apples from my brother. - : string = "I bought a bag of apples from my brother." *) let _ = run [| rule "A" "apple"; rule "B" "bag"; rule "S" "shop" ~final:true; rule "T" "the"; rule "the shop" "my brother"; |] "I bought a B of As from T S." (* (start) I bought a B of As from T S. (0) I bought a B of apples from T S. (1) I bought a bag of apples from T S. (2 final) I bought a bag of apples from T shop. - : string = "I bought a bag of apples from T shop." *) (* Big endian binary to unary *) let bin_to_unary = [| rule "1" "0|"; rule "|0" "0||"; rule "0" ""; |] let _ = run bin_to_unary "0" let _ = run bin_to_unary "1" let _ = run bin_to_unary "10" let _ = run bin_to_unary "11" let _ = run bin_to_unary "100" let _ = run bin_to_unary "110" (* (start) 110 (0) 0|10 (0) 0|0|0 (1) 00|||0 (1) 00||0|| (1) 00|0|||| (1) 000|||||| (2) 00|||||| (2) 0|||||| (2) |||||| (no match) |||||| - : string = "||||||" *) (* Compare with the corresponding TM, see below *) let unary_addition = [| rule "#" "" ~final:true |] let _ = run unary_addition "##" let _ = run unary_addition "11##" let _ = run unary_addition "#11#" let _ = run unary_addition "11#111#" (* Again compare with the corresponding TM *) let unary_subtraction = [| rule "1#1" "#"; rule "##" "#"; rule "#1" "#" |] let _ = run unary_subtraction "##" (* 0-0 *) let _ = run unary_subtraction "11##" (* 2-0 *) let _ = run unary_subtraction "#11#" (* 0-2 *) let _ = run unary_subtraction "1111#1#" (* 4-1 *) (* (start) 1111#1# (0) 111## (1) 111# (no match) 111# - : string = "111#" *) let _ = run unary_subtraction "1111#11#" let _ = run unary_subtraction "1111#111#" let _ = run unary_subtraction "1111#1111#" let _ = run unary_subtraction "1111#11111#" (* 4-5 *) (* (start) 1111#11111# (0) 111#1111# (0) 11#111# (0) 1#11# (0) #1# (2) ## (1) # (no match) # - : string = "#" (* that is, 0 *) *) (* Emulating TM that does unary addition input: '111#11#' blank: ' ' start state: q0 table: q0: '1': {write: 1, R: q0} '#': {write: '#', R: q1} q1: '#': {write: ' ', R: stop} '1': {write: 1, L: q3} q3: '#': {write: 1, R: q4} q4: '1': {write: 1, R: q4} '#': {write: ' ', L: q5} q5: '1': {write: '#', R: stop} *) let tm_unary_addition = [| rule "1" "1"; rule "#" "#"; rule "#" " "; rule "#1" "#1"; rule "11" "11"; rule " 1" " 1"; rule "1" " 1"; rule "#" "1"; rule "1" "1"; rule "##" "# "; rule "1#" "1 "; rule " #" " "; rule "#" " "; rule "1" "#"; |] let _ = run tm_unary_addition "##" (* 0+0 *) let _ = run tm_unary_addition "11##" (* 2+0 *) let _ = run tm_unary_addition "#11#" (* 0+2 *) let _ = run tm_unary_addition "11#111#" (* 2+3 *) (* (start) 11#111# (0) 11#111# (0) 11#111# (1) 11#111# (3) 11#111# (7) 111111# (8) 111111# (8) 111111# (8) 111111# (10) 111111 (13) 11111# (no match) 11111# - : string = "11111# " *) (* gcd *) let gcd = [| rule "aA" "Aa"; rule "a#a" "A#"; rule "a#" "#B"; rule "B" "a"; rule "A" "C"; rule "C" "a"; rule "#" ""; |] let _ = run gcd "#aa" (* gcd 0 2 *) (* (start) #aa (6) aa (no match) aa - : string = "aa" *) let _ = run gcd "aaa#aa" (* gcd 3 2 *) (* (start) aaa#aa (1) aaA#a (0) aAa#a (0) Aaa#a (1) AaA# (0) AAa# (2) AA#B (3) AA#a (4) CA#a (4) CC#a (5) aC#a (5) aa#a (1) aA# (0) Aa# (2) A#B (3) A#a (4) C#a (5) a#a (1) A# (4) C# (5) a# (2) #B (3) #a (6) a (no match) a - : string = "a" *) let _ = run gcd "aaaaaa#aaaaaaaa" (* gcd 6 8 *) (* - : string = "aa" *) ;;