Another update from ingydotnet^djgoku
This commit is contained in:
Ingy döt Net
parent
91df62d461
commit
948b86eafa
7604 changed files with 108452 additions and 22726 deletions
|
|
@ -46,7 +46,7 @@ multi sub MAIN(Bool :$verbose?) {
|
|||
my $ruleset = slurp($rulefile);
|
||||
say $start_value.perl();
|
||||
say run(:$ruleset, :$start_value, :$verbose).perl;
|
||||
say;
|
||||
say '';
|
||||
}
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -1,41 +1,41 @@
|
|||
/*REXX pgm to execute a Markov algorithm(s) against specified entries.*/
|
||||
parse arg low high . /*allow which ruleset to process.*/
|
||||
if low=='' | low==',' then low=1 /*assume a default if none given.*/
|
||||
if high=='' | high==',' then high=6 /*assume a default if none given.*/
|
||||
tellE = low<0; tellR = high<0 /*flags: display file contents. */
|
||||
/*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 " " " */
|
||||
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 done.*/
|
||||
/*───────────────────────────────EXECRULES──────────────────────────────*/
|
||||
execRules: parse arg q .; if tellE | tellR then say
|
||||
do f=1 /* forever */
|
||||
do k=1 while @.k\==''; if left(@.k,1)=='#' | @.k='' then iterate
|
||||
parse var @.k a ' ->' b; a=strip(a); b=strip(b)
|
||||
fullstop= left(b,1)=='.' /*is this a fullstop rule? */
|
||||
if fullstop then b=substr(b,2) /*purify the B part of the rule. */
|
||||
old=!.q /*remember value before change. */
|
||||
!.q=changestr(a, !.q, b) /*implement the ruleset change. */
|
||||
if fullstop then if old\==!.q then return /*should we stop?*/
|
||||
if old\==!.q then iterate f /*Entry changed? Then start over*/
|
||||
exit /*stick a fork in it, we're all done. */
|
||||
/*────────────────────────────────────────────────────────────────────────────*/
|
||||
execRules: parse arg q .; if tellE | tellR then say /*a blank line*/
|
||||
do f=1
|
||||
do k=1 while @.k\==''; if left(@.k,1)=='#' | @.k='' then iterate
|
||||
parse var @.k a ' ->' b; a=strip(a); b=strip(b)
|
||||
fullstop= left(b,1)=='.' /*is this a "fullstop" rule? */
|
||||
if fullstop then b=substr(b,2) /*purify the B part of the rule. */
|
||||
old=!.q /*remember the value before the change.*/
|
||||
!.q=changestr(a, !.q, b) /*implement the ruleset change. */
|
||||
if fullstop then if old\==!.q then return /*should we stop? */
|
||||
if old\==!.q then iterate f /*Has Entry changed? Then start over.*/
|
||||
end /*k*/
|
||||
leave
|
||||
end /*f*/
|
||||
return
|
||||
/*───────────────────────────────READRULES──────────────────────────────*/
|
||||
/*────────────────────────────────────────────────────────────────────────────*/
|
||||
readRules: parse arg ? .; rFID='MARKOV_R.'?; if tellR then say
|
||||
@.= /*placeholder: all Markov rules.*/
|
||||
do r=1 while lines(rFID)\==0 /*read the input file until E-O-F*/
|
||||
@.= /*placeholder for all the Markov rules.*/
|
||||
do r=1 while lines(rFID)\==0 /*read the input file until End-Of-File*/
|
||||
@.r=linein(rFID); if tellR then say 'ruleSet' ?"."left(r,4)'≡'@.r
|
||||
end /*r*/ /*(above) read and maybe echo it.*/
|
||||
end /*r*/ /*(above) read and maybe echo the rule.*/
|
||||
return
|
||||
/*───────────────────────────────READENTRY──────────────────────────────*/
|
||||
readEntry: eFID='MARKOV.ENT'; if tellE then say
|
||||
!.= /*placeholder: all test entries.*/
|
||||
do e=1 while lines(eFID)\==0 /*read the input file until E-O-F*/
|
||||
/*────────────────────────────────────────────────────────────────────────────*/
|
||||
readEntry: eFID='MARKOV.ENT'; if tellE then say
|
||||
!.= /*placeholder for all the test entries.*/
|
||||
do e=1 while lines(eFID)\==0 /*read the input file until End-Of-File*/
|
||||
!.e=linein(eFID); if tellE then say 'test entry' e"≡"!.e
|
||||
end /*e*/ /*(above) read and maybe echo it.*/
|
||||
end /*e*/ /*(above) read and maybe echo the entry*/
|
||||
return
|
||||
|
|
|
|||
|
|
@ -0,0 +1,128 @@
|
|||
#!/bin/sh
|
||||
exec "snobol4" "-r" "$0" "$@"
|
||||
*
|
||||
* http://rosettacode.org/wiki/Execute_a_Markov_algorithm
|
||||
*
|
||||
define('repl(s1,s2,s3)c,t,findc') :(repl_end)
|
||||
repl s2 len(1) . c = :f(freturn)
|
||||
findc = break(c) . t len(1)
|
||||
s2 = pos(0) s2
|
||||
repl_1 s1 findc = :f(repl_2)
|
||||
s1 s2 = :f(repl_3)
|
||||
repl = repl t s3 :(repl_1)
|
||||
repl_3 repl = repl t c :(repl_1)
|
||||
repl_2 repl = repl s1 :(return)
|
||||
repl_end
|
||||
*
|
||||
define('quote(s)q,qq') :(quote_end)
|
||||
quote q = "'"; qq = '"'
|
||||
quote = q repl(s, q, q ' ' qq q qq ' ' q) q :(return)
|
||||
quote_end
|
||||
*
|
||||
whitespace = span(' ' char(9))
|
||||
top r = 0
|
||||
read s = input :f(end)
|
||||
s pos(0) 'ENDRULE' rpos(0) :s(interp)
|
||||
s pos(0) '#' :s(read)
|
||||
pattern =; replacement =; term =
|
||||
s arb . pattern whitespace '->' whitespace
|
||||
+ ('.' | '') . term arb . replacement rpos(0) :f(syntax)
|
||||
r = r + 1
|
||||
f = ident(term, '.') ' :(done)'
|
||||
f = ident(term) ' :f(rule' r + 1 ')s(rule1)'
|
||||
c = 'rule' r ' s ' quote(pattern) ' = ' quote(replacement) f
|
||||
code(c) :s(read)
|
||||
output = 'rule: ' s ' generates code ' c ' in error' :(end)
|
||||
syntax output = 'rule: ' s ' in error' :(read)
|
||||
interp code('rule' r + 1 ' :(done)')
|
||||
go s = input :f(end)
|
||||
s pos(0) 'END' rpos(0) :s(top)f(rule1)
|
||||
done output = s :(go)
|
||||
end
|
||||
# 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
|
||||
ENDRULE
|
||||
I bought a B of As from T S.
|
||||
END
|
||||
# Slightly modified from the rules on Wikipedia
|
||||
A -> apple
|
||||
B -> bag
|
||||
S -> .shop
|
||||
T -> the
|
||||
the shop -> my brother
|
||||
a never used -> .terminating rule
|
||||
ENDRULE
|
||||
I bought a B of As from T S.
|
||||
END
|
||||
# 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
|
||||
ENDRULE
|
||||
I bought a B of As W my Bgage from T S.
|
||||
END
|
||||
### 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
|
||||
_+_ ->
|
||||
ENDRULE
|
||||
_1111*11111_
|
||||
END
|
||||
# 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
|
||||
ENDRULE
|
||||
000000A000000
|
||||
END
|
||||
Loading…
Add table
Add a link
Reference in a new issue