Execute a Markov algorithm: Difference between revisions
Add Cowgol
Not a robot (talk | contribs) (Add Cowgol) |
|||
Line 1,400:
NIL
</lang>
=={{header|Cowgol}}==
<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();</lang>
{{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}}==
| |||