# Paste: Simplify sequences of shuffle words.

Author: pozorvlak factor Sun, 29 Nov 2009 19:47:09
Plain Text |
```! Copyright (C) 2009 Miles Gould
! Simplify sequences of shuffle words.
USING: combinators.smart kernel quotations sequences sequences.product
math.ranges assocs arrays ;
IN: tools.shuffle-simplify

: id ( -- ) ;

: shuffles ( -- seq )
{
drop 2drop 3drop nip 2nip
dup 2dup 3dup dupd over 2over pick tuck
swap swapd rot -rot spin roll -roll
} ;

: shuffles-id ( -- seq ) { id } shuffles append ;

! What does a word do if the numbers [0,10] are on the stack?
: behaviour ( quot -- seq )
10 [0,b] prepend >quotation output>array ; inline

! Get a map of behaviours => shuffle words.
: shuffle-behaviours ( -- assoc )
shuffles-id [ [ 1quotation behaviour ] keep ] H{ } map>assoc ; inline

! Given a sequence of shuffle words, return either a single shuffle word
! with the same stack effect, or f if none was found.
: simplify ( seq -- seq )
>quotation behaviour shuffle-behaviours at ; inline

! Find one-word equivalents of all n-word sequences of shuffles, ignoring
! those sequences for which no one-word equivalent exists.
: simplify-all ( n -- seq )
shuffles <repetition> <product-sequence>
[ dup simplify ] H{ } map>assoc [ nip ] assoc-filter ; inline```

## Annotation: Slight cleanup

Author: pozorvlak factor Sun, 29 Nov 2009 22:29:54
Plain Text |
```! Copyright (C) 2009 Miles Gould
! Generate exhaustive lists of simplifications for sequences of shuffle words.
USING: combinators.smart kernel quotations sequences sequences.product
math.ranges assocs arrays ;
IN: tools.shuffle-simplify

: id ( -- ) ;

: shuffles ( -- seq )
{
drop 2drop 3drop nip 2nip
dup 2dup 3dup dupd over 2over pick tuck
swap swapd rot -rot spin roll -roll
} ;

: shuffles-id ( -- seq ) { id } shuffles append ;

! What does a sequence of words do if the numbers [0,10] are on the stack?
: behaviour ( seq -- seq )
10 [0,b] prepend >quotation output>array ; inline

! Get a map of behaviours => shuffle words.
: shuffle-behaviours ( -- assoc )
shuffles-id [ [ 1quotation behaviour ] keep ] H{ } map>assoc ; inline

! Given a sequence of shuffle words, return either a single shuffle word
! with the same stack effect, or f if none was found.
: simplify ( seq -- seq )
behaviour shuffle-behaviours at ; inline

! Find one-word equivalents of all n-word sequences of shuffles, ignoring
! those sequences for which no one-word equivalent exists.
: simplify-all ( n -- seq )
shuffles <repetition> <product-sequence>
[ dup simplify ] H{ } map>assoc [ nip ] assoc-filter ; inline```