Execute a Markov algorithm: Difference between revisions

→‎{{header|Racket}}: Decomposed the main Markov algorithm and cleaned up the code.
(→‎{{header|Racket}}: Decomposed the main Markov algorithm and cleaned up the code.)
Line 2,053:
===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>
Line 2,061:
(struct ->. (A B))
 
(define ((Markov-algorithm . rules) startinitial-string)
(let/cc stop
; rewriting rules
(define (rewrite rule str)
(match rrule
[(-> a b) (cond [(replace a resstr b) => newapply-cyclerules]
[else resstr])]
[(->. a b) (cond [(replace a resstr b) => stop]
[else resstr])])))))
; 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 ((Markov-algorithm . rules) start)
(define ((fixed-point f) xx0)
(let/cc stop
(let loop ((fixed-point [x x0] [fx (f x0)])
(if (equal? x fx) fx (λloop fx (stringf fx)))))
(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>
 
Anonymous user