! Copyright (C) 2010 Marek Kubica. ! See http://factorcode.org/license.txt for BSD license. USING: kernel sequences combinators assocs io random ; IN: trumpet SINGLETONS: left right ; : apply-rules ( seq -- seq ? ) { { [ dup 2 unclip-nlast { right left } = ] [ nip { left right } append t ] } [ drop f ] } cond ; : process-element ( seq elt -- seq ) suffix-last apply-rules [ suffix { } suffix ] [ suffix ] if ; : clean-step ( seq -- seq ) { { } } [ process-element ] reduce concat ; : step ( seq -- seq ) [ clean-step rest ] [ first ] bi prefix ; : lr>string ( seq -- string ) [ { { left [ CHAR: < ] } { right [ CHAR: > ] } } case ] "" map-at ; : in-order? ( seq -- ? ) [ [ left = ] all? ] [ [ right = ] all? ] bi or ; : while-unordered-and-changing ( seq -- ) 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