update

Task/Execute-a-Markov-algorithm/Racket/execute-a-markov-algorithm-1.rkt

@@ -0,0 +1,28 @@
+#lang racket
+
+(struct ->  (A B))
+(struct ->. (A B))
+
+(define ((Markov-algorithm . rules) initial-string)
+  (let/cc stop
+    ; rewriting rules
+    (define (rewrite rule str)
+      (match rule
+        [(->  a b) (cond [(replace a str b) => apply-rules]
+                         [else str])]
+        [(->. a b) (cond [(replace a str b) => stop]
+                         [else str])]))
+    ; the cycle through rewriting rules
+    (define (apply-rules s) (foldl rewrite s rules))
+    ; the result is a fixed point of rewriting procedure
+    (fixed-point apply-rules initial-string)))
+
+;; replaces the first substring A to B in a string s
+(define (replace A s B)
+  (and (regexp-match? (regexp-quote A) s)
+       (regexp-replace (regexp-quote A) s B)))
+
+;; Finds the least fixed-point of a function
+(define (fixed-point f x0)
+  (let loop ([x x0] [fx (f x0)])
+    (if (equal? x fx) fx (loop fx (f fx)))))

Task/Execute-a-Markov-algorithm/Racket/execute-a-markov-algorithm-2.rkt

@@ -0,0 +1,11 @@
+> (define MA
+    (Markov-algorithm
+     (->  "A" "apple")
+     (->  "B" "bag")
+     (->. "S" "shop")
+     (->  "T" "the")
+     (->  "the shop" "my brother")
+     (->. "a never used" "terminating rule")))
+
+> (MA "I bought a B of As from T S.")
+"I bought a bag of apples from T shop."

Task/Execute-a-Markov-algorithm/Racket/execute-a-markov-algorithm-3.rkt

@@ -0,0 +1,22 @@
+;; the reader
+(define (read-rules source)
+  (with-input-from-string source
+    (λ () (for*/list ([line (in-lines)]
+                      #:unless (should-be-skipped? line))
+            (match line
+              [(rx-split A "[[:blank:]]->[[:blank:]][.]" B) (->. A B)]
+              [(rx-split A "[[:blank:]]->[[:blank:]]" B)    (->  A B)])))))
+
+;; the new pattern for the match form
+(define-match-expander rx-split
+  (syntax-rules ()
+    [(rx-split A rx B)
+     (app (λ (s) (regexp-split (pregexp rx) s)) (list A B))]))
+
+;; skip empty lines and comments
+(define (should-be-skipped? line)
+  (or (regexp-match? #rx"^#.*" line)
+      (regexp-match? #px"^[[:blank:]]*$" line)))
+
+(define (read-Markov-algorithm source)
+  (apply Markov-algorithm (read-rules source)))

Task/Execute-a-Markov-algorithm/Racket/execute-a-markov-algorithm-4.rkt

@@ -0,0 +1,64 @@
+(define R3 (read-Markov-algorithm "
+# 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"))
+
+(define R4
+  (read-Markov-algorithm "
+### 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
+_+_ -> "))
+
+(define R5
+  (read-Markov-algorithm "
+# 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"))

Task/Execute-a-Markov-algorithm/Racket/execute-a-markov-algorithm-5.rkt

@@ -0,0 +1,8 @@
+> (R3 "I bought a B of As W my Bgage from T S.")
+"I bought a bag of apples with my money from T shop."
+
+> (R4 "_1111*11111_")
+"11111111111111111111"
+
+> (R5 "000000A000000")
+"00011H1111000"