Sync

Task/Execute-a-Markov-algorithm/Common-Lisp/execute-a-markov-algorithm-1.lisp

@@ -0,0 +1,68 @@
+;;; Keeps track of all our rules
+(defclass markov ()
+  ((rules :initarg :rules :initform nil :accessor rules)))
+
+;;; Definition of a rule
+(defclass rule ()
+  ((pattern :initarg :pattern :accessor pattern)
+   (replacement :initarg :replacement :accessor replacement)
+   (terminal :initform nil :initarg :terminal :accessor terminal)))
+
+;;; Parse a rule with this regular expression
+(defparameter *rex->* (compile-re "^(.+)(?: |\\t)->(?: |\\t)(\\.?)(.*)$"))
+
+;;; Create a rule and add it to the markov object
+(defmethod update-markov ((mkv markov) lhs terminating rhs)
+  (setf (rules mkv) (cons
+                     (make-instance 'rule :pattern lhs :replacement rhs :terminal terminating)
+                     (rules mkv))))
+
+;;; Parse a line and add it to the markov object
+(defmethod parse-line ((mkv markov) line)
+  (let ((trimmed (string-trim #(#\Space #\Tab) line)))
+    (if (not (or
+              (eql #\# (aref trimmed 0))
+              (equal "" trimmed)))
+        (let ((vals (multiple-value-list (match-re *rex->* line))))
+          (if (not (car vals))
+              (progn
+                (format t "syntax error in ~A" line)
+                (throw 'fail t)))
+          (update-markov mkv (nth 2 vals) (equal "." (nth 3 vals)) (nth 4 vals))))))
+
+;;; Make a markov object from the string of rules
+(defun make-markov (rules-text)
+  (catch 'fail
+         (let ((mkv (make-instance 'markov)))
+           (with-input-from-string (s rules-text)
+             (loop for line = (read-line s nil)
+                 while line do
+                   (parse-line mkv line)))
+           (setf (rules mkv) (reverse (rules mkv)))
+           mkv)))
+
+;;; Given a rule and bounds where it applies, apply it to the input text
+(defun adjust (rule-info text)
+  (let* ((rule (car rule-info))
+         (index-start (cadr rule-info))
+         (index-end (caddr rule-info))
+         (prefix (subseq text 0 index-start))
+         (suffix (subseq text index-end))
+         (replace (replacement rule)))
+    (concatenate 'string prefix replace suffix)))
+
+;;; Get the next applicable rule or nil if none
+(defmethod get-rule ((markov markov) text)
+  (dolist (rule (rules markov) nil)
+    (let ((index (search (pattern rule) text)))
+      (if index
+          (return (list rule index (+ index (length (pattern rule)))))))))
+
+;;; Interpret text using a markov object
+(defmethod interpret ((markov markov) text)
+  (let ((rule-info (get-rule markov text))
+        (ret text))
+    (loop (if (not rule-info) (return ret))
+          (setf ret (adjust rule-info ret))
+          (if (terminal (car rule-info)) (return ret))
+          (setf rule-info (get-rule markov ret)))))

Task/Execute-a-Markov-algorithm/Common-Lisp/execute-a-markov-algorithm-2.lisp

@@ -0,0 +1,27 @@
+(defparameter
+    *rules1*
+"# This rules file is extracted from Wikipedia:
+# http://en.wikipedia.org/wiki/Markov_Algorithm
+A -> apple
+B -> bag
+S -> shop
+T -> the
+the shop -> my brother
+a never used -> .terminating rule")
+
+;;; Lots of other defparameters for rules omitted here...
+
+(defun test ()
+  (format t "~A~%" (interpret (make-markov *rules1*) "I bought a B of As from T S."))
+  (format t "~A~%" (interpret (make-markov *rules2*) "I bought a B of As from T S."))
+  (format t "~A~%" (interpret (make-markov *rules3*) "I bought a B of As W my Bgage from T S."))
+  (format t "~A~%" (interpret (make-markov *rules4*) "_1111*11111_"))
+  (format t "~A~%" (interpret (make-markov *rules5*) "000000A000000"))
+  )
+(test)
+I bought a bag of apples from my brother.
+I bought a bag of apples from T shop.
+I bought a bag of apples with my money from T shop.
+11111111111111111111
+00011H1111000
+NIL

Task/Execute-a-Markov-algorithm/D/execute-a-markov-algorithm.d

@@ -1,26 +1,27 @@
-import std.stdio, std.array, std.file, std.regex, std.string,
-       std.range;
-
 void main() {
-    string[][] rules = readText("markov_rules.txt").splitLines()
-                       .split("");
-    auto tests = readText("markov_tests.txt").splitLines();
-    auto re = ctRegex!(r"^([^#]*?)\s+->\s+(\.?)(.*)"); // 130 MB RAM.
+    import std.stdio, std.file, std.regex, std.string, std.range,
+           std.functional;
 
-    auto pairs = zip(StoppingPolicy.requireSameLength, tests, rules);
-    foreach (test, rule; pairs) {
-        auto origTest = test.dup;
+    const rules = "markov_rules.txt".readText.splitLines.split("");
+    auto tests = "markov_tests.txt".readText.splitLines;
+    auto re = ctRegex!(r"^([^#]*?)\s+->\s+(\.?)(.*)"); // 160 MB RAM.
+
+    alias slZip = curry!(zip, StoppingPolicy.requireSameLength);
+    foreach (test, const rule; slZip(tests, rules)) {
+        const origTest = test.dup;
 
         string[][] capt;
-        foreach (line; rule) {
+        foreach (const line; rule) {
             auto m = line.match(re);
-            if (!m.empty)
-                capt ~= m.captures.array()[1 .. $];
+            if (!m.empty) {
+                //capt.put(m.captures.dropOne);
+                capt ~= m.captures.dropOne.array;
+            }
         }
 
     REDO:
-        auto copy = test;
-        foreach (c; capt) {
+        const copy = test;
+        foreach (const c; capt) {
             test = test.replace(c[0], c[2]);
             if (c[1] == ".")
                 break;

Task/Execute-a-Markov-algorithm/Deja-Vu/execute-a-markov-algorithm.djv

@@ -0,0 +1,47 @@
+(remove-comments) text:
+	]
+	for line in text:
+		if and line not starts-with line "#":
+			line
+	[
+
+(markov-parse) text:
+	]
+	for line in text:
+		local :index find line " -> "
+		local :pat slice line 0 index
+		local :rep slice line + index 4 len line
+		local :term starts-with rep "."
+		if term:
+			set :rep slice rep 1 len rep
+		& pat & term rep
+	[
+
+markov-parse:
+	]
+	while dup input:
+		pass
+	[
+	(markov-parse) (remove-comments)
+
+(markov-tick) rules start:
+	for rule in copy rules:
+		local :pat &< rule
+		local :rep &> dup &> rule
+		local :term &<
+		local :index find start pat
+		if < -1 index:
+			)
+			slice start + index len pat len start
+			rep
+			slice start 0 index
+			concat(
+			return term
+	true start
+
+markov rules:
+	true
+	while:
+		not (markov-tick) rules
+
+markov markov-parse

Task/Execute-a-Markov-algorithm/Lua/execute-a-markov-algorithm.lua

@@ -0,0 +1,185 @@
+-- utility method to escape punctuation
+function normalize(str)
+	local result = str:gsub("(%p)", "%%%1")
+	-- print(result)
+	return result
+end
+
+-- utility method to split string into lines
+function get_lines(str)
+	local t = {}
+	for line in str:gmatch("([^\n\r]*)[\n\r]*") do
+		table.insert(t, line)
+	end
+	return t
+end
+
+local markov = {}
+local MARKOV_RULE_PATTERN = "(.+)%s%-%>%s(%.?)(.*)"
+
+function markov.rule(pattern,replacement,terminating)
+	return {
+		pattern = pattern,
+		replacement = replacement,
+		terminating = (terminating == ".")
+	}, normalize(pattern)
+end
+
+function markov.make_rules(sample)
+	local lines = get_lines(sample)
+	local rules = {}
+	local finders = {}
+	for i,line in ipairs(lines) do
+		if not line:find("^#") then
+		s,e,pat,term,rep = line:find(MARKOV_RULE_PATTERN)
+		if s then
+			r, p = markov.rule(pat,rep,term)
+			rules[p] = r
+			table.insert(finders, p)
+		end
+		end
+	end
+	return {
+		rules = rules,
+		finders = finders
+	}
+end
+
+function markov.execute(state, sample_input)
+
+local rules, finders = state.rules, state.finders
+local found = false -- did we find any rule?
+local terminate = false
+
+repeat
+found = false
+
+for i,v in ipairs(finders) do
+	local found_now = false -- did we find this rule?
+	if sample_input:find(v) then
+		found = true
+		found_now = true
+	end
+	sample_input = sample_input:gsub(v, rules[v].replacement, 1)
+	-- handle terminating rules
+	if found_now then
+		if rules[v].terminating then terminate = true end
+		break
+	end
+end
+
+until not found or terminate
+
+return sample_input
+end
+------------------------------------------
+------------------------------------------
+
+local grammar1 = [[
+# This rules file is extracted from Wikipedia:
+# http://en.wikipedia.org/wiki/Markov_Algorithm
+A -> apple
+B -> bag
+S -> shop
+T -> the
+the shop -> my brother
+a never used -> .terminating rule
+]]
+
+local grammar2 = [[
+# Slightly modified from the rules on Wikipedia
+A -> apple
+B -> bag
+S -> .shop
+T -> the
+the shop -> my brother
+a never used -> .terminating rule
+]]
+
+local grammar3 = [[
+# BNF Syntax testing rules
+A -> apple
+WWWW -> with
+Bgage -> ->.*
+B -> bag
+->.* -> money
+W -> WW
+S -> .shop
+T -> the
+the shop -> my brother
+a never used -> .terminating rule
+]]
+
+local grammar4 = [[
+### Unary Multiplication Engine, for testing Markov Algorithm implementations
+### By Donal Fellows.
+# Unary addition engine
+_+1 -> _1+
+1+1 -> 11+
+# Pass for converting from the splitting of multiplication into ordinary
+# addition
+1! -> !1
+,! -> !+
+_! -> _
+# Unary multiplication by duplicating left side, right side times
+1*1 -> x,@y
+1x -> xX
+X, -> 1,1
+X1 -> 1X
+_x -> _X
+,x -> ,X
+y1 -> 1y
+y_ -> _
+# Next phase of applying
+1@1 -> x,@y
+1@_ -> @_
+,@_ -> !_
+++ -> +
+# Termination cleanup for addition
+_1 -> 1
+1+_ -> 1
+_+_ ->
+]]
+
+local grammar5 = [[
+# Turing machine: three-state busy beaver
+#
+# state A, symbol 0 => write 1, move right, new state B
+A0 -> 1B
+# state A, symbol 1 => write 1, move left, new state C
+0A1 -> C01
+1A1 -> C11
+# state B, symbol 0 => write 1, move left, new state A
+0B0 -> A01
+1B0 -> A11
+# state B, symbol 1 => write 1, move right, new state B
+B1 -> 1B
+# state C, symbol 0 => write 1, move left, new state B
+0C0 -> B01
+1C0 -> B11
+# state C, symbol 1 => write 1, move left, halt
+0C1 -> H01
+1C1 -> H11
+]]
+
+local text1 = "I bought a B of As from T S."
+local text2 = "I bought a B of As W my Bgage from T S."
+local text3 = '_1111*11111_'
+local text4 = '000000A000000'
+
+------------------------------------------
+------------------------------------------
+
+function do_markov(rules, input, output)
+	local m = markov.make_rules(rules)
+	input = markov.execute(m, input)
+	assert(input == output)
+	print(input)
+end
+
+do_markov(grammar1, text1, 'I bought a bag of apples from my brother.')
+do_markov(grammar2, text1, 'I bought a bag of apples from T shop.')
+-- stretch goals
+do_markov(grammar3, text2, 'I bought a bag of apples with my money from T shop.')
+do_markov(grammar4, text3, '11111111111111111111')
+do_markov(grammar5, text4, '00011H1111000')

Task/Execute-a-Markov-algorithm/OCaml/execute-a-markov-algorithm.ocaml

@@ -0,0 +1,48 @@
+(* Useful for resource cleanup (such as filehandles) *)
+let try_finally x f g =
+  try let res = f x in g x; res
+  with e -> g x; raise e
+
+(* Substitute string 'b' for first occurance of regexp 'a' in 's';
+ * Raise Not_found if there was no occurance of 'a'. *)
+let subst a b s =
+  ignore (Str.search_forward a s 0); (* to generate Not_found *)
+  Str.replace_first a b s
+
+let parse_rules cin =
+  let open Str in
+  let rule = regexp "\\(.+\\)[ \t]+->[ \t]+\\(.*\\)" in
+  let leader s c = String.length s > 0 && s.[0] = c in
+  let parse_b s = if leader s '.' then (string_after s 1,true) else (s,false) in
+  let rec parse_line rules =
+    try
+      let s = input_line cin in
+      if leader s '#' then parse_line rules
+      else if string_match rule s 0 then
+        let a = regexp_string (matched_group 1 s) in
+        let b,terminate = parse_b (matched_group 2 s) in
+        parse_line ((a,b,terminate)::rules)
+      else failwith ("parse error: "^s)
+    with End_of_file -> rules
+  in List.rev (parse_line [])
+
+let rec run rules text =
+  let rec apply s = function
+    | [] -> s
+    | (a,b,term)::next ->
+        try
+          let s' = subst a b s in
+          if term then s' else run rules s'
+        with Not_found -> apply s next
+  in apply text rules
+
+let _ =
+  if Array.length Sys.argv <> 2 then
+    print_endline "Expecting one argument: a filename where rules can be found."
+  else
+    let rules = try_finally (open_in Sys.argv.(1)) parse_rules close_in in
+    (* Translate lines read from stdin, until EOF *)
+    let rec translate () =
+      print_endline (run rules (input_line stdin));
+      translate ()
+    in try translate () with End_of_file -> ()

Task/Execute-a-Markov-algorithm/Perl-6/execute-a-markov-algorithm.pl6

@@ -0,0 +1,65 @@
+grammar Markov {
+    token TOP {
+        ^ [^^ [<rule> | <comment>] $$ [\n|$]]* $
+        { make $<rule>>>.ast }
+    }
+    token comment {
+        <before ^^> '#' \N*
+        { make Nil }
+    }
+    token ws {
+        [' '|\t]*
+    }
+    rule rule {
+        <before ^^>$<pattern>=[\N+?] '->'
+        $<terminal>=[\.]?$<replacement>=[\N*]
+        { make {:pattern($<pattern>.Str),
+                :replacement($<replacement>.Str),
+                :terminal($<terminal>.Str eq ".")} }
+    }
+}
+
+sub run(:$ruleset, :$start_value, :$verbose?) {
+    my $value = $start_value;
+    my @rules = Markov.parse($ruleset).ast.list;
+    loop {
+        my $beginning = $value;
+        for @rules {
+            my $prev = $value;
+            $value = $value.subst(.<pattern>, .<replacement>);
+            say $value if $verbose && $value ne $prev;
+            return $value if .<terminal>;
+            last if $value ne $prev;
+        }
+        last if $value eq $beginning;
+    }
+    return $value;
+}
+
+multi sub MAIN(Bool :$verbose?) {
+    my @rulefiles = dir.grep(/rules.+/).sort;
+    for @rulefiles -> $rulefile {
+        my $testfile = $rulefile.subst("rules", "test");
+        my $start_value = (try slurp($testfile).trim-trailing)
+                          // prompt("please give a start value: ");
+
+        my $ruleset = slurp($rulefile);
+        say $start_value.perl();
+        say run(:$ruleset, :$start_value, :$verbose).perl;
+        say;
+    }
+}
+
+multi sub MAIN(Str $rulefile where *.IO.f, Str $input where *.IO.f, Bool :$verbose?) {
+    my $ruleset = slurp($rulefile);
+    my $start_value = slurp($input).trim-trailing;
+    say "starting with $start_value.perl()";
+    say run(:$ruleset, :$start_value, :$verbose).perl;
+}
+
+multi sub MAIN(Str $rulefile where *.IO.f, *@pieces, Bool :$verbose?) {
+    my $ruleset = slurp($rulefile);
+    my $start_value = @pieces.join(" ");
+    say "starting with $start_value.perl()";
+    say run(:$ruleset, :$start_value, :$verbose).perl;
+}