Paste: Trumpet players
Author: | Leonidas |
Mode: | factor |
Date: | Thu, 25 Feb 2010 11:25:11 |
Plain Text |
USING: kernel sequences combinators assocs io random ;
IN: trumpet
SINGLETONS: left right ;
<PRIVATE
: subtail short tail ;
: subtail* short tail* ;
: unclip-nlast 2dup subtail* [ subtail ] dip ;
: suffix-last swap unclip-last pick suffix rot drop ;
PRIVATE>
: apply-rules {
{ [ dup 2 unclip-nlast { right left } = ] [ nip { left right } append t ] }
[ drop f ]
} cond ;
: process-element suffix-last apply-rules
[ suffix { } suffix ] [ suffix ] if ;
: clean-step { { } } [ process-element ] reduce concat ;
: step dup first swap clean-step rest swap prefix ;
: lr>string [ H{ { left "<" } { right ">" } } at ] map
concat ;
: in-order? dup [ [ left = ] all? ] [ [ right = ] all? ] bi* or ;
: while-unordered-and-changing
dup
[ 2dup = [ f ] [ swap drop dup t ] if
[ dup in-order? not ]
and ]
[ dup lr>string print flush step ] do while
2drop ;
: main
10 iota [ drop { left right } random ] map
while-unordered-and-changing ;
main
Author: | Leonidas |
Mode: | factor |
Date: | Thu, 25 Feb 2010 21:40:17 |
Plain Text |
USING: kernel sequences combinators assocs io random ;
IN: trumpet
SINGLETONS: left right ;
<PRIVATE
: subtail short tail ;
: subtail* short tail* ;
: unclip-nlast [ subtail ] [ subtail* ] 2bi ;
: suffix-last swap unclip-last pick suffix rot drop ;
PRIVATE>
: apply-rules {
{ [ dup 2 unclip-nlast { right left } = ] [ nip { left right } append t ] }
[ drop f ]
} cond ;
: process-element suffix-last apply-rules
[ suffix { } suffix ] [ suffix ] if ;
: clean-step { { } } [ process-element ] reduce concat ;
: step dup first swap clean-step rest swap prefix ;
: lr>string [ H{ { left "<" } { right ">" } } at ] map
concat ;
: in-order? dup [ [ left = ] all? ] [ [ right = ] all? ] bi* or ;
: while-unordered-and-changing
dup
[ 2dup = [ f ] [ swap drop dup t ] if
[ dup in-order? not ]
and ]
[ dup lr>string print flush step ] do while
2drop ;
: main
10 iota [ drop { left right } random ] map
while-unordered-and-changing ;
main
Author: | Leonidas |
Mode: | factor |
Date: | Thu, 25 Feb 2010 21:59:54 |
Plain Text |
USING: kernel sequences combinators assocs io random ;
IN: trumpet
SINGLETONS: left right ;
<PRIVATE
: subtail short tail ;
: subtail* short tail* ;
: unclip-nlast [ subtail ] [ subtail* ] 2bi ;
: suffix-last [ unclip-last ] dip suffix ;
PRIVATE>
: apply-rules {
{ [ dup 2 unclip-nlast { right left } = ] [ nip { left right } append t ] }
[ drop f ]
} cond ;
: process-element suffix-last apply-rules
[ suffix { } suffix ] [ suffix ] if ;
: clean-step { { } } [ process-element ] reduce concat ;
: step [ clean-step rest ] [ first ] bi prefix ;
: lr>string [ { { left [ CHAR: < ] } { right [ CHAR: > ] } } case ] "" map-at ;
: in-order? [ [ left = ] all? ] [ [ right = ] all? ] bi or ;
: while-unordered-and-changing
dup
[ 2dup = [ f ] [ swap drop dup t ] if
[ dup in-order? not ]
and ]
[ dup lr>string print flush step ] do while
2drop ;
: main
10 [ drop { left right } random ] replicate
while-unordered-and-changing ;
main
New Annotation