Factorial base numbers indexing permutations of a collection: Difference between revisions
Content deleted Content added
SqrtNegInf (talk | contribs) Added Perl example |
Add Factor |
||
Line 132: | Line 132: | ||
</pre> |
</pre> |
||
8GB of memory is insufficient for rc's perm task |
8GB of memory is insufficient for rc's perm task |
||
=={{header|Factor}}== |
|||
<lang factor>USING: assocs io kernel literals math math.factorials |
|||
math.parser math.ranges prettyprint qw random sequences |
|||
splitting ; |
|||
RENAME: factoradic math.combinatorics.private => _factoradic |
|||
RENAME: rotate sequences.extras => _rotate |
|||
IN: rosetta-code.factorial-permutations |
|||
CONSTANT: shoe $[ |
|||
qw{ A K Q J 10 9 8 7 6 5 4 3 2 } qw{ ♠ ♥ ♦ ♣ } |
|||
[ append ] cartesian-map flip concat |
|||
] |
|||
! Factor can already make factoradic numbers, but they always |
|||
! have a least-significant digit of 0 to remove. |
|||
: factoradic ( n -- seq ) |
|||
_factoradic dup [ drop but-last ] unless-empty ; |
|||
! Convert "3.1.2.0" to { 3 1 2 0 }, for example. |
|||
: string>factoradic ( str -- seq ) |
|||
"." split [ string>number ] map ; |
|||
! Rotate a subsequence. |
|||
! E.g. 0 2 { 3 1 2 0 } (rotate) -> { 2 3 1 0 }. |
|||
: (rotate) ( from to seq -- newseq ) |
|||
[ 1 + ] dip [ snip ] [ subseq ] 3bi -1 _rotate glue ; |
|||
! Only rotate a subsequence if from does not equal to. |
|||
: rotate ( from to seq -- newseq ) |
|||
2over = [ 2nip ] [ (rotate) ] if ; |
|||
! The pseudocode from the task description |
|||
: fpermute ( factoradic -- permutation ) |
|||
dup length 1 + <iota> swap <enumerated> |
|||
[ over + rot rotate ] assoc-each ; |
|||
! Use a factoradic number to index permutations of a collection. |
|||
: findex ( factoradic seq -- permutation ) |
|||
[ fpermute ] [ nths concat ] bi* ; |
|||
: .f ( seq -- ) [ "." write ] [ pprint ] interleave ; ! Print a factoradic number |
|||
: .p ( seq -- ) [ pprint ] each nl ; ! Print a permutation |
|||
: show-table ( -- ) |
|||
"Generate table" print 24 |
|||
[ factoradic 3 0 pad-head dup .f fpermute " -> " write .p ] |
|||
each-integer nl ; |
|||
: show-shuffles ( -- ) |
|||
"Generate given task shuffles" print |
|||
"Original deck:" print shoe concat print nl |
|||
"39.49.7.47.29.30.2.12.10.3.29.37.33.17.12.31.29.34.17.25.2.4.25.4.1.14.20.6.21.18.1.1.1.4.0.5.15.12.4.3.10.10.9.1.6.5.5.3.0.0.0" |
|||
"51.48.16.22.3.0.19.34.29.1.36.30.12.32.12.29.30.26.14.21.8.12.1.3.10.4.7.17.6.21.8.12.15.15.13.15.7.3.12.11.9.5.5.6.6.3.4.0.3.2.1" |
|||
[ |
|||
dup |
|||
[ print ] [ string>factoradic shoe findex print nl ] bi* |
|||
] bi@ ; |
|||
: show-random-shuffle ( -- ) |
|||
"Random shuffle:" print |
|||
51 52 [ n! ] bi@ [a,b] random factoradic shoe findex print ; |
|||
: main ( -- ) show-table show-shuffles show-random-shuffle ; |
|||
MAIN: main</lang> |
|||
{{out}} |
|||
<pre> |
|||
Generate table |
|||
0.0.0 -> 0123 |
|||
0.0.1 -> 0132 |
|||
0.1.0 -> 0213 |
|||
0.1.1 -> 0231 |
|||
0.2.0 -> 0312 |
|||
0.2.1 -> 0321 |
|||
1.0.0 -> 1023 |
|||
1.0.1 -> 1032 |
|||
1.1.0 -> 1203 |
|||
1.1.1 -> 1230 |
|||
1.2.0 -> 1302 |
|||
1.2.1 -> 1320 |
|||
2.0.0 -> 2013 |
|||
2.0.1 -> 2031 |
|||
2.1.0 -> 2103 |
|||
2.1.1 -> 2130 |
|||
2.2.0 -> 2301 |
|||
2.2.1 -> 2310 |
|||
3.0.0 -> 3012 |
|||
3.0.1 -> 3021 |
|||
3.1.0 -> 3102 |
|||
3.1.1 -> 3120 |
|||
3.2.0 -> 3201 |
|||
3.2.1 -> 3210 |
|||
Generate given task shuffles |
|||
Original deck: |
|||
A♠K♠Q♠J♠10♠9♠8♠7♠6♠5♠4♠3♠2♠A♥K♥Q♥J♥10♥9♥8♥7♥6♥5♥4♥3♥2♥A♦K♦Q♦J♦10♦9♦8♦7♦6♦5♦4♦3♦2♦A♣K♣Q♣J♣10♣9♣8♣7♣6♣5♣4♣3♣2♣ |
|||
39.49.7.47.29.30.2.12.10.3.29.37.33.17.12.31.29.34.17.25.2.4.25.4.1.14.20.6.21.18.1.1.1.4.0.5.15.12.4.3.10.10.9.1.6.5.5.3.0.0.0 |
|||
A♣3♣7♠4♣10♦8♦Q♠K♥2♠10♠4♦7♣J♣5♥10♥10♣K♣2♣3♥5♦J♠6♠Q♣5♠K♠A♦3♦Q♥8♣6♦9♠8♠4♠9♥A♠6♥5♣2♦7♥8♥9♣6♣7♦A♥J♦Q♦9♦2♥3♠J♥4♥K♦ |
|||
51.48.16.22.3.0.19.34.29.1.36.30.12.32.12.29.30.26.14.21.8.12.1.3.10.4.7.17.6.21.8.12.15.15.13.15.7.3.12.11.9.5.5.6.6.3.4.0.3.2.1 |
|||
2♣5♣J♥4♥J♠A♠5♥A♣6♦Q♠9♣3♦Q♥J♣10♥K♣10♣5♦7♥10♦3♠8♥10♠7♠6♥5♠K♥4♦A♥4♣2♥9♦Q♣8♣7♦6♣3♥6♠7♣2♦J♦9♥A♦Q♦8♦4♠K♦K♠3♣2♠8♠9♠ |
|||
Random shuffle: |
|||
5♠K♣K♠4♣8♥7♠Q♥J♦3♠A♦3♣8♣6♥A♥3♥A♣10♥9♠10♣5♣J♣J♠J♥2♣K♥Q♦Q♣7♣6♦7♥2♥5♥2♠10♦2♦A♠4♦8♠4♠7♦10♠6♣9♣5♦4♥8♦9♦3♦6♠K♦9♥Q♠ |
|||
</pre> |
|||
=={{header|Go}}== |
=={{header|Go}}== |