Execute a Markov algorithm: Difference between revisions
Content added Content deleted
Thundergnat (talk | contribs) (Rename Perl 6 -> Raku, alphabetize, minor clean-up) |
|||
Line 1,891: | Line 1,891: | ||
Input: '000000A000000' has output: '00011H1111000' |
Input: '000000A000000' has output: '00011H1111000' |
||
</pre> |
</pre> |
||
=={{header|Haskell}}== |
=={{header|Haskell}}== |
||
Line 2,796: | Line 2,794: | ||
print $input;</lang> |
print $input;</lang> |
||
=={{header|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. |
|||
<lang perl6>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.perl(); |
|||
say run(:$ruleset, :$start_value, :$verbose).perl; |
|||
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.perl()"; |
|||
say run(:$ruleset, :$start_value, :$verbose).perl; |
|||
} |
|||
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.perl()"; |
|||
say run(:$ruleset, :$start_value, :$verbose).perl; |
|||
}</lang> |
|||
=={{header|Phix}}== |
=={{header|Phix}}== |
||
Line 3,867: | Line 3,791: | ||
"00011H1111000" |
"00011H1111000" |
||
</lang> |
</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. |
|||
<lang perl6>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.perl(); |
|||
say run(:$ruleset, :$start_value, :$verbose).perl; |
|||
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.perl()"; |
|||
say run(:$ruleset, :$start_value, :$verbose).perl; |
|||
} |
|||
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.perl()"; |
|||
say run(:$ruleset, :$start_value, :$verbose).perl; |
|||
}</lang> |
|||
=={{header|REXX}}== |
=={{header|REXX}}== |
||
Line 4,378: | Line 4,377: | ||
END |
END |
||
</lang> |
</lang> |
||
=={{header|Swift}}== |
=={{header|Swift}}== |