Execute a Markov algorithm: Difference between revisions

Add Refal
(→‎{{header|Go}}: simplify code, include all input data)
(Add Refal)
(36 intermediate revisions by 18 users not shown)
Line 149:
: <code> 00011H1111000 </code>
<br><br>
 
=={{header|11l}}==
{{trans|Nim}}
 
<syntaxhighlight lang="11l">T Rule
String pattern
String replacement
Bool terminating
F (pattern, replacement, terminating)
.pattern = pattern
.replacement = replacement
.terminating = terminating
 
F parse(rules)
[Rule] result
L(line) rules.split("\n")
I line.starts_with(‘#’)
L.continue
I line.trim(‘ ’).empty
L.continue
 
V (pat, rep) = line.split(‘ -> ’)
 
V terminating = 0B
I rep.starts_with(‘.’)
rep = rep[1..]
terminating = 1B
 
result.append(Rule(pat, rep, terminating))
R result
 
F apply(text, rules)
V result = text
V changed = 1B
 
L changed == 1B
changed = 0B
L(rule) rules
I rule.pattern C result
result = result.replace(rule.pattern, rule.replacement)
I rule.terminating
R result
changed = 1B
L.break
 
R result
 
V SampleTexts = [‘I bought a B of As from T S.’,
‘I bought a B of As from T S.’,
‘I bought a B of As W my Bgage from T S.’,
‘_1111*11111_’,
‘000000A000000’]
 
V RuleSets = [
‘# 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’,
 
‘# Slightly modified from the rules on Wikipedia
A -> apple
B -> bag
S -> .shop
T -> the
the shop -> my brother
a never used -> .terminating rule’,
 
‘# 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’,
 
‘### 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
_+_ -> ’,
 
‘# 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’]
 
L(ruleset) RuleSets
V rules = parse(ruleset)
print(apply(SampleTexts[L.index], rules))</syntaxhighlight>
 
{{out}}
<pre>
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
</pre>
 
=={{header|Ada}}==
markov.ads:
<langsyntaxhighlight Adalang="ada">with Ada.Strings.Unbounded;
 
package Markov is
Line 177 ⟶ 320:
Entries : Entry_Array (1 .. Length);
end record;
end Markov;</langsyntaxhighlight>
 
markov.adb:
<langsyntaxhighlight Adalang="ada">package body Markov is
 
function Parse (S : String_Array) return Ruleset is
Line 260 ⟶ 403:
end Apply;
 
end Markov;</langsyntaxhighlight>
 
test_markov.adb:
<langsyntaxhighlight Adalang="ada">with Ada.Command_Line;
with Ada.Text_IO.Unbounded_IO;
with Ada.Strings.Unbounded;
Line 310 ⟶ 453:
end;
end;
end Test_Markov;</langsyntaxhighlight>
 
Output (rulesX contains the ruleset of above examples and testX the example text):
Line 322 ⟶ 465:
11111111111111111111
$ ./test_markov rules5 test5
00011H1111000</pre>
 
=={{header|APL}}==
{{works with|Dyalog APL}}
<syntaxhighlight lang="apl">markov←{
trim←{(~(∧\∨⌽∘(∧\)∘⌽)⍵∊⎕UCS 9 32)/⍵}
rules←(~rules∊⎕UCS 10 13)⊆rules←80 ¯1 ⎕MAP ⍺
rules←('#'≠⊃¨rules)/rules
rules←{
norm←' '@(9=⎕UCS)⊢⍵
spos←⍸' -> '⍷norm
pat←trim spos↑⍵
repl←trim(spos+2)↓⍵
term←'.'=⊃repl
term pat(term↓repl)
}¨rules
apply←{
0=⍴rule←⍸∨/¨(2⊃¨⍺)⍷¨⊂⍵:⍵
term pat repl←⊃⍺[⊃rule]
idx←(⊃⍸pat⍷⍵)-1
⍺ ∇⍣(~term)⊢(idx↑⍵),repl,(idx+≢pat)↓⍵
}
rules apply ⍵
}</syntaxhighlight>
{{out}}
<pre> 'f:\ruleset1.mkv' markov 'I bought a B of As from T S.'
I bought a bag of apples from my brother.
'f:\ruleset2.mkv' markov 'I bought a B of As from T S.'
I bought a bag of apples from T shop.
'f:\ruleset3.mkv' markov 'I bought a B of As W my Bgage from T S.'
I bought a bag of apples with my money from T shop.
'f:\ruleset4.mkv' markov '_1111*11111_'
11111111111111111111
'f:\ruleset5.mkv' markov '000000A000000'
00011H1111000</pre>
 
=={{header|AutoHotkey}}==
<langsyntaxhighlight lang="autohotkey">;---------------------------------------------------------------------------
; Markov Algorithm.ahk
; by wolf_II
Line 678 ⟶ 855:
 
 
;---------- end of file ----------------------------------------------------</langsyntaxhighlight>
 
=={{header|BBC BASIC}}==
<langsyntaxhighlight lang="bbcbasic"> PRINT FNmarkov("ruleset1.txt", "I bought a B of As from T S.")
PRINT FNmarkov("ruleset2.txt", "I bought a B of As from T S.")
PRINT FNmarkov("ruleset3.txt", "I bought a B of As W my Bgage from T S.")
Line 715 ⟶ 892:
UNTIL EOF#rules% OR done%
CLOSE #rules%
= text$</langsyntaxhighlight>
'''Output:'''
<pre>
Line 727 ⟶ 904:
=={{header|Bracmat}}==
Save the following text to a file "markov.bra":
<langsyntaxhighlight lang="bracmat">
markov=
{
Line 942 ⟶ 1,119:
& ok
| failure;
</syntaxhighlight>
</lang>
 
Test:
Line 961 ⟶ 1,138:
 
=={{header|C}}==
<langsyntaxhighlight lang="c">#include <stdio.h>
#include <stdlib.h>
#include <string.h>
Line 973 ⟶ 1,150:
 
typedef struct {
char *pat, *repl;
int terminate;
} rule_t;
 
typedef struct {
int n;
rule_t *rules;
char *buf;
} ruleset_t;
 
void ruleset_del(ruleset_t *r)
{
if (r->rules) free(r->rules);
if (r->buf) free(r->buf);
free(r);
}
 
string * str_new(const char *s)
{
int l = strlen(s);
string *str = malloc(sizeof(string));
str->s = malloc(l + 1);
strcpy(str->s, s);
str->alloc_len = l + 1;
return str;
}
 
void str_append(string *str, const char *s, int len)
{
int l = strlen(str->s);
if (len == -1) len = strlen(s);
 
if (str->alloc_len < l + len + 1) {
str->alloc_len = l + len + 1;
str->s = realloc(str->s, str->alloc_len);
}
}
memcpy(str->s + l, s, len);
str->s[l + len] = '\0';
}
 
Line 1,016 ⟶ 1,193:
void str_transfer(string *dest, string *src)
{
size_t tlen = dest->alloc_len;
dest->alloc_len = src->alloc_len;
src->alloc_len = tlen;
 
char *ts = dest->s;
dest->s = src->s;
src->s = ts;
src->s[0] = '\0';
}
 
void str_del(string *s)
{
if (s->s) free(s->s);
free(s);
}
 
void str_markov(string *str, ruleset_t *r)
{
int i, j, sl, pl;
int changed = 0, done = 0;
string *tmp = str_new("");
 
while (!done) {
changed = 0;
for (i = 0; !done && !changed && i < r->n; i++) {
pl = strlen(r->rules[i].pat);
sl = strlen(str->s);
for (j = 0; j < sl; j++) {
if (strncmp(str->s + j, r->rules[i].pat, pl))
continue;
str_append(tmp, str->s, j);
str_append(tmp, r->rules[i].repl, -1);
str_append(tmp, str->s + j + pl, -1);
 
str_transfer(str, tmp);
changed = 1;
 
if (r->rules[i].terminate)
done = 1;
break;
}
}
}
}
if (!changed) break;
}
}
str_del(tmp);
return;
}
 
ruleset_t* read_rules(const char *name)
{
struct stat s;
char *buf;
size_t i, j, k, tmp;
rule_t *rules = 0;
int n = 0; /* number of rules */
 
int fd = open(name, O_RDONLY);
if (fd == -1) return 0;
 
fstat(fd, &s);
buf = malloc(s.st_size + 2);
read(fd, buf, s.st_size);
buf[s.st_size] = '\n';
buf[s.st_size + 1] = '\0';
close(fd);
 
for (i = j = 0; buf[i] != '\0'; i++) {
if (buf[i] != '\n') continue;
 
/* skip comments */
if (buf[j] == '#' || i == j) {
j = i + 1;
continue;
}
}
 
/* find the '->' */
for (k = j + 1; k < i - 3; k++)
if (isspace(buf[k]) && !strncmp(buf + k + 1, "->", 2))
break;
 
if (k >= i - 3) {
printf("parse error: no -> in %.*s\n", i - j, buf + j);
break;
}
}
 
/* left side: backtrack through whitespaces */
for (tmp = k; tmp > j && isspace(buf[--tmp]); );
if (tmp < j) {
printf("left side blank? %.*s\n", i - j, buf + j);
break;
}
}
buf[++tmp] = '\0';
 
/* right side */
for (k += 3; k < i && isspace(buf[++k]););
buf[i] = '\0';
 
rules = realloc(rules, sizeof(rule_t) * (1 + n));
rules[n].pat = buf + j;
 
if (buf[k] == '.') {
rules[n].terminate = 1;
rules[n].repl = buf + k + 1;
} else {
rules[n].terminate = 0;
rules[n].repl = buf + k;
}
}
n++;
 
j = i + 1;
}
}
 
ruleset_t *r = malloc(sizeof(ruleset_t));
r->buf = buf;
r->rules = rules;
r->n = n;
return r;
}
 
int test_rules(const char *s, const char *file)
{
ruleset_t * r = read_rules(file);
if (!r) return 0;
printf("Rules from '%s' ok\n", file);
 
string *ss = str_new(s);
printf("text: %s\n", ss->s);
 
str_markov(ss, r);
printf("markoved: %s\n", ss->s);
 
str_del(ss);
ruleset_del(r);
 
return printf("\n");
}
 
int main()
{
/* rule 1-5 are files containing rules from page top */
test_rules("I bought a B of As from T S.", "rule1");
test_rules("I bought a B of As from T S.", "rule2");
test_rules("I bought a B of As W my Bgage from T S.", "rule3");
test_rules("_1111*11111_", "rule4");
test_rules("000000A000000", "rule5");
 
return 0;
}</langsyntaxhighlight>output<syntaxhighlight lang="text">Rules from 'rule1' ok
text: I bought a B of As from T S.
markoved: I bought a bag of apples from my brother.
Line 1,182 ⟶ 1,359:
text: 000000A000000
markoved: 00011H1111000
</syntaxhighlight>
</lang>
 
=={{header|C++}}==
Note: Non-use of <code>iswhite</code> is intentional, since depending on the locale, other chars besides space and tab might be detected by that function.
<langsyntaxhighlight lang="cpp">
#include <cstdlib>
#include <iostream>
Line 1,299 ⟶ 1,476:
 
std::cout << output << "\n";
}</langsyntaxhighlight>
 
=={{header|CLU}}==
<syntaxhighlight lang="clu">markov = cluster is make, run
rule = struct[from, to: string, term: bool]
rep = array[rule]
% Remove leading and trailing whitespace from a string
trim = proc (s: string) returns (string)
ac = array[char]
sc = sequence[char]
own ws: string := "\n\t "
a: ac := string$s2ac(s)
while ~ac$empty(a) cand string$indexc(ac$bottom(a), ws) ~= 0 do
ac$reml(a)
end
while ~ac$empty(a) cand string$indexc(ac$top(a), ws) ~= 0 do
ac$remh(a)
end
return(string$sc2s(sc$a2s(a)))
end trim
% Parse a single Markov rule
parse = proc (s: string) returns (rule) signals (comment, invalid(string))
if string$empty(s) cor s[1]='#' then signal comment end
arrow: int := string$indexs(" -> ", s)
if arrow=0 then signal invalid(s) end
left: string := trim(string$substr(s, 1, arrow-1))
right: string := trim(string$rest(s, arrow+4))
if ~string$empty(right) cand right[1] = '.' then
right := string$rest(right, 2)
return(rule${from: left, to: right, term: true})
else
return(rule${from: left, to: right, term: false})
end
end parse
% Add a rule to the list
add_rule = proc (m: cvt, s: string) signals (invalid(string))
rep$addh(m, parse(s)) resignal invalid
except when comment: end
end add_rule
% Read rules in sequence from a stream
add_rules = proc (m: cvt, s: stream) signals (invalid(string))
while true do
add_rule(up(m), stream$getl(s)) resignal invalid
except when end_of_file: break end
end
end add_rules
make = proc (s: stream) returns (cvt) signals (invalid(string))
a: rep := rep$new()
add_rules(up(a), s)
return(a)
end make
% Apply a rule to a string
apply_rule = proc (r: rule, s: string) returns (string) signals (no_match)
match: int := string$indexs(r.from, s)
if match = 0 then signal no_match end
new: string := string$substr(s, 1, match-1)
|| r.to
|| string$rest(s, match+string$size(r.from))
return(new)
end apply_rule
% Apply all rules to a string repeatedly
run = proc (c: cvt, s: string) returns (string)
i: int := 1
while i <= rep$high(c) do
r: rule := c[i]
begin
s := apply_rule(r, s)
i := 1
if r.term then break end
end except when no_match:
i := i+1
end
end
return(s)
end run
end markov
 
start_up = proc ()
po: stream := stream$primary_output()
eo: stream := stream$error_output()
begin
args: sequence[string] := get_argv()
file: string := args[1]
input: string := args[2]
fs: stream := stream$open(file_name$parse(file), "read")
mkv: markov := markov$make(fs)
stream$close(fs)
stream$putl(po, markov$run(mkv, input))
end except
when bounds: stream$putl(eo, "Arguments: markov [filename] [string]")
when not_possible(s: string): stream$putl(eo, "File error: " || s)
when invalid(s: string): stream$putl(eo, "Parse error: " || s)
end
end start_up</syntaxhighlight>
{{out}}
<pre>$ ./markov ruleset1.mkv "I bought a B of As from T S."
I bought a bag of apples from my brother.
 
$ ./markov ruleset2.mkv "I bought a B of As from T S."
I bought a bag of apples from T shop.
 
$ ./markov ruleset3.mkv "I bought a B of As W my Bgage from T S."
I bought a bag of apples with my money from T shop.
 
$ ./markov ruleset4.mkv "_1111*11111_"
11111111111111111111
 
$ ./markov ruleset5.mkv "000000A000000"
00011H1111000</pre>
 
=={{header|Common Lisp}}==
I should mention that this uses the regular expression machinery present in Allegro Lisp but not Common Lisp generally (though there are public domain Lisp libraries).
<langsyntaxhighlight lang="lisp">;;; Keeps track of all our rules
(defclass markov ()
((rules :initarg :rules :initform nil :accessor rules)))
Line 1,370 ⟶ 1,664:
(setf ret (adjust rule-info ret))
(if (terminal (car rule-info)) (return ret))
(setf rule-info (get-rule markov ret)))))</langsyntaxhighlight>
Testing:
<syntaxhighlight lang="text">(defparameter
*rules1*
"# This rules file is extracted from Wikipedia:
Line 1,399 ⟶ 1,693:
00011H1111000
NIL
</syntaxhighlight>
</lang>
 
=={{header|Cowgol}}==
<syntaxhighlight lang="cowgol">include "cowgol.coh";
include "strings.coh";
include "malloc.coh";
include "argv.coh";
include "file.coh";
 
record Rule is
pattern: [uint8];
replacement: [uint8];
next: [Rule];
terminates: uint8;
end record;
 
sub AllocRule(): (rule: [Rule]) is
rule := Alloc(@bytesof Rule) as [Rule];
MemZero(rule as [uint8], @bytesof Rule);
end sub;
 
sub ParseRule(text: [uint8]): (rule: [Rule]) is
sub ParseError() is
print("Failed to parse rule: ");
print(text);
print_nl();
ExitWithError();
end sub;
var cur := text;
sub SkipWs() is
while [cur] != 0 and [cur] <= ' ' loop cur := @next cur; end loop;
end sub;
sub AllocAndCopy(src: [uint8], length: intptr): (copy: [uint8]) is
copy := Alloc(length + 1);
MemCopy(src, length, copy);
[copy + length] := 0;
end sub;
SkipWs();
if [cur] == '#' or [cur] == 0 then # comment or empty line
rule := 0 as [Rule];
return;
end if;
var patternStart := cur;
 
# find the " ->"
while [cur] != 0
and ([cur] > ' ' or [cur+1] != '-' or [cur+2] != '>') loop
cur := @next cur;
end loop;
if [cur] == 0 then ParseError(); end if;
 
# find last char of pattern
var patternEnd := cur;
while patternStart < patternEnd and [patternEnd] <= ' ' loop
patternEnd := @prev patternEnd;
end loop;
 
cur := cur + 3; # whitespace + '->'
SkipWs();
var replacementStart := cur;
 
# find last char of replacement
while [cur] != 0 loop cur := @next cur; end loop;
while replacementStart < cur and [cur] <= ' ' loop
cur := @prev cur;
end loop;
 
# make rule object
rule := AllocRule();
rule.pattern := AllocAndCopy(patternStart, patternEnd-patternStart+1);
if [replacementStart] == '.' then
rule.terminates := 1;
replacementStart := @next replacementStart;
end if;
rule.replacement := AllocAndCopy(replacementStart, cur-replacementStart+1);
end sub;
 
sub FindMatch(needle: [uint8], haystack: [uint8]): (match: [uint8]) is
match := 0 as [uint8];
while [haystack] != 0 loop
var n := needle;
var h := haystack;
while [n] != 0 and [h] != 0 and [n] == [h] loop
n := @next n;
h := @next h;
end loop;
if [n] == 0 then
match := haystack;
return;
end if;
haystack := @next haystack;
end loop;
end sub;
 
const NO_MATCH := 0;
const HALT := 1;
const CONTINUE := 2;
sub ApplyRule(rule: [Rule], in: [uint8], out: [uint8]): (result: uint8) is
var match := FindMatch(rule.pattern, in);
if match == 0 as [uint8] then
result := NO_MATCH;
else
var len := StrLen(rule.replacement);
var patlen := StrLen(rule.pattern);
var rest := match + patlen;
MemCopy(in, match-in, out);
MemCopy(rule.replacement, len, out+(match-in));
CopyString(rest, out+(match-in)+len);
if rule.terminates != 0 then
result := HALT;
else
result := CONTINUE;
end if;
end if;
end sub;
 
sub ApplyRules(rules: [Rule], buffer: [uint8]): (r: [uint8]) is
var outbuf: uint8[256];
var rule := rules;
r := buffer;
 
while rule != 0 as [Rule] loop
case ApplyRule(rule, buffer, &outbuf[0]) is
when NO_MATCH:
rule := rule.next;
when HALT:
CopyString(&outbuf[0], buffer);
return;
when CONTINUE:
CopyString(&outbuf[0], buffer);
rule := rules;
end case;
end loop;
end sub;
 
sub ReadFile(filename: [uint8]): (rules: [Rule]) is
var linebuf: uint8[256];
var fcb: FCB;
var bufptr := &linebuf[0];
 
rules := 0 as [Rule];
var prevRule := 0 as [Rule];
 
if FCBOpenIn(&fcb, filename) != 0 then
print("Cannot open file: ");
print(filename);
print_nl();
ExitWithError();
end if;
var length := FCBExt(&fcb);
var ch: uint8 := 1;
while length != 0 and ch != 0 loop
ch := FCBGetChar(&fcb);
length := length - 1;
[bufptr] := ch;
bufptr := @next bufptr;
 
if ch == '\n' then
[bufptr] := 0;
bufptr := &linebuf[0];
var rule := ParseRule(&linebuf[0]);
if rule != 0 as [Rule] then
if rules == 0 as [Rule] then rules := rule; end if;
if prevRule != 0 as [Rule] then prevRule.next := rule; end if;
prevRule := rule;
end if;
end if;
end loop;
var dummy := FCBClose(&fcb);
end sub;
 
ArgvInit();
var fname := ArgvNext();
if fname == 0 as [uint8] then
print("usage: markov [pattern file] [pattern]\n");
ExitWithError();
end if;
 
var patbuf: uint8[256];
var patptr := &patbuf[0];
loop
var patpart := ArgvNext();
if patpart == 0 as [uint8] then
if patptr != &patbuf[0] then patptr := @prev patptr; end if;
[patptr] := 0;
break;
end if;
var partlen := StrLen(patpart);
MemCopy(patpart, partlen, patptr);
patptr := patptr + partlen + 1;
[@prev patptr] := ' ';
end loop;
 
print(ApplyRules(ReadFile(fname), &patbuf[0]));
print_nl();</syntaxhighlight>
{{out}}
<pre>$ ./markov.386 ruleset1.mkv "I bought a B of As from T S."
I bought a bag of apples from my brother.
$ ./markov.386 ruleset2.mkv "I bought a B of As from T S."
I bought a bag of apples from T shop.
$ ./markov.386 ruleset3.mkv "I bought a B of As W my Bgage from T S."
I bought a bag of apples with my money from T shop.
$ ./markov.386 ruleset4.mkv "_1111*11111_"
11111111111111111111
$ ./markov.386 ruleset5.mkv "000000A000000"
00011H1111000</pre>
 
=={{header|D}}==
{{trans|Perl}}
<langsyntaxhighlight lang="d">void main() {
import std.stdio, std.file, std.regex, std.string, std.range,
std.functional;
Line 1,435 ⟶ 1,939:
writefln("%s\n%s\n", origTest, test);
}
}</langsyntaxhighlight>
{{out}}
<pre>I bought a B of As from T S.
Line 1,454 ⟶ 1,958:
=={{header|Déjà Vu}}==
This implementation expect the initial text on the command line and the ruleset on STDIN.
<langsyntaxhighlight lang="dejavu">(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:
(markov-parse) (remove-comments) split !decode!utf-8 !read!stdin "\n"
 
(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
rep
slice start 0 index
concat(
return term
true start
 
markov rules:
true
while:
not (markov-tick) rules
 
!. markov markov-parse get-from !args 1</langsyntaxhighlight>
 
=={{header|EchoLisp}}==
<langsyntaxhighlight lang="scheme">
;; rule := (pattern replacement [#t terminal])
 
Line 1,533 ⟶ 2,037:
(define (task i-string RS)
(markov i-string (parse-rules RS)))
</syntaxhighlight>
</lang>
{{out}}
<pre>
Line 1,568 ⟶ 2,072:
</pre>
 
=={{header|F_Sharp|F#}}==
<p>Using Partial Active Pattern to simplify pattern matching.</p>
<syntaxhighlight lang="fsharp">open System
open System.IO
open System.Text.RegularExpressions
 
type Rule = {
matches : Regex
replacement : string
terminate : bool
}
 
let (|RegexMatch|_|) regexStr input =
let m = Regex.Match(input, regexStr, RegexOptions.ExplicitCapture)
if m.Success then Some (m) else None
 
let (|RuleReplace|_|) rule input =
let replaced = rule.matches.Replace(input, rule.replacement, 1, 0)
if input = replaced then None
else Some (replaced, rule.terminate)
 
let parseRules line =
match line with
| RegexMatch "^#" _ -> None
| RegexMatch "(?<pattern>.*?)\s+->\s+(?<replacement>.*)$" m ->
let replacement = (m.Groups.Item "replacement").Value
let terminate = replacement.Length > 0 && replacement.Substring(0,1) = "."
let pattern = (m.Groups.Item "pattern").Value
Some {
matches = pattern |> Regex.Escape |> Regex;
replacement = if terminate then replacement.Substring(1) else replacement;
terminate = terminate
}
| _ -> failwith "illegal rule definition"
 
let rec applyRules input = function
| [] -> (input, true)
| rule::rules ->
match input with
| RuleReplace rule (withReplacement, terminate) ->
(withReplacement, terminate)
| _ -> applyRules input rules
 
[<EntryPoint>]
let main argv =
let rules = File.ReadAllLines argv.[0] |> Array.toList |> List.choose parseRules
let rec run input =
let output, terminate = applyRules input rules
if terminate then output
else run output
 
Console.ReadLine()
|> run
|> printfn "%s"
0</syntaxhighlight>
{{out}}
<pre>H:\RosettaCode\ExecMarkovAlgo>echo I bought a B of As from T S. | Fsharp\RosettaCode\bin\Debug\RosettaCode.exe m1
I bought a bag of apples from my brother.
 
H:\RosettaCode\ExecMarkovAlgo>echo I bought a B of As from T S.| Fsharp\RosettaCode\bin\Debug\RosettaCode.exe m2
I bought a bag of apples from T shop.
 
H:\RosettaCode\ExecMarkovAlgo>echo I bought a B of As W my Bgage from T S.| Fsharp\RosettaCode\bin\Debug\RosettaCode.exe m3
I bought a bag of apples with my money from T shop.
 
H:\RosettaCode\ExecMarkovAlgo>echo _1111*11111_ | Fsharp\RosettaCode\bin\Debug\RosettaCode.exe m4
11111111111111111111
 
H:\RosettaCode\ExecMarkovAlgo>echo 000000A000000 | Fsharp\RosettaCode\bin\Debug\RosettaCode.exe m5
00011H1111000</pre>
 
=={{header|Go}}==
<langsyntaxhighlight lang="go">package main
 
import (
Line 1,745 ⟶ 2,319:
`00011H1111000`,
},
}</langsyntaxhighlight>
{{out}}
<pre>
Line 1,753 ⟶ 2,327:
 
=={{header|Groovy}}==
<langsyntaxhighlight lang="groovy">def markovInterpreterFor = { rules ->
def ruleMap = [:]
rules.eachLine { line ->
Line 1,777 ⟶ 2,351:
text
}]
}</langsyntaxhighlight>
The test code is below (with the markov rulesets 2..5 elided):
<langsyntaxhighlight lang="groovy">def verify = { ruleset ->
[withInput: { text ->
[hasOutput: { expected ->
Line 1,811 ⟶ 2,385:
 
def ruleset5 = markovInterpreterFor("""...""")
verify ruleset5 withInput '000000A000000' hasOutput '00011H1111000'</langsyntaxhighlight>
{{out}}
<pre>
Line 1,821 ⟶ 2,395:
Input: '000000A000000' has output: '00011H1111000'
</pre>
 
 
 
=={{header|Haskell}}==
This program expects a source file as an argument and uses the standard input and output devices for the algorithm's I/O.
 
<langsyntaxhighlight lang="haskell">import Data.List (isPrefixOf)
import Data.Maybe (catMaybes)
import Control.Monad
Line 1,869 ⟶ 2,441:
then let new = reverse before ++ to ++ drop (length from) ahead
in if terminating then new else f rules new
else g (a : before) as</langsyntaxhighlight>
 
=={{header|Icon}} and {{header|Unicon}}==
 
<langsyntaxhighlight lang="unicon">procedure main(A)
rules := loadRules(open(A[1],"r"))
every write(line := !&input, " -> ",apply(rules, line))
Line 1,894 ⟶ 2,466:
if (s == line) | \r.term then return s else line := s
}
end</langsyntaxhighlight>
 
Sample runs using above rule sets and test strings:
Line 1,916 ⟶ 2,488:
 
=={{header|J}}==
'''Solution''':<langsyntaxhighlight lang="j">require'strings regex'
 
markovLexer =: verb define
Line 1,945 ⟶ 2,517:
end.
y
)</langsyntaxhighlight>
 
'''Example''':<langsyntaxhighlight lang="j"> m1 =. noun define
# 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
)
 
m1 markov 'I bought a B of As from T S.'
I bought a bag of apples from my brother.
</syntaxhighlight>
</lang>
'''Discussion''': The J implementation correctly processes all the rulesets. More details are available on the [[Talk:Markov Algorithm#explicit_vs_tacit|the talk page]].
 
Line 1,966 ⟶ 2,538:
{{trans|D}}
{{works with|Java|7}}
<langsyntaxhighlight lang="java">import java.io.IOException;
import java.nio.charset.StandardCharsets;
import java.nio.file.Files;
Line 2,028 ⟶ 2,600:
return rules;
}
}</langsyntaxhighlight>
 
Output:
Line 2,046 ⟶ 2,618:
000000A000000
00011H1111000</pre>
 
=={{header|JavaScript}}==
<syntaxhighlight lang="javascript">/**
* Take a ruleset and return a function which takes a string to which the rules
* should be applied.
* @param {string} ruleSet
* @returns {function(string): string}
*/
const markov = ruleSet => {
 
/**
* Split a string at an index
* @param {string} s The string to split
* @param {number} i The index number where to split.
* @returns {Array<string>}
*/
const splitAt = (s, i) => [s.slice(0, i), s.slice(i)];
 
/**
* Strip a leading number of chars from a string.
* @param {string} s The string to strip the chars from
* @param {string} strip A string who's length will determine the number of
* chars to strip.
* @returns {string}
*/
const stripLeading = (s, strip) => s.split('')
.filter((e, i) => i >= strip.length).join('');
 
/**
* Replace the substring in the string.
* @param {string} s The string to replace the substring in
* @param {string} find The sub-string to find
* @param {string} rep The replacement string
* @returns {string}
*/
const replace = (s, find, rep) => {
let result = s;
if (s.indexOf(find) >= 0) {
const a = splitAt(s, s.indexOf(find));
result = [a[0], rep, stripLeading(a[1], find)].join('');
}
return result;
};
 
/**
* Convert a ruleset string into a map
* @param {string} ruleset
* @returns {Map}
*/
const makeRuleMap = ruleset => ruleset.split('\n')
.filter(e => !e.startsWith('#'))
.map(e => e.split(' -> '))
.reduce((p,c) => p.set(c[0], c[1]), new Map());
 
/**
* Recursively apply the ruleset to the string.
* @param {Map} rules The rules to apply
* @param {string} s The string to apply the rules to
* @returns {string}
*/
const parse = (rules, s) => {
const o = s;
for (const [k, v] of rules.entries()) {
if (v.startsWith('.')) {
s = replace(s, k, stripLeading(v, '.'));
break;
} else {
s = replace(s, k, v);
if (s !== o) { break; }
}
}
return o === s ? s : parse(rules, s);
};
 
const ruleMap = makeRuleMap(ruleSet);
 
return str => parse(ruleMap, str)
};
 
 
const ruleset1 = `# 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`;
 
const ruleset2 = `# Slightly modified from the rules on Wikipedia
A -> apple
B -> bag
S -> .shop
T -> the
the shop -> my brother
a never used -> .terminating rule`;
 
const ruleset3 = `# 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`;
 
const ruleset4 = `### 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
_+_ -> `;
 
const ruleset5 = `# 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`;
 
console.log(markov(ruleset1)('I bought a B of As from T S.'));
console.log(markov(ruleset2)('I bought a B of As from T S.'));
console.log(markov(ruleset3)('I bought a B of As W my Bgage from T S.'));
console.log(markov(ruleset4)('_1111*11111_'));
console.log(markov(ruleset5)('000000A000000'));</syntaxhighlight>
Output:
<pre>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</pre>
 
=={{header|jq}}==
{{works with|jq}}
'''Works with gojq, the Go implementation of jq'''
 
This entry assumes that the rule sets are in a single file (markov_rules.txt);
that the rule sets are separated by a blank line;
and that the corresponding test cases are in a separate file (markov_tests.txt), with one test case per line.
In addition, for simplicity, only blanks are counted as <whitespace>.
 
With the following program, jq could then be invoked as follows:
<pre>
jq -nrR --rawfile markov_rules markov_rules.txt -f program.jq markov_tests.txt
</pre>
 
'''Preliminaries'''
<syntaxhighlight lang="jq"># Output: the input string with all its regex-special characters suitably escaped
def deregex:
reduce ("\\\\", "\\*", "\\^", "\\?", "\\+", "\\.", "\\!", "\\{", "\\}", "\\[", "\\]", "\\$", "\\|",
"\\(", "\\)" ) as $c
(.; gsub( $c; $c));
 
# line-break
def lb: "\n";
 
def split2($s):
index($s) as $ix
| if $ix then [ .[:$ix], .[$ix + ($s|length):]] else null end;
 
def trim: sub("^ *";"") | sub(" *$";"");
 
# rulesets are assumed to be separated by a blank line
# input: a string
def readRules:
trim | split("\(lb)\(lb)") | map(split(lb)) ;
 
# tests are assumed to be on consecutive lines via `inputs`
# Output: an array
def readTests: [inputs | trim | select(length>0) ];
 
def rules: $markov_rules | readRules;
 
def tests: readTests;</syntaxhighlight>
 
<syntaxhighlight lang="jq">def parseRules($rules):
"^ *(?<period>[.]?) *(?<rule>.*)" as $pattern
| reduce $rules[] as $rule ([];
if $rule | (startswith("#") or (test(" -> ")|not)) then .
else ($rule|split2(" -> ")) as $splits
| ($splits[1] | capture($pattern)) as $re
| . + [[($splits[0]|trim|deregex), $re.period, ($re.rule | trim)]]
end );
 
# applyRules applies $rules to . recursively,
# where $rules is the set of applicable rules in the form of an array-of-triples.
# Input and output: a string
def applyRules($rules):
# The inner function has arity-0 for efficiency
# input and output: {stop, string}
def apply:
if .stop then .
else .string as $copy
| first( foreach $rules[] as $c (.;
.string |= sub($c[0]; $c[2])
| if $c[1] == "."
then .stop=true
elif .string != $copy
then (apply | .stop = true)
else .
end;
if .stop then . else empty end))
// .
end;
{stop: false, string: .} | apply | .string;
 
def proceed:
rules as $rules
| tests as $tests
| range(0; $tests|length) as $ix
| $tests[$ix]
| " \(.)\n=>\(applyRules( parseRules( $rules[$ix] ) ))\n" ;
 
proceed</syntaxhighlight>
 
{{out}}
<pre>
I bought a B of As from T S.
=>I bought a bag of apples from my brother.
 
I bought a B of As from T S.
=>I bought a bag of apples from T shop.
 
I bought a B of As W my Bgage from T S.
=>I bought a bag of apples with my money from T shop.
 
_1111*11111_
=>11111111111111111111
 
000000A000000
=>00011H1111000
</pre>
 
=={{header|Julia}}==
{{works with|Julia|0.6}}
 
'''Module''':
<syntaxhighlight lang="julia">module MarkovAlgos
 
struct MarkovRule{F,T}
patt::F
repl::T
term::Bool
end
 
isterminating(r::MarkovRule) = r.term
Base.show(io::IO, rule::MarkovRule) =
print(io, rule.patt, " → ", isterminating(rule) ? "." : "", rule.repl)
function Base.convert(::Type{MarkovRule}, s::AbstractString)
rmatch = match(r"^(.+)\s+->\s*(\.)?(.*)?$", s)
if rmatch ≡ nothing || isempty(rmatch.captures)
throw(ParseError("not valid rule: " * s))
end
patt, term, repl = rmatch.captures
return MarkovRule(patt, repl ≢ nothing ? repl : "", term ≢ nothing)
end
 
function ruleset(file::Union{AbstractString,IO})
ruleset = Vector{MarkovRule}(0)
for line in eachline(file)
ismatch(r"(^#|^\s*$)", line) || push!(ruleset, MarkovRule(line))
end
return ruleset
end
 
apply(text::AbstractString, rule::MarkovRule) = replace(text, rule.patt, rule.repl)
function apply(file::Union{AbstractString,IO}, ruleset::AbstractVector{<:MarkovRule})
text = readstring(file)
redo = !isempty(text)
while redo
matchrule = false
for rule in ruleset
if contains(text, rule.patt)
matchrule = true
text = apply(text, rule)
redo = !isterminating(rule)
break
end
end
redo = redo && matchrule
end
return text
end
 
end # module MarkovAlgos</syntaxhighlight>
 
'''Main''':
<syntaxhighlight lang="julia">include("module.jl")
 
let rulesets = @.("data/markovrules0" * string(1:5) * ".txt"),
ruletest = @.("data/markovtest0" * string(1:5) * ".txt")
for i in eachindex(rulesets, ruletest)
rules = MarkovAlgos.ruleset(rulesets[i])
println("# Example n.$i")
println("Original:\n", readstring(ruletest[i]))
println("Transformed:\n", MarkovAlgos.apply(ruletest[i], rules))
end
end</syntaxhighlight>
 
{{out}}
<pre># Example n.1
Original:
I bought a B of As from T S.
 
Transformed:
I bought a bag of apples from my brother.
 
# Example n.2
Original:
I bought a B of As from T S.
 
Transformed:
I bought a bag of apples from T shop.
 
# Example n.3
Original:
I bought a B of As W my Bgage from T S.
 
Transformed:
I bought a bag of apples with my baggage from T shop.
 
# Example n.4
Original:
_1111*11111_
 
Transformed:
11111111111111111111
 
# Example n.5
Original:
000000A000000
 
Transformed:
00011H1111000</pre>
 
=={{header|Kotlin}}==
{{trans|Java}}
<syntaxhighlight lang="scala">// version 1.1.51
 
import java.io.File
import java.util.regex.Pattern
 
/* rulesets assumed to be separated by a blank line in file */
fun readRules(path: String): List<List<String>> {
val ls = System.lineSeparator()
return File(path).readText().split("$ls$ls").map { it.split(ls) }
}
 
/* tests assumed to be on consecutive lines */
fun readTests(path: String) = File(path).readLines()
 
fun main(args: Array<String>) {
val rules = readRules("markov_rules.txt")
val tests = readTests("markov_tests.txt")
val pattern = Pattern.compile("^([^#]*?)\\s+->\\s+(\\.?)(.*)")
 
for ((i, origTest) in tests.withIndex()) {
val captures = mutableListOf<List<String>>()
for (rule in rules[i]) {
val m = pattern.matcher(rule)
if (m.find()) {
val groups = List<String>(m.groupCount()) { m.group(it + 1) }
captures.add(groups)
}
}
var test = origTest
 
do {
val copy = test
var redo = false
for (c in captures) {
test = test.replace(c[0], c[2])
if (c[1] == ".") break
if (test != copy) { redo = true; break }
}
}
while (redo)
 
println("$origTest\n$test\n")
}
}</syntaxhighlight>
 
{{out}}
<pre>
I bought a B of As from T S.
I bought a bag of apples from my brother.
 
I bought a B of As from T S.
I bought a bag of apples from T shop.
 
I bought a B of As W my Bgage from T S.
I bought a bag of apples with my money from T shop.
 
_1111*11111_
11111111111111111111
 
000000A000000
00011H1111000
</pre>
 
=={{header|Lua}}==
<langsyntaxhighlight lang="lua">-- 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
 
Line 2,068 ⟶ 3,076:
 
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
 
Line 2,105 ⟶ 3,113:
 
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
 
Line 2,221 ⟶ 3,229:
 
function do_markov(rules, input, output)
local m = markov.make_rules(rules)
input = markov.execute(m, input)
assert(input == output)
print(input)
end
 
Line 2,232 ⟶ 3,240:
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')</langsyntaxhighlight>
 
=={{header|Mathematica}} / {{header|Wolfram Language}}==
<langsyntaxhighlight lang="mathematica">markov[ruleset_, text_] :=
Module[{terminating = False, output = text,
rules = StringCases[
Line 2,246 ⟶ 3,254:
output = StringReplace[output, rule[[1]] -> rule[[2]]];
If[! rule[[3]], terminating = False]; Break[]], {rule, rules}]];
output];</langsyntaxhighlight>
Example:
<langsyntaxhighlight lang="mathematica">markov["# Turing machine: three-state busy beaver
#
# state A, symbol 0 => write 1, move right, new state B
Line 2,265 ⟶ 3,273:
# state C, symbol 1 => write 1, move left, halt
0C1 -> H01
1C1 -> H11", "000000A000000"]</langsyntaxhighlight>
Output:
<pre>"00011H1111000"</pre>
 
=={{header|МК-61/52}}==
<syntaxhighlight lang="text"> 9 П4
КИП4 [x] П7 Вx {x} П8
ИП8 ИПE * П8 {x} x=0 08
П5 ИП9 П1 lg [x] 10^x П3
ИП1 П2
Сx П6
ИП2 ИП7 - x=0 70
ИП9 ^ lg [x] 1 + ИП5 - 10^x / [x]
ИП6 ИП8 x#0 50 lg [x] 1 + + 10^x *
ИП9 ИП6 10^x П7 / {x} ИП7 * +
ИП8 ИП7 * + П9
С/П БП 00
x>=0 80
КИП6
ИП2 ИПE / [x] П2
x=0 26
КИП5
ИП1 ИП3 / {x} ИП3 * П1
ИП3 ИПE / [x] П3
x=0 22
ИП4 ИП0 - 9 - x=0 02 С/П</langsyntaxhighlight>
 
Under the rules of left 4 registers, under the word has 8 character cells, the alphabet of the digits from 1 to 8. Rules are placed in "123,456", where "123" is a fragment, and "456" is to be replaced, in the registers of the РA to РD. The number of rules is stored in Р0, the initial word is in Р9. Number triggered rule is the last digit registration Р4 (0 to 3), if no rule did not work, the indicator 0, otherwise the current word to be processed. In РE is stored 10.
 
=={{header|Nim}}==
<syntaxhighlight lang="nim">import strutils, strscans
 
type Rule = object
pattern: string # Input pattern.
replacement: string # Replacement string (may be empty).
terminating: bool # "true" if terminating rule.
 
#---------------------------------------------------------------------------------------------------
 
func parse(rules: string): seq[Rule] =
## Parse a rule set to build a sequence of rules.
 
var linecount = 0
for line in rules.splitLines():
 
inc linecount
if line.startsWith('#'): continue
if line.strip.len == 0: continue
 
# Scan the line.
var pat, rep: string
var terminating = false
if not line.scanf("$+ -> $*", pat, rep):
raise newException(ValueError, "Invalid rule at line " & $linecount)
 
if rep.startsWith('.'):
# Terminating rule.
rep = rep[1..^1]
terminating = true
 
result.add(Rule(pattern: pat, replacement: rep, terminating: terminating))
 
#---------------------------------------------------------------------------------------------------
 
func apply(text: string; rules: seq[Rule]): string =
## Apply a set of rules to a text and return the result.
 
result = text
var changed = true
 
while changed:
changed = false
# Try to apply the rules in sequence.
for rule in rules:
if result.find(rule.pattern) >= 0:
# Found a rule to apply.
result = result.replace(rule.pattern, rule.replacement)
if rule.terminating: return
changed = true
break
 
#———————————————————————————————————————————————————————————————————————————————————————————————————
 
const SampleTexts = ["I bought a B of As from T S.",
"I bought a B of As from T S.",
"I bought a B of As W my Bgage from T S.",
"_1111*11111_",
"000000A000000"]
 
const Rulesets = [
 
#................................................
 
"""# 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""",
 
#................................................
 
"""# Slightly modified from the rules on Wikipedia
A -> apple
B -> bag
S -> .shop
T -> the
the shop -> my brother
a never used -> .terminating rule""",
 
#................................................
 
"""# 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""",
 
#................................................
 
"""### 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
_+_ -> """,
 
#................................................
 
"""# 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"""
 
]
 
for n, ruleset in RuleSets:
let rules = ruleset.parse()
echo SampleTexts[n].apply(rules)</syntaxhighlight>
 
{{out}}
<pre>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</pre>
 
=={{header|OCaml}}==
Line 2,298 ⟶ 3,468:
I'm not familiar with string processing, or parsing, so there are probably better ways to express this in OCaml. One might be with the mikmatch library which allows pattern-matching with regexps. Here I've only used the OCaml stdlib...
 
<langsyntaxhighlight OCamllang="ocaml">(* Useful for resource cleanup (such as filehandles) *)
let try_finally x f g =
try let res = f x in g x; res
Line 2,345 ⟶ 3,515:
print_endline (run rules (input_line stdin));
translate ()
in try translate () with End_of_file -> ()</langsyntaxhighlight>
 
With the above compiled to an executable 'markov', and the five rule-sets in files, strings are accepted on stdin for translation:
Line 2,368 ⟶ 3,538:
000000A000000
00011H1111000
</pre>
 
=={{header|Pascal}}==
{{works with|FPC}}
<syntaxhighlight lang="pascal">
program InterpretMA;
{$mode objfpc}{$h+}{$j-}{$b-}
uses
SysUtils;
 
type
TRule = record
Pattern, Replacement: string;
Terminating: Boolean;
end;
 
function ParseMA(const aScheme: string; out aRules: specialize TArray<TRule>): Boolean;
function ParseLine(const s: string; out r: TRule): Boolean;
var
Terms: TStringArray;
begin
Terms := s.Split([' -> ']);
if Length(Terms) <> 2 then exit(False);
r.Pattern := Terms[0].Trim;
r.Replacement := Terms[1].Trim;
r.Terminating := False;
if (r.Replacement <> '') and (r.Replacement[1] = '.') then begin
r.Terminating := True;
Delete(r.Replacement, 1, 1);
end;
Result := True;
end;
var
Lines: TStringArray;
s: string;
I: Integer;
begin
aRules := nil;
if aScheme = '' then exit(False);
Lines := aScheme.Split([LineEnding], TStringSplitOptions.ExcludeEmpty);
if Lines = nil then exit(False);
SetLength(aRules, Length(Lines));
I := 0;
for s in Lines do begin
if s[1] = '#' then continue;
if not ParseLine(s, aRules[I]) then exit(False);
Inc(I);
end;
SetLength(aRules, I);
Result := True;
end;
 
function ExecuteMA(const aScheme, aInput: string): string;
var
Rules: array of TRule;
r: TRule;
Applied: Boolean;
begin
if not ParseMA(aScheme.Replace(#9, ' ', [rfReplaceAll]), Rules) then
exit('Error while parsing MA scheme');
Result := aInput;
repeat
Applied := False;
for r in Rules do begin
if r.Pattern = '' then begin
Result := r.Replacement + Result;
Applied := True;
end else begin
Applied := Result.IndexOf(r.Pattern) >= 0;
if Applied then
Result := Result.Replace(r.Pattern, r.Replacement);
end;
if Applied then begin
if r.Terminating then exit;
break;
end;
end;
until not Applied;
end;
 
type
TTestEntry = record
Scheme, Input, Output: string;
end;
 
const
LE = LineEnding;
TestSet: array[1..5] of TTestEntry = (
(Scheme:
'# This rules file is extracted from Wikipedia: ' +LE+
'# http://en.wikipedia.org/wiki/Markov_Algorithm' +LE+
'A -> apple' +LE+
'B -> bag' +LE+
'S -> shop' +LE+
'T -> the' +LE+
'the shop -> my brother' +LE+
'a never used -> .terminating rule';
Input: 'I bought a B of As from T S.'; Output: 'I bought a bag of apples from my brother.'),
(Scheme:
'# Slightly modified from the rules on Wikipedia' +LE+
'A -> apple' +LE+
'B -> bag' +LE+
'S -> .shop' +LE+
'T -> the' +LE+
'the shop -> my brother' +LE+
'a never used -> .terminating rule';
Input: 'I bought a B of As from T S.'; Output: 'I bought a bag of apples from T shop.'),
(Scheme:
'# BNF Syntax testing rules' +LE+
'A -> apple' +LE+
'WWWW -> with' +LE+
'Bgage -> ->.*' +LE+
'B -> bag' +LE+
'->.* -> money' +LE+
'W -> WW' +LE+
'S -> .shop' +LE+
'T -> the' +LE+
'the shop -> my brother' +LE+
'a never used -> .terminating rule';
Input: 'I bought a B of As W my Bgage from T S.'; Output: 'I bought a bag of apples with my money from T shop.'),
(Scheme:
'### Unary Multiplication Engine, for testing Markov Algorithm implementations' +LE+
'### By Donal Fellows.' +LE+
'# Unary addition engine' +LE+
'_+1 -> _1+' +LE+
'1+1 -> 11+' +LE+
'# Pass for converting from the splitting of multiplication into ordinary' +LE+
'# addition' +LE+
'1! -> !1' +LE+
',! -> !+' +LE+
'_! -> _' +LE+
'# Unary multiplication by duplicating left side, right side times' +LE+
'1*1 -> x,@y' +LE+
'1x -> xX' +LE+
'X, -> 1,1' +LE+
'X1 -> 1X' +LE+
'_x -> _X' +LE+
',x -> ,X' +LE+
'y1 -> 1y' +LE+
'y_ -> _' +LE+
'# Next phase of applying' +LE+
'1@1 -> x,@y' +LE+
'1@_ -> @_' +LE+
',@_ -> !_' +LE+
'++ -> +' +LE+
'# Termination cleanup for addition' +LE+
'_1 -> 1' +LE+
'1+_ -> 1' +LE+
'_+_ -> ';
Input: '_1111*11111_'; Output: '11111111111111111111'),
(Scheme:
'# Turing machine: three-state busy beaver' +LE+
'#' +LE+
'# state A, symbol 0 => write 1, move right, new state B' +LE+
'A0 -> 1B' +LE+
'# state A, symbol 1 => write 1, move left, new state C' +LE+
'0A1 -> C01' +LE+
'1A1 -> C11' +LE+
'# state B, symbol 0 => write 1, move left, new state A' +LE+
'0B0 -> A01' +LE+
'1B0 -> A11' +LE+
'# state B, symbol 1 => write 1, move right, new state B' +LE+
'B1 -> 1B' +LE+
'# state C, symbol 0 => write 1, move left, new state B' +LE+
'0C0 -> B01' +LE+
'1C0 -> B11' +LE+
'# state C, symbol 1 => write 1, move left, halt' +LE+
'0C1 -> H01' +LE+
'1C1 -> H11';
Input: '000000A000000'; Output: '00011H1111000')
);
E_FMT = 'test #%d: expected "%s", but got "%s"';
var
e: TTestEntry;
Result: string;
I: Integer = 1;
Failed: Integer = 0;
begin
for e in TestSet do begin
Result := ExecuteMA(e.Scheme, e.Input);
if Result <> e.Output then begin
WriteLn(Format(E_FMT, [I, e.Output, Result]));
Inc(Failed);
end;
Inc(I);
end;
WriteLn('tests completed: ', Length(TestSet), ', failed: ', Failed);
end.
</syntaxhighlight>
{{out}}
<pre>
tests completed: 5, failed: 0
</pre>
 
Line 2,373 ⟶ 3,735:
This program expects a source file as an argument and uses the standard input and output devices for the algorithm's I/O.
 
<langsyntaxhighlight lang="perl">@ARGV == 1 or die "Please provide exactly one source file as an argument.\n";
open my $source, '<', $ARGV[0] or die "I couldn't open \"$ARGV[0]\" for reading. ($!.)\n";
my @rules;
Line 2,390 ⟶ 3,752:
and ($terminating ? last OUTER : redo OUTER);}}
 
print $input;</langsyntaxhighlight>
 
=={{header|Perl 6Phix}}==
<!--<syntaxhighlight lang="phix">(phixonline)-->
<span style="color: #008080;">procedure</span> <span style="color: #000000;">markov</span><span style="color: #0000FF;">(</span><span style="color: #004080;">string</span> <span style="color: #000000;">rules</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">input</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">expected</span><span style="color: #0000FF;">)</span>
<span style="color: #004080;">sequence</span> <span style="color: #000000;">subs</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{},</span> <span style="color: #000000;">reps</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{}</span>
<span style="color: #004080;">sequence</span> <span style="color: #000000;">lines</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">split</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">substitute</span><span style="color: #0000FF;">(</span><span style="color: #000000;">rules</span><span style="color: #0000FF;">,</span><span style="color: #008000;">'\t'</span><span style="color: #0000FF;">,</span><span style="color: #008000;">' '</span><span style="color: #0000FF;">),</span><span style="color: #008000;">'\n'</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">lines</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span>
<span style="color: #004080;">string</span> <span style="color: #000000;">li</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">lines</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]</span>
<span style="color: #008080;">if</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">li</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">and</span> <span style="color: #000000;">li</span><span style="color: #0000FF;">[</span><span style="color: #000000;">1</span><span style="color: #0000FF;">]!=</span><span style="color: #008000;">'#'</span> <span style="color: #008080;">then</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">k</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">match</span><span style="color: #0000FF;">(</span><span style="color: #008000;">" -&gt; "</span><span style="color: #0000FF;">,</span><span style="color: #000000;">li</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">k</span> <span style="color: #008080;">then</span>
<span style="color: #000000;">subs</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">append</span><span style="color: #0000FF;">(</span><span style="color: #000000;">subs</span><span style="color: #0000FF;">,</span><span style="color: #7060A8;">trim</span><span style="color: #0000FF;">(</span><span style="color: #000000;">li</span><span style="color: #0000FF;">[</span><span style="color: #000000;">1</span><span style="color: #0000FF;">..</span><span style="color: #000000;">k</span><span style="color: #0000FF;">-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">]))</span>
<span style="color: #000000;">reps</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">append</span><span style="color: #0000FF;">(</span><span style="color: #000000;">reps</span><span style="color: #0000FF;">,</span><span style="color: #7060A8;">trim</span><span style="color: #0000FF;">(</span><span style="color: #000000;">li</span><span style="color: #0000FF;">[</span><span style="color: #000000;">k</span><span style="color: #0000FF;">+</span><span style="color: #000000;">4</span><span style="color: #0000FF;">..$]))</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<span style="color: #004080;">string</span> <span style="color: #000000;">res</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">input</span>
<span style="color: #004080;">bool</span> <span style="color: #000000;">term</span> <span style="color: #0000FF;">=</span> <span style="color: #004600;">false</span>
<span style="color: #008080;">while</span> <span style="color: #000000;">1</span> <span style="color: #008080;">do</span>
<span style="color: #004080;">bool</span> <span style="color: #000000;">found</span> <span style="color: #0000FF;">=</span> <span style="color: #004600;">false</span>
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">subs</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span>
<span style="color: #004080;">string</span> <span style="color: #000000;">sub</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">subs</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">k</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">match</span><span style="color: #0000FF;">(</span><span style="color: #000000;">sub</span><span style="color: #0000FF;">,</span><span style="color: #000000;">res</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">k</span> <span style="color: #008080;">then</span>
<span style="color: #000000;">found</span> <span style="color: #0000FF;">=</span> <span style="color: #004600;">true</span>
<span style="color: #004080;">string</span> <span style="color: #000000;">rep</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">reps</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]</span>
<span style="color: #008080;">if</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">rep</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">and</span> <span style="color: #000000;">rep</span><span style="color: #0000FF;">[</span><span style="color: #000000;">1</span><span style="color: #0000FF;">]=</span><span style="color: #008000;">'.'</span> <span style="color: #008080;">then</span>
<span style="color: #000000;">rep</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">rep</span><span style="color: #0000FF;">[</span><span style="color: #000000;">2</span><span style="color: #0000FF;">..$]</span>
<span style="color: #000000;">term</span> <span style="color: #0000FF;">=</span> <span style="color: #004600;">true</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #000000;">res</span><span style="color: #0000FF;">[</span><span style="color: #000000;">k</span><span style="color: #0000FF;">..</span><span style="color: #000000;">k</span><span style="color: #0000FF;">+</span><span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">sub</span><span style="color: #0000FF;">)-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">rep</span>
<span style="color: #008080;">exit</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">term</span> <span style="color: #008080;">then</span> <span style="color: #008080;">exit</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">term</span> <span style="color: #008080;">or</span> <span style="color: #008080;">not</span> <span style="color: #000000;">found</span> <span style="color: #008080;">then</span> <span style="color: #008080;">exit</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">while</span>
<span style="color: #0000FF;">?{</span><span style="color: #000000;">input</span><span style="color: #0000FF;">,</span><span style="color: #000000;">res</span><span style="color: #0000FF;">,</span><span style="color: #008080;">iff</span><span style="color: #0000FF;">(</span><span style="color: #000000;">res</span><span style="color: #0000FF;">=</span><span style="color: #000000;">expected</span><span style="color: #0000FF;">?</span><span style="color: #008000;">"ok"</span><span style="color: #0000FF;">:</span><span style="color: #008000;">"**ERROR**"</span><span style="color: #0000FF;">)}</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">procedure</span>
<span style="color: #008080;">constant</span> <span style="color: #000000;">ruleset1</span> <span style="color: #0000FF;">=</span> <span style="color: #008000;">"""
# This rules file is extracted from Wikipedia:
# http://en.wikipedia.org/wiki/Markov_Algorithm
A -&gt; apple
B -&gt; bag
S -&gt; shop
T -&gt; the
the shop -&gt; my brother
a never used -&gt; .terminating rule"""</span>
<span style="color: #000000;">markov</span><span style="color: #0000FF;">(</span><span style="color: #000000;">ruleset1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"I bought a B of As from T S."</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"I bought a bag of apples from my brother."</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">constant</span> <span style="color: #000000;">ruleset2</span> <span style="color: #0000FF;">=</span> <span style="color: #008000;">"""
# Slightly modified from the rules on Wikipedia
A -&gt; apple
B -&gt; bag
S -&gt; .shop
T -&gt; the
the shop -&gt; my brother
a never used -&gt; .terminating rule"""</span>
<span style="color: #000000;">markov</span><span style="color: #0000FF;">(</span><span style="color: #000000;">ruleset2</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"I bought a B of As from T S."</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"I bought a bag of apples from T shop."</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">constant</span> <span style="color: #000000;">ruleset3</span> <span style="color: #0000FF;">=</span> <span style="color: #008000;">"""
# BNF Syntax testing rules
A -&gt; apple
WWWW -&gt; with
Bgage -&gt; -&gt;.*
B -&gt; bag
-&gt;.* -&gt; money
W -&gt; WW
S -&gt; .shop
T -&gt; the
the shop -&gt; my brother
a never used -&gt; .terminating rule"""</span>
<span style="color: #000000;">markov</span><span style="color: #0000FF;">(</span><span style="color: #000000;">ruleset3</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"I bought a B of As W my Bgage from T S."</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"I bought a bag of apples with my money from T shop."</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">constant</span> <span style="color: #000000;">ruleset4</span> <span style="color: #0000FF;">=</span> <span style="color: #008000;">"""
### Unary Multiplication Engine, for testing Markov Algorithm implementations
### By Donal Fellows.
# Unary addition engine
_+1 -&gt; _1+
1+1 -&gt; 11+
# Pass for converting from the splitting of multiplication into ordinary
# addition
1! -&gt; !1
,! -&gt; !+
_! -&gt; _
# Unary multiplication by duplicating left side, right side times
1*1 -&gt; x,@y
1x -&gt; xX
X, -&gt; 1,1
X1 -&gt; 1X
_x -&gt; _X
,x -&gt; ,X
y1 -&gt; 1y
y_ -&gt; _
# Next phase of applying
1@1 -&gt; x,@y
1@_ -&gt; @_
,@_ -&gt; !_
++ -&gt; +
# Termination cleanup for addition
_1 -&gt; 1
1+_ -&gt; 1
_+_ -&gt;
"""</span>
<span style="color: #000000;">markov</span><span style="color: #0000FF;">(</span><span style="color: #000000;">ruleset4</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"_1111*11111_"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"11111111111111111111"</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">constant</span> <span style="color: #000000;">ruleset5</span> <span style="color: #0000FF;">=</span> <span style="color: #008000;">"""
# Turing machine: three-state busy beaver
#
# state A, symbol 0 =&gt; write 1, move right, new state B
A0 -&gt; 1B
# state A, symbol 1 =&gt; write 1, move left, new state C
0A1 -&gt; C01
1A1 -&gt; C11
# state B, symbol 0 =&gt; write 1, move left, new state A
0B0 -&gt; A01
1B0 -&gt; A11
# state B, symbol 1 =&gt; write 1, move right, new state B
B1 -&gt; 1B
# state C, symbol 0 =&gt; write 1, move left, new state B
0C0 -&gt; B01
1C0 -&gt; B11
# state C, symbol 1 =&gt; write 1, move left, halt
0C1 -&gt; H01
1C1 -&gt; H11
"""</span>
<span style="color: #000000;">markov</span><span style="color: #0000FF;">(</span><span style="color: #000000;">ruleset5</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"000000A000000"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"00011H1111000"</span><span style="color: #0000FF;">)</span>
<!--</syntaxhighlight>-->
{{out}}
<pre>
{"I bought a B of As from T S.","I bought a bag of apples from my brother.","ok"}
{"I bought a B of As from T S.","I bought a bag of apples from T shop.","ok"}
{"I bought a B of As W my Bgage from T S.","I bought a bag of apples with my money from T shop.","ok"}
{"_1111*11111_","11111111111111111111","ok"}
{"000000A000000","00011H1111000","ok"}
</pre>
 
=={{header|PHP}}==
Run this without arguments and it will scan the cwd for rules.* files and their corresponding test.*.
 
<syntaxhighlight lang="php"><?php
Run it with two filenames or one filename and some text to run a rulefile on the file contents or the given text.
 
function markov($text, $ruleset) {
Add --verbose to see the replacements step-by-step.
$lines = explode(PHP_EOL, $ruleset);
 
$rules = array();
<lang Perl6>grammar Markov {
tokenforeach TOP($lines AS $line) {
^$spc [^^= "[<rule>\t | <comment>] $$ [\n|$]]* $+";
if (empty($line) OR preg_match('/^#/', $line)) {
{ make $<rule>>>.ast }
continue;
}
} elseif (preg_match('/^(.+)' . $spc . '->' . $spc . '(\.?)(.*)$/', $line, $matches)) {
token comment {
list($dummy, $pattern, $terminating, $replacement) = $matches;
<before ^^> '#' \N*
{ make Nil } $rules[] = array(
'pattern' => trim($pattern),
}
'terminating' => ($terminating === '.'),
token ws {
'replacement' => trim($replacement),
[' '|\t]*
} );
rule rule { }
<before ^^>$<pattern>=[\N+?] '->'
$<terminal>=[\.]?$<replacement>=[\N*]
{ make {:pattern($<pattern>.Str),
:replacement($<replacement>.Str),
:terminal($<terminal>.Str eq ".")} }
}
do {
}
$found = false;
foreach ($rules AS $rule) {
sub run(:$ruleset, :$start_value, :$verbose?) {
if (strpos($text, $rule['pattern']) !== FALSE) {
my $value = $start_value;
$text = str_replace($rule['pattern'], $rule['replacement'], $text);
my @rules = Markov.parse($ruleset).ast.list;
if ($rule['terminating']) {
loop {
my $beginning = return $valuetext;
for @rules { }
my $prevfound = $valuetrue;
$value = $value.subst(.<pattern>, .<replacement>) break;
say $value if $verbose && $value ne $prev;}
return $value if .<terminal>;
last if $value ne $prev;
}
} while($found);
last if $value eq $beginning;
}return $text;
return $value;
}
 
$conf = array(
multi sub MAIN(Bool :$verbose?) {
1 => array(
my @rulefiles = dir.grep(/rules.+/).sort;
'text' => 'I bought a B of As from T S.',
for @rulefiles -> $rulefile {
'rule' => '
my $testfile = $rulefile.subst("rules", "test");
# This rules file is extracted from Wikipedia:
my $start_value = (try slurp($testfile).trim-trailing)
# http:// prompt("please give a start value: ");en.wikipedia.org/wiki/Markov_Algorithm
A -> apple
my $ruleset = slurp($rulefile); B -> bag
say $start_value.perl(); S -> shop
T -> the
say run(:$ruleset, :$start_value, :$verbose).perl;
say ''; the shop -> my brother
a never used -> .terminating rule
}
',
}
),
2 => array(
multi sub MAIN(Str $rulefile where *.IO.f, Str $input where *.IO.f, Bool :$verbose?) {
'text' => 'I bought a B of As from T S.',
my $ruleset = slurp($rulefile);
'rule' => '
my $start_value = slurp($input).trim-trailing;
# Slightly modified from the rules on Wikipedia
say "starting with $start_value.perl()";
A -> apple
say run(:$ruleset, :$start_value, :$verbose).perl;
B -> bag
}
S -> .shop
T -> the
multi sub MAIN(Str $rulefile where *.IO.f, *@pieces, Bool :$verbose?) {
the shop -> my brother
my $ruleset = slurp($rulefile);
a never used -> .terminating rule
my $start_value = @pieces.join(" ");
',
say "starting with $start_value.perl()";
),
say run(:$ruleset, :$start_value, :$verbose).perl;
3 => array(
}</lang>
'text' => 'I bought a B of As W my Bgage from T S.',
'rule' => '
# 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
',
),
4 => array(
'text' => '_1111*11111_',
'rule' => '
### 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
_+_ ->
',
),
5 => array(
'text' => '000000A000000',
'rule' => '
# 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
',
),
6 => array(
'text' => '101',
'rule' => '
# Another example extracted from Wikipedia:
# http://en.wikipedia.org/wiki/Markov_Algorithm
1 -> 0|
|0 -> 0||
0 ->
',
),
);
 
foreach ($conf AS $id => $rule) {
echo 'Ruleset ', $id, ' : ', markov($rule['text'], $rule['rule']), PHP_EOL;
}</syntaxhighlight>
 
{{out}}
<pre>Ruleset 1 : I bought a bag of apples from my brother.
Ruleset 2 : I bought a bag of apples from T shop.
Ruleset 3 : I bought a bag of apples with my money from T shop.
Ruleset 4 : 11111111111111111111
Ruleset 5 : 00011H1111000
Ruleset 6 : |||||</pre>
 
=={{header|PicoLisp}}==
<langsyntaxhighlight PicoLisplang="picolisp">(de markov (File Text)
(use (@A @Z R)
(let Rules
Line 2,485 ⟶ 4,068:
(T (= "." (cadr (setq R @)))
(append @A (cddr R) @Z) )
(setq Text (append @A (cdr R) @Z)) ) ) ) ) )</langsyntaxhighlight>
Output:
<pre>: (markov "r1" "I bought a B of As from T S.")
Line 2,501 ⟶ 4,084:
: (markov "r5" "000000A000000")
-> "00011H1111000"</pre>
 
=={{header|Prolog}}==
Works with SWI-Prolog and module(library(lambda)).<br>
Module lambda can be found there : http://www.complang.tuwien.ac.at/ulrich/Prolog-inedit/lambda.pl
 
<langsyntaxhighlight lang="prolog">:- module('markov.pl', [markov/3, apply_markov/3]).
 
:- use_module(library(lambda)).
 
apply_markov(Rules, Sentence, Replacement) :-
maplist(\X^Y^(atom_chars(X, Ch), phrase(markov(Y), Ch, [])), Rules, TmpRules),
% comments produce empty rules
exclude(=([]), TmpRules, LstRules),
 
atom_chars(Sentence, L),
apply_rules(L, LstRules, R),
atom_chars(Replacement, R).
 
apply_rules(In, Rules, Out ) :-
apply_one_rule(In, Rules, Out1, Keep_On),
( Keep_On = false
-> Out = Out1
; apply_rules(Out1, Rules, Out)).
 
 
apply_one_rule(In, [Rule | Rules], Out, Keep_On) :-
extract(Rule, In, Out1, KeepOn),
( KeepOn = false
-> Out = Out1, Keep_On = KeepOn
; (KeepOn = stop
-> Out = Out1,
Keep_On = true
; apply_one_rule(Out1, Rules, Out, Keep_On))).
 
apply_one_rule(In, [], In, false) .
Line 2,538 ⟶ 4,122:
 
extract([Pattern, Replace], In, Out, Keep_On) :-
( Replace = [.|Rest]
-> R = Rest
; R = Replace),
( (append(Pattern, End, T), append(Deb, T, In))
-> extract([Pattern, Replace], End, NewEnd, _Keep_On),
append_3(Deb, R, NewEnd, Out),
Keep_On = stop
; Out = In,
( R = Replace
-> Keep_On = true
; Keep_On = false)).
 
 
append_3(A, B, C, D) :-
append(A, B, T),
append(T, C, D).
 
% creation of the rules
Line 2,574 ⟶ 4,158:
 
rule([A,B]) -->
pattern(A), whitespaces, ['-', '>'], whitespaces, end_rule(B).
 
pattern([X | R]) --> [X], {X \= '\n'}, pattern(R).
Line 2,593 ⟶ 4,177:
replacement([X | R]) --> [X], {X \= '\n'}, replacement(R).
replacement([]) --> [].
</syntaxhighlight>
</lang>
Code to test :
<langsyntaxhighlight Prologlang="prolog">:- use_module('markov.pl').
:- use_module(library(lambda)).
 
markov :-
maplist(\X^(call(X), nl,nl), [markov_1, markov_2, markov_3, markov_4, markov_5]).
 
markov_1 :-
A = ['# 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'],
B = 'I bought a B of As from T S.',
apply_markov(A, B, R),
writeln(B),
writeln(R).
 
 
markov_2 :-
A = ['# Slightly modified from the rules on Wikipedia',
'A -> apple',
'B -> bag',
'S -> .shop',
'T -> the',
'the shop -> my brother',
'a never used -> .terminating rule'],
 
B = 'I bought a B of As from T S.',
 
apply_markov(A, B, R),
writeln(B),
writeln(R).
 
 
markov_3 :-
A = ['# 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'],
 
B = 'I bought a B of As W my Bgage from T S.',
 
apply_markov(A, B, R),
writeln(B),
writeln(R).
 
 
markov_4 :-
A = ['### 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',
'_+_ -> '],
 
B = '_1111*11111_',
 
apply_markov(A, B, R),
writeln(B),
writeln(R).
 
markov_5 :-
A = ['# 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'],
 
B = '000000A000000',
apply_markov(A, B, R),
writeln(B),
writeln(R).
</syntaxhighlight>
</lang>
Output :
<pre> ?- markov.
Line 2,740 ⟶ 4,324:
=={{header|PureBasic}}==
The GUI used here allows a ruleset to be loaded from a text file or manually added one rule at a time. Symbol input can be tested anytime by selecting 'Interpret'.
<langsyntaxhighlight PureBasiclang="purebasic">Structure mRule
pattern.s
replacement.s
Line 2,853 ⟶ 4,437:
EndSelect
Until isDone
</syntaxhighlight>
</lang>
Sample output from loading Ruleset 1 and interpreting a symbol:
<pre>Comment: "# This rules file is extracted from Wikipedia:"
Line 2,872 ⟶ 4,456:
 
The example gains flexibility by not being tied to specific files. The functions may be imported into other programs which then can provide textual input from their sources without the need to pass 'file handles' around.
<langsyntaxhighlight lang="python">import re
 
def extractreplacements(grammar):
Line 3,005 ⟶ 4,589:
== '11111111111111111111'
assert replace(text4, extractreplacements(grammar5)) \
== '00011H1111000'</langsyntaxhighlight>
 
=={{header|Racket}}==
Line 3,013 ⟶ 4,597:
The <tt>Markov-algorithm</tt> 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.
 
<langsyntaxhighlight lang="racket">
#lang racket
 
Line 3,042 ⟶ 4,626:
(let loop ([x x0] [fx (f x0)])
(if (equal? x fx) fx (loop fx (f fx)))))
</syntaxhighlight>
</lang>
 
Example of use:
 
<langsyntaxhighlight lang="racket">
> (define MA
(Markov-algorithm
Line 3,058 ⟶ 4,642:
> (MA "I bought a B of As from T S.")
"I bought a bag of apples from T shop."
</syntaxhighlight>
</lang>
 
===The source reader===
Line 3,064 ⟶ 4,648:
To read from a file just replace <tt>with-input-from-string</tt> ==> <tt>with-input-from-file</tt>.
 
<langsyntaxhighlight lang="racket">
;; the reader
(define (read-rules source)
Line 3,087 ⟶ 4,671:
(define (read-Markov-algorithm source)
(apply Markov-algorithm (read-rules source)))
</syntaxhighlight>
</lang>
 
Examples:
 
<langsyntaxhighlight lang="racket">
(define R3 (read-Markov-algorithm "
# BNF Syntax testing rules
Line 3,156 ⟶ 4,740:
0C1 -> H01
1C1 -> H11"))
</syntaxhighlight>
</lang>
 
<langsyntaxhighlight lang="racket">
> (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."
Line 3,167 ⟶ 4,751:
> (R5 "000000A000000")
"00011H1111000"
</syntaxhighlight>
</lang>
 
=={{header|Raku}}==
(formerly Perl 6)
Run this without arguments and it will scan the cwd for rules.* files and their corresponding test.*.
 
Run it with two filenames or one filename and some text to run a rulefile on the file contents or the given text.
 
Add --verbose to see the replacements step-by-step.
 
<syntaxhighlight lang="raku" line>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;
say run(:$ruleset, :$start_value, :$verbose);
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";
say run(:$ruleset, :$start_value, :$verbose);
}
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";
say run(:$ruleset, :$start_value, :$verbose);
}</syntaxhighlight>
 
=={{header|Refal}}==
<syntaxhighlight lang="refal">$ENTRY Go {
, <Arg 1>: e.File
, <Arg 2>: e.Input
, <ReadLines 1 e.File>: e.Lines
, <Each ParseRule e.Lines>: e.Rules
, <Apply (e.Rules) e.Input>: e.Result
= <Prout e.Result>;
};
 
Each {
s.F = ;
s.F (e.I) e.R = <Mu s.F e.I> <Each s.F e.R>;
};
 
ReadLines {
s.Chan e.File = <Open 'r' s.Chan e.File>
<ReadLines (s.Chan)>;
(s.Chan), <Get s.Chan>: {
0 = <Close s.Chan>;
e.Line = (e.Line) <ReadLines (s.Chan)>;
};
};
 
ParseRule {
= (Empty);
'#' e.X = (Empty);
e.Pat ' -> ' e.Rep,
<Trim e.Pat>: e.TrPat,
<Trim e.Rep>: e.TrRep,
e.TrRep: {
'.' e.R = (Term (e.Pat) (e.R));
e.R = (Nonterm (e.Pat) (e.R));
};
};
 
ApplyRule {
(s.Type (e.Pat) (e.Rep)) e.Subj,
e.Subj: e.X e.Pat e.Y = s.Type e.X e.Rep e.Y;
t.Rule e.Subj = NoMatch e.Subj;
};
 
Apply {
(e.Rules) () e.Subj = e.Subj;
(e.Rules) (t.Rule e.Rest) e.Subj,
<ApplyRule t.Rule e.Subj>: {
NoMatch e.Subj = <Apply (e.Rules) (e.Rest) e.Subj>;
Term e.Res = e.Res;
Nonterm e.Res = <Apply (e.Rules) e.Res>;
};
(e.Rules) e.Subj = <Apply (e.Rules) (e.Rules) e.Subj>;
};
 
Trim {
' ' e.X = <Trim e.X>;
e.X ' ' = <Trim e.X>;
e.X = e.X;
};</syntaxhighlight>
{{out}}
<pre>$ refgo markov ruleset1.mkv 'I bought a B of As from T S.'
I bought a bag of apples from my brother.
$ refgo markov ruleset2.mkv 'I bought a B of As from T S.'
I bought a bag of apples from T shop.
$ refgo markov ruleset3.mkv 'I bought a B of As W my Bgage from T S.'
I bought a bag of apples with my money from T shop.
$ refgo markov ruleset4.mkv '_111*11111_'
111111111111111
$ refgo markov ruleset5.mkv '000000A000000'
00011H1111000</pre>
 
=={{header|REXX}}==
Code was added to the REXX example to optionally list the contents of the ruleset and/or the Markov entries.
<br>Also, blank lines in the ruleset were treated as comments.
<langsyntaxhighlight lang="rexx">/*REXX program executes a Markov algorithm(s) against specified entries. */
parse arg low high . /*allows which ruleset to process. */
if low=='' | low=='",'" then low=1 /*Not specified? Then use the default.*/
if high=='' | high=='",'" then high=6 /* " " " " " " */
tellE= low<0; tellR= high<0 /*flags: used to display file contents.*/
call readEntry
do j=abs(low) to abs(high) /*process each of these rulesets. */
call readRules j /*read a particular ruleset. */
call execRules j /*execute " " " */
say 'result for ruleset' j "───►" !.j
end /*j*/
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
/*────────────────────────────────────────────────────────────────────────────*/
execRules: parse arg q .; if tellE | tellR then say /*show a blank line?*/
do f=1
do k=1 while @.k\==''; if left(@.k, 1)=='#' | @.k='' then iterate
parse var @.k a ' ->' b; /*obtain the A & B a=strip(a); parts from b=strip(b)rule.*/
fullstop= left(b,1)=='.' /*isa=strip(a); this a "fullstop" rule?b=strip(b) /*strip leading and/or trailing blanks.*/
if fullstop then b fullstop=substr left(b,2 1)==. /*purify the B part of the rule. /*is this a "fullstop" rule? 1≡yes */
old=!.q if fullstop then b=substr(b, 2) /*purify the B part of the rule. /*remember the value before the change.*/
!.q=changestr(a, old=!.q, b) /*implement the ruleset change. /*remember the value before the change.*/
if fullstop then if old\= !.q=changestr(a, !.q, b) then return /*shouldimplement the ruleset change. we stop? */
if fullstop then if old\==!.q then iteratereturn f /*Has Entry changed? Then start/*should we stop? over.*/
if old\==!.q then iterate f /*Has Entry changed? Then start over.*/
end /*k*/
leave end /*k*/
end /*f*/ return
end /*f*/
return
return
/*────────────────────────────────────────────────────────────────────────────*/
/*──────────────────────────────────────────────────────────────────────────────────────*/
readRules: parse arg ? .; rFID='MARKOV_R.'?; if tellR then say
@.readEntry: eFID= 'MARKOV.ENT'; if tellE then say /*placeholdershow fora allblank the Markov rules.line?*/
do r !.=1 while lines(rFID)\==0 /*readplaceholder thefor inputall filethe untiltest End-Of-Fileentries.*/
do e=1 while lines(eFID)\==0 /*read the input file until End-Of-File*/
@.r=linein(rFID); if tellR then say 'ruleSet' ?"."left(r,4)'≡'@.r
end /*r*/ !.e=linein(eFID); if tellE then say 'test entry' e /*(above) read and"───►" maybe echo the rule!.*/e
end /*e*/ /* [↑] read and maybe echo the entry. */
return
return
/*────────────────────────────────────────────────────────────────────────────*/
/*──────────────────────────────────────────────────────────────────────────────────────*/
readEntry: eFID='MARKOV.ENT'; if tellE then say
readRules: parse arg ? .; rFID= 'MARKOV_R.'?; if tellR then say /*show a blank line?*/
!.= /*placeholder for all the test entries.*/
do e @.=1 while lines(eFID)\==0 /*readplaceholder thefor inputall filethe untilMarkov End-Of-Filerules.*/
do r=1 while lines(rFID)\==0 /*read the input file until End-Of-File*/
!.e=linein(eFID); if tellE then say 'test entry' e"≡"!.e
end /*e*/ @.r=linein(rFID); if tellR then say 'ruleSet' /*?"."left(abover,4) read and maybe echo the'───►' entry*/@.r
end /*r*/ /* [↑] read and maybe echo the rule. */
return</lang>
return</syntaxhighlight>
Some older REXXes don't have a &nbsp; '''changestr''' &nbsp; BIF, so one is included here &nbsp; ──► &nbsp; [[CHANGESTR.REX]].
<br><br>
'''{{out|output''' |text=&nbsp; when using the default input and files:}}
<pre>
result for ruleset 1≡I1 ───► I bought a bagB of applesAs from myT brotherS.
result for ruleset 2≡I2 ───► I bought a bag of apples from T shop.
result for ruleset 3≡I3 ───► I bought a bag of apples with my money from T shop.
result for ruleset 4≡111111111111111111114 ───► 11111111111111111111
result for ruleset 5≡00011H11110005 ───► 00011H1111000
result for ruleset 6≡6 ───► |||||
</pre>
'''{{out|Ruleset &nbsp;6'''|text=&nbsp; is:}}
<pre>
# Rewrite binary numbers to their unary value (| bars).
Line 3,235 ⟶ 4,964:
 
=={{header|Ruby}}==
{{works with|Ruby|13.82.70}}
<langsyntaxhighlight Rubylang="ruby">def setup(ruleset)
ruleset.each_line.inject([]) do |rules, line|
if line =~ /^\s*#/
Line 3,248 ⟶ 4,977:
end
 
def morcovmarkov(ruleset, input_data)
rules = setup(ruleset)
while (matched = rules.find { |match, replace, term|
Line 3,255 ⟶ 4,984:
end
input_data
end</langsyntaxhighlight>
 
'''Test:'''
<langsyntaxhighlight Rubylang="ruby">ruleset1 = <<EOS
# This rules file is extracted from Wikipedia:
# http://en.wikipedia.org/wiki/Markov_Algorithm
Line 3,269 ⟶ 4,998:
EOS
 
puts morcovmarkov(ruleset1, "I bought a B of As from T S.")
 
ruleset2 = <<EOS
Line 3,281 ⟶ 5,010:
EOS
 
puts morcovmarkov(ruleset2, "I bought a B of As from T S.")
 
ruleset3 = <<EOS
Line 3,297 ⟶ 5,026:
EOS
 
puts morcovmarkov(ruleset3, "I bought a B of As W my Bgage from T S.")
 
ruleset4 = <<EOS
Line 3,330 ⟶ 5,059:
EOS
 
puts morcovmarkov(ruleset4, "_1111*11111_")
 
ruleset5 = <<EOS
Line 3,353 ⟶ 5,082:
EOS
 
puts morcovmarkov(ruleset5, "000000A000000")</langsyntaxhighlight>
 
{{out}}
Line 3,363 ⟶ 5,092:
00011H1111000
</pre>
 
=={{header|Rust}}==
 
<syntaxhighlight lang="rust">use std::str::FromStr;
 
#[derive(Clone, Debug)]
pub struct Rule {
pub pat: String,
pub rep: String,
pub terminal: bool,
}
 
impl Rule {
pub fn new(pat: String, rep: String, terminal: bool) -> Self {
Self { pat, rep, terminal }
}
 
pub fn applicable_range(&self, input: impl AsRef<str>) -> Option<std::ops::Range<usize>> {
input
.as_ref()
.match_indices(&self.pat)
.next()
.map(|(start, slice)| start..start + slice.len())
}
 
pub fn apply(&self, s: &mut String) -> bool {
self.applicable_range(s.as_str()).map_or(false, |range| {
s.replace_range(range, &self.rep);
true
})
}
}
 
impl FromStr for Rule {
type Err = String;
 
fn from_str(s: &str) -> Result<Self, Self::Err> {
let mut split = s.splitn(2, " -> ");
let pat = split.next().ok_or_else(|| s.to_string())?;
let rep = split.next().ok_or_else(|| s.to_string())?;
 
let pat = pat.to_string();
if rep.starts_with('.') {
Ok(Self::new(pat, rep[1..].to_string(), true))
} else {
Ok(Self::new(pat, rep.to_string(), false))
}
}
}
 
#[derive(Clone, Debug)]
pub struct Rules {
rules: Vec<Rule>,
}
 
impl Rules {
pub fn new(rules: Vec<Rule>) -> Self {
Self { rules }
}
 
pub fn apply(&self, s: &mut String) -> Option<&Rule> {
self.rules
.iter()
.find(|rule| rule.apply(s))
}
 
pub fn execute(&self, mut buffer: String) -> String {
while let Some(rule) = self.apply(&mut buffer) {
if rule.terminal {
break;
}
}
 
buffer
}
}
 
impl FromStr for Rules {
type Err = String;
 
fn from_str(s: &str) -> Result<Self, Self::Err> {
let mut rules = Vec::new();
 
for line in s.lines().filter(|line| !line.starts_with('#')) {
rules.push(line.parse::<Rule>()?);
}
 
Ok(Rules::new(rules))
}
}
 
#[cfg(test)]
mod tests {
 
use super::Rules;
 
#[test]
fn case_01() -> Result<(), String> {
let input = "I bought a B of As from T S.";
let rules = "\
# 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";
 
assert_eq!(
rules.parse::<Rules>()?.execute(input.to_string()),
"I bought a bag of apples from my brother."
);
 
Ok(())
}
 
#[test]
fn case_02() -> Result<(), String> {
let input = "I bought a B of As from T S.";
let rules = "\
# Slightly modified from the rules on Wikipedia
A -> apple
B -> bag
S -> .shop
T -> the
the shop -> my brother
a never used -> .terminating rule";
 
assert_eq!(
rules.parse::<Rules>()?.execute(input.to_string()),
"I bought a bag of apples from T shop."
);
 
Ok(())
}
 
#[test]
fn case_03() -> Result<(), String> {
let input = "I bought a B of As W my Bgage from T S.";
let rules = "\
# 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";
 
assert_eq!(
rules.parse::<Rules>()?.execute(input.to_string()),
"I bought a bag of apples with my money from T shop."
);
 
Ok(())
}
 
#[test]
fn case_04() -> Result<(), String> {
let input = "_1111*11111_";
let rules = "\
### 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
_+_ -> ";
 
assert_eq!(
rules.parse::<Rules>()?.execute(input.to_string()),
"11111111111111111111"
);
 
Ok(())
}
 
#[test]
fn case_05() -> Result<(), String> {
let input = "000000A000000";
let rules = "\
# 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";
 
assert_eq!(
rules.parse::<Rules>()?.execute(input.to_string()),
"00011H1111000"
);
 
Ok(())
}
}
</syntaxhighlight>
 
=={{header|Scala}}==
{{works with|Scala|2.8}}
<langsyntaxhighlight lang="scala">import scala.io.Source
 
object MarkovAlgorithm {
Line 3,395 ⟶ 5,358:
println(algorithm(args(1)))
}
}</langsyntaxhighlight>
 
Script-style, and more concise:
 
<langsyntaxhighlight lang="scala">import scala.io.Source
 
if (argv.size != 2 ) error("Syntax: MarkovAlgorithm inputFile inputPattern")
Line 3,414 ⟶ 5,377:
 
println(argv(1))
println(algorithm(argv(1)))</langsyntaxhighlight>
 
Sample outputs:
Line 3,442 ⟶ 5,405:
The following implementation uses several string-related procedures provided by SRFI-13 [http://srfi.schemers.org/srfi-13/srfi-13.html].
 
<langsyntaxhighlight lang="scheme">
(define split-into-lines
(lambda (str)
Line 3,490 ⟶ 5,453:
rules))
(loop (cdr remaining) result)))))))
</syntaxhighlight>
</lang>
 
=={{header|SequenceL}}==
 
<syntaxhighlight lang="sequencel">
import <Utilities/Sequence.sl>;
 
Rule ::= ( pattern : char(1),
replacement : char(1),
terminal : bool);
 
ReplaceResult ::= (newString : char(1), wasReplaced : bool);
 
main(args(2)) := markov(createRule(split(args[1], '\n')), 1, args[2]);
 
createRule(line(1)) :=
let
containsComments := firstIndexOf(line, '#');
removedComments := line when containsComments = 0 else
line[1 ... containsComments - 1];
 
arrowLocation := startOfArrow(removedComments, 1);
lhs := removedComments[1 ... arrowLocation-1];
rhs := removedComments[arrowLocation + 4 ... size(removedComments)];
isTerminal := size(rhs) > 0 and rhs[1] = '.';
in
(pattern : lhs,
replacement : rhs[2 ... size(rhs)] when isTerminal else rhs,
terminal : isTerminal) when size(removedComments) > 0 and arrowLocation /= -1;
 
startOfArrow(line(1), n) :=
-1 when n > size(line) - 3 else
n when (line[n]=' ' or line[n]='\t') and
line[n+1] = '-' and line[n+2] = '>' and
(line[n+3]=' ' or line[n+3]='\t') else
startOfArrow(line, n+1);
 
markov(rules(1), n, input(1)) :=
let
replaced := replaceSubString(input, rules[n].pattern, rules[n].replacement, 1);
in
input when n > size(rules) else
replaced.newString when replaced.wasReplaced and rules[n].terminal else
markov(rules, 1, replaced.newString) when replaced.wasReplaced else
markov(rules, n+1, input);
 
replaceSubString(str(1), original(1), new(1), n) :=
(newString : str, wasReplaced : false)
when n > size(str) - size(original) + 1 else
(newString : str[1 ... n - 1] ++ new ++ str[n + size(original) ... size(str)], wasReplaced : true)
when equalList(str[n ... n + size(original) - 1], original) else
replaceSubString(str, original, new, n + 1);
 
</syntaxhighlight>
 
=={{header|SETL}}==
<syntaxhighlight lang="setl">program markov_algorithm;
magic := false;
if command_line(1) = om then
print("error: no ruleset file given");
stop;
elseif command_line(2) = om then
print("error: no input string given");
stop;
end if;
 
rules := read_file(command_line(1));
 
input := command_line(2);
loop do
loop for [pat, repl, trm] in rules do
if pat in input then
input(pat) := repl;
if trm then
quit;
else
continue loop do;
end if;
end if;
end loop;
quit;
end loop;
print(input);
 
proc read_file(file_name);
if (rulefile := open(file_name, "r")) = om then
print("error: cannot open ruleset file");
stop;
end if;
rules := [];
loop doing
line := getline(rulefile);
while line /= om do
rule := parse_rule(line);
if rule /= om then rules with:= rule; end if;
end loop;
return rules;
end proc;
proc parse_rule(rule);
if rule(1) = "#" then return om; end if; $ comment
if " -> " notin rule then return om; end if; $ not a rule
[s, e] := mark(rule, " -> ");
pattern := rule(..s-1);
repl := rule(e+1..);
whitespace := "\t\r\n ";
span(pattern, whitespace);
rspan(pattern, whitespace);
span(repl, whitespace);
rspan(repl, whitespace);
trm := match(repl, ".") /= "";
return [pattern, repl, trm];
end proc;
end program;</syntaxhighlight>
{{out}}
<pre>$ setl markov.setl ruleset1.mkv "I bought a B of As from T S."
I bought a bag of apples from my brother.
$ setl markov.setl ruleset2.mkv "I bought a B of As from T S."
I bought a bag of apples from T shop.
$ setl markov.setl ruleset3.mkv "I bought a B of As W my Bgage from T S."
I bought a bag of apples with my money from T shop.
$ setl markov.setl ruleset4.mkv "_1111*11111_"
11111111111111111111
$ setl markov.setl ruleset5.mkv "000000A000000"
00011H1111000</pre>
 
=={{header|SNOBOL4}}==
Note that the run-time data is immediately after the "end" label. This works with CSNOBOL4, on a Unix (or Unix-like) platform.
The Markov rules are actually compiled into the program after parsing, and are then directly executed (self-modifying code).
<syntaxhighlight lang="snobol4">
<lang SNOBOL4>
#!/bin/sh
exec "snobol4" "-r" "$0" "$@"
Line 3,626 ⟶ 5,715:
000000A000000
END
</syntaxhighlight>
</lang>
 
 
=={{header|Swift}}==
{{trans|Ruby}}
<langsyntaxhighlight lang="swift">import Foundation
 
func setup(ruleset: String) -> [(String, String, Bool)] {
Line 3,676 ⟶ 5,764:
}
 
</syntaxhighlight>
</lang>
{{out}}
<pre>
Line 3,688 ⟶ 5,776:
=={{header|Tcl}}==
{{works with|Tcl|8.5}}
<langsyntaxhighlight lang="tcl">package require Tcl 8.5
if {$argc < 3} {error "usage: $argv0 ruleFile inputFile outputFile"}
lassign $argv ruleFile inputFile outputFile
Line 3,698 ⟶ 5,786:
if {[string match "#*" $line] || $line eq ""} continue
if {[regexp {^(.+)\s+->\s+(\.?)(.*)$} $line -> from final to]} {
lappend rules $from $to [string compare "." $final] [string length $from]
} else {
error "Syntax error: \"$line\""
}
}
Line 3,710 ⟶ 5,798:
set any 1
while {$any} {
set any 0
foreach {from to more fl} $rules {
# If we match the 'from' pattern...
if {[set idx [string first $from $line]] >= 0} {
# Change for the 'to' replacement
set line [string replace $line $idx [expr {$idx+$fl-1}] $to]
 
# Stop if we terminate, otherwise note that we've more work to do
set any $more
break; # Restart search for rules to apply
}
}
}
#DEBUG# puts $line
}
Line 3,728 ⟶ 5,816:
puts $out $line
}
close $out</langsyntaxhighlight>
In the case where there are no terminating rules and no overlapping issues, the following is an alternative:
<langsyntaxhighlight lang="tcl">package require Tcl 8.5
if {$argc < 3} {error "usage: $argv0 ruleFile inputFile outputFile"}
lassign $argv ruleFile inputFile outputFile
Line 3,742 ⟶ 5,830:
dict set rules $from $to
} else {
error "Syntax error: \"$line\""
}
}
Line 3,757 ⟶ 5,845:
}
puts $out $data
close $out</langsyntaxhighlight>
 
=={{header|VBScript}}==
====Implementation====
<syntaxhighlight lang="vb">
<lang vb>
class markovparser
 
dim aRules
public property let ruleset( sBlock )
dim i
aRules = split( sBlock, vbNewLine )
'~ remove blank lines from end of array
do while aRules( ubound( aRules ) ) = vbnullstring
redim preserve aRules( ubound( aRules ) - 1 )
loop
'~ parse array
for i = lbound( aRules ) to ubound( aRules )
if left( aRules( i ), 1 ) = "#" then
aRules( i ) = Array( vbnullstring, aRules(i))
else
aRules( i ) = Split( aRules( i ), " -> ", 2 )
end if
next
end property
public function apply( sArg )
dim ruleapplied
dim terminator
dim was
dim i
dim repl
dim changes
ruleapplied = true
terminator = false
 
do while ruleapplied and (not terminator)
changes = 0
was = sArg
for i = lbound( aRules ) to ubound( aRules )
repl = aRules(i)(1)
if left( repl, 1 ) = "." then
terminator = true
repl = mid( repl, 2 )
end if
sArg = replace( sArg, aRules(i)(0), repl)
if was <> sArg then
changes = changes + 1
if changes = 1 then
exit for
end if
end if
if terminator then
exit for
end if
next
if changes = 0 then
ruleapplied = false
end if
loop
apply = sArg
end function
sub dump
dim i
for i = lbound( aRules ) to ubound( aRules )
wscript.echo eef(aRules(i)(0)=vbnullstring,aRules(i)(1),aRules(i)(0)& " -> " & aRules(i)(1)) & eef( left( aRules(i)(1), 1 ) = ".", " #terminator", "" )
next
end sub
private function eef( bCond, sExp1, sExp2 )
if bCond then
eef = sExp1
else
eef = sExp2
end if
end function
end class
</syntaxhighlight>
</lang>
 
=====Invocation=====
<syntaxhighlight lang="vb">
<lang vb>
dim m1
set m1 = new markovparser
Line 3,899 ⟶ 5,987:
m5.ruleset = fso.opentextfile("busybeaver.tur").readall
wscript.echo m5.apply("000000A000000")
</syntaxhighlight>
</lang>
 
=====Output=====
<syntaxhighlight lang="vb">
<lang vb>
I bought a bag of apples from my brother.
I bought a bag of apples from T shop.
Line 3,908 ⟶ 5,996:
11111111111111111111
00011H1111000
</syntaxhighlight>
</lang>
 
=={{header|Wren}}==
{{trans|Kotlin}}
{{libheader|Wren-ioutil}}
{{libheader|wren-pattern}}
<syntaxhighlight lang="wren">import "./ioutil" for FileUtil, File
import "./pattern" for Pattern
 
var lb = FileUtil.lineBreak
 
/* rulesets assumed to be separated by a blank line in file */
var readRules = Fn.new { |path|
return File.read(path).trimEnd().split("%(lb)%(lb)").map { |rs| rs.split(lb) }.toList
}
 
/* tests assumed to be on consecutive lines */
var readTests = Fn.new { |path| File.read(path).trimEnd().split(lb) }
 
var rules = readRules.call("markov_rules.txt")
var tests = readTests.call("markov_tests.txt")
var pattern = Pattern.new("+0/s[~.][+0/z]", Pattern.start)
var ix = 0
for (origTest in tests) {
var captures = []
for (rule in rules[ix]) {
if (rule.startsWith("#")) continue
var splits = rule.split(" -> ")
var m = pattern.find(splits[1])
if (m) captures.add([splits[0].trimEnd()] + m.capsText)
}
var test = origTest
while (true) {
var copy = test
var redo = false
for (c in captures) {
test = test.replace(c[0], c[2])
if (c[1] == ".") break
if (test != copy) {
redo = true
break
}
}
if (!redo) break
}
System.print("%(origTest)\n%(test)\n")
ix = ix + 1
}</syntaxhighlight>
 
{{out}}
<pre>
I bought a B of As from T S.
I bought a bag of apples from my brother.
 
I bought a B of As from T S.
I bought a bag of apples from T shop.
 
I bought a B of As W my Bgage from T S.
I bought a bag of apples with my money from T shop.
 
_1111*11111_
11111111111111111111
 
000000A000000
00011H1111000
</pre>
 
=={{header|zkl}}==
<langsyntaxhighlight lang="zkl">fcn parseRuleSet(lines){
if(vm.numArgs>1) lines=vm.arglist; // lines or object
ks:=L(); vs:=L();
foreach line in (lines){
if(line[0]=="#") continue; // nuke <comment>
pattern,replacement:=line.replace("\t"," ")
.split(" -> ",1).apply("strip");
Line 3,927 ⟶ 6,080:
do{ go:=False;
foreach n,k in (eks){
if (Void!=text.find(k)){
if (Void==(v:=vs[n])) return(text);
if (v[0,1]==".") v=v[1,*] else go=True;
text=text.replace(k,v,1);
break; // restart after every rule application, unless terminating
}
}
}while(go);
text
}</langsyntaxhighlight>
<langsyntaxhighlight lang="zkl">ruleSet:=parseRuleSet("# This rules file is extracted from Wikipedia:",
"# http://en.wikipedia.org/wiki/Markov_Algorithm",
"A\t->\tapple", "B -> bag", "S -> shop", "T -> the",
"the shop -> my brother", "a never used -> .terminating rule");
ruleSet.println();
markov("I bought a B of As from T S.",ruleSet).println();</langsyntaxhighlight>
{{out}}
<pre>
Line 3,948 ⟶ 6,101:
I bought a bag of apples from my brother.
</pre>
<langsyntaxhighlight lang="zkl">parseRuleSet( // rule set in a list
T("# Slightly modified from the rules on Wikipedia",
"A -> apple", "B -> bag", "S -> .shop", "T -> the",
Line 3,958 ⟶ 6,111:
"W -> WW", "S -> .shop", "T -> the",
"the shop -> my brother", "a never used -> .terminating rule") :
markov("I bought a B of As W my Bgage from T S.",_).println();</langsyntaxhighlight>
{{out}}
<pre>
Line 3,965 ⟶ 6,118:
</pre>
For the next two tasks, read the rule set from a file.
<langsyntaxhighlight lang="zkl">parseRuleSet(File("ruleSet4")) : markov("_1111*11111_",_).println();
parseRuleSet(File("ruleSet5")) : markov("000000A000000",_).println();</langsyntaxhighlight>
{{out}}
<pre>
2,095

edits