Paste: permutation

Author: jon factor Sun, 13 Sep 2009 07:21:15
Plain Text |
```! Copyright (C) 2009 Jon Harper.
USING: kernel math sequences sorting ;
IN: permutations

! Begining from the end, find the smallest subsequence that's not increasing monotonic.
! Call a the first element of this sequence.
! swap a and the smallest number greater than a in the rest of the sequence.
! Natural sort the rest of the sequence.
! Append this new sequence to the begining sequence

<PRIVATE

: deep-1+ ( x obj obj -- x+1 obj obj )
[ [ 1 + ] dip ] dip ;
: remove-one ( seq elt -- newseq )
dupd [ = ] curry find [ swap remove-nth ] [ drop ] if ;

: (index-of-not-ascending) ( index seq previous -- i )
over empty?
[ 3drop f ]
[ [ unclip-last dup ] dip >=
[
deep-1+ (index-of-not-ascending)
] [
2drop
] if
] if ;

: index-of-not-ascending ( seq -- i )
dup empty?
[
drop f
] [
[ 1 ] dip
dup last (index-of-not-ascending)
] if ;

: get-non-monotonic-endsequence ( seq -- beginseq endseq )
dup index-of-not-ascending dup
[ cut* ] [ 2drop f f ] if ;

: get-smallest-greater-than ( seq i -- seq )
[ > ] curry filter infimum ;

: handle-endseq ( endseq -- newendseq )
dup unclip get-smallest-greater-than
[ remove-one natural-sort ] keep prefix ;
PRIVATE>

: next ( seq -- seq )
get-non-monotonic-endsequence dup [ handle-endseq append ] [ drop ] if ;```

Annotation: another way to do it?

Author: pruned factor Sun, 13 Sep 2009 08:21:25
Plain Text |
```: depermutation ( seq -- n seq ) dup natural-sort [ [ index ] curry map >factoradic factoradic>integer ] keep ;
: factoradic>integer ( factoradic -- n ) <reversed> [ factorial * ] map-index sum ;
: >factoradic ( permutation -- factoradic ) dup [ unclip [ '[ _ over < [ 1 - ] when ] map ] keep ] replicate nip ;

usage:

( scratchpad ) "abcd" depermutation [ 1 + ] dip permutation >string .
"abdc"
```

Annotation: for non-canonic strings (ulgy)

Author: pruned factor Sun, 13 Sep 2009 09:03:18
Plain Text |
```USE: math.combinatorics
: invert ( perm -- perm' ) <enum> >alist sort-values keys ;
: factoradic>integer ( factoradic -- n ) <reversed> [ factorial * ] map-index sum ;
: >factoradic ( permutation -- factoradic ) dup [ unclip [ '[ _ over < [ 1 - ] when ] map ] keep ] replicate nip ;
: depermutation ( seq -- n seq ) [ 2array ] map-index sort-keys unzip invert >factoradic factoradic>integer swap ;
: next-permutation ( seq -- seq ) dup depermutation [ 3dup permutation <=> +lt+ = not ] [ [ 1 + ] dip ] while permutation nip ;```