(* 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"
*)
;;