! 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 ) dup first swap clean-step rest swap prefix ; : lr>string ( seq -- string ) [ H{ { left "<" } { right ">" } } at ] map concat ; : in-order? ( seq -- ? ) dup [ [ 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 iota [ drop { left right } random ] map while-unordered-and-changing ; main