Execute a Markov algorithm: Difference between revisions
Content added Content deleted
Thundergnat (talk | contribs) m (syntax highlighting fixup automation) |
(added Pascal example) |
||
Line 3,538: | Line 3,538: | ||
000000A000000 |
000000A000000 |
||
00011H1111000 |
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; |
|||
TRules = array of TRule; |
|||
function ParseMA(const aScheme: string; out aRules: TRules): 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].TrimRight; |
|||
if r.Pattern = '' then exit(False); |
|||
r.Replacement := Terms[1].TrimLeft; |
|||
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: TRules; |
|||
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 |
|||
if Result.IndexOf(r.Pattern) >= 0 then begin |
|||
Result := Result.Replace(r.Pattern, r.Replacement); |
|||
if r.Terminating then exit; |
|||
Applied := True; |
|||
break; |
|||
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> |
</pre> |
||