Execute a Markov algorithm: Difference between revisions

(→‎{{header|МК-61/52}}: Optimization.)
Line 2,048:
assert replace(text4, extractreplacements(grammar5)) \
== '00011H1111000'</lang>
 
=={{header|Racket}}==
 
===The Markov algorithm interpreter===
 
The <tt>Markov-algorithm</tt> procedure for a set of rules returns a function which maps from a string to string and can be used as a first-class object. Rules are represented by abstract data structures.
 
<lang scheme>
#lang racket
 
(struct -> (A B))
(struct ->. (A B))
 
(define (replace A s B)
(and (regexp-match? (regexp-quote A) s)
(regexp-replace (regexp-quote A) s B)))
 
(define ((Markov-algorithm . rules) start)
(let/cc stop
((fixed-point
(λ (string)
(let new-cycle ([s string])
(for/fold ([res s]) ([r rules])
(match r
[(-> a b) (cond [(replace a res b) => new-cycle]
[else res])]
[(->. a b) (cond [(replace a res b) => stop]
[else res])])))))
start)))
</lang>
 
The general fixed-point operator:
 
<lang scheme>
(define ((fixed-point f) x)
(let F ([x x] [fx (f x)])
(if (equal? x fx)
fx
(F fx (f fx)))))
</lang>
 
Example of use:
 
<lang scheme>
> (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."
</lang>
 
===The sourse reader===
 
To read from a file just replace <tt>with-input-from-string</tt> ==> <tt>with-input-from-file</tt>.
 
<lang scheme>
;; 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)))
</lang>
 
Examples:
 
<lang scheme>
(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"))
</lang>
 
<lang scheme>
> (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"
</lang>
 
=={{header|REXX}}==
Anonymous user