Paste: permutation
Author: | jon |
Mode: | factor |
Date: | Sun, 13 Sep 2009 07:21:15 |
Plain Text |
USING: kernel math sequences sorting ;
IN: permutations
<PRIVATE
: deep-1+
[ [ 1 + ] dip ] dip ;
: remove-one
dupd [ = ] curry find [ swap remove-nth ] [ drop ] if ;
: (index-of-not-ascending)
over empty?
[ 3drop f ]
[ [ unclip-last dup ] dip >=
[
deep-1+ (index-of-not-ascending)
] [
2drop
] if
] if ;
: index-of-not-ascending
dup empty?
[
drop f
] [
[ 1 ] dip
dup last (index-of-not-ascending)
] if ;
: get-non-monotonic-endsequence
dup index-of-not-ascending dup
[ cut* ] [ 2drop f f ] if ;
: get-smallest-greater-than
[ > ] curry filter infimum ;
: handle-endseq
dup unclip get-smallest-greater-than
[ remove-one natural-sort ] keep prefix ;
PRIVATE>
: next
get-non-monotonic-endsequence dup [ handle-endseq append ] [ drop ] if ;
Author: | pruned |
Mode: | factor |
Date: | Sun, 13 Sep 2009 08:21:25 |
Plain Text |
: depermutation dup natural-sort [ [ index ] curry map >factoradic factoradic>integer ] keep ;
: factoradic>integer <reversed> [ factorial * ] map-index sum ;
: >factoradic dup [ unclip [ '[ _ over < [ 1 - ] when ] map ] keep ] replicate nip ;
usage:
"abcd" depermutation [ 1 + ] dip permutation >string .
"abdc"
Author: | pruned |
Mode: | factor |
Date: | Sun, 13 Sep 2009 09:03:18 |
Plain Text |
USE: math.combinatorics
: invert <enum> >alist sort-values keys ;
: factoradic>integer <reversed> [ factorial * ] map-index sum ;
: >factoradic dup [ unclip [ '[ _ over < [ 1 - ] when ] map ] keep ] replicate nip ;
: depermutation [ 2array ] map-index sort-keys unzip invert >factoradic factoradic>integer swap ;
: next-permutation dup depermutation [ 3dup permutation <=> +lt+ = not ] [ [ 1 + ] dip ] while permutation nip ;
New Annotation