Perfect shuffle: Difference between revisions
m
→{{header|Wren}}: Minor tidy
(add FreeBASIC) |
m (→{{header|Wren}}: Minor tidy) |
||
(17 intermediate revisions by 11 users not shown) | |||
Line 89:
{{trans|Python}}
<
[Int] r
L(sublst) lst
Line 112:
V deck = Array(0 .< length)
V shuffles_needed = after_how_many_is_equal(deck, deck)
print(‘#<5 | #.’.format(length, shuffles_needed))</
{{out}}
Line 124:
1024 | 10
10000 | 300
</pre>
=={{header|Action!}}==
Calculations on a real Atari 8-bit computer take quite long time. It is recommended to use an emulator capable with increasing speed of Atari CPU.
<syntaxhighlight lang="action!">DEFINE MAXDECK="5000"
PROC Order(INT ARRAY deck INT count)
INT i
FOR i=0 TO count-1
DO
deck(i)=i
OD
RETURN
BYTE FUNC IsOrdered(INT ARRAY deck INT count)
INT i
FOR i=0 TO count-1
DO
IF deck(i)#i THEN
RETURN (0)
FI
OD
RETURN (1)
PROC Shuffle(INT ARRAY src,dst INT count)
INT i,i1,i2
i=0 i1=0 i2=count RSH 1
WHILE i<count
DO
dst(i)=src(i1) i==+1 i1==+1
dst(i)=src(i2) i==+1 i2==+1
OD
RETURN
PROC Test(INT ARRAY deck,deck2 INT count)
INT ARRAY tmp
INT n
Order(deck,count)
n=0
DO
Shuffle(deck,deck2,count)
tmp=deck deck=deck2 deck2=tmp
n==+1
Poke(77,0) ;turn off the attract mode
PrintF("%I cards -> %I iterations%E",count,n)
Put(28) ;move cursor up
UNTIL IsOrdered(deck,count)
OD
PutE()
RETURN
PROC Main()
INT ARRAY deck(MAXDECK),deck2(MAXDECK)
INT ARRAY counts=[8 24 52 100 1020 1024 MAXDECK]
INT i
FOR i=0 TO 6
DO
Test(deck,deck2,counts(i))
OD
RETURN</syntaxhighlight>
{{out}}
[https://gitlab.com/amarok8bit/action-rosetta-code/-/raw/master/images/Perfect_shuffle.png Screenshot from Atari 8-bit computer]
<pre>
8 cards -> 3 iterations
24 cards -> 11 iterations
52 cards -> 8 iterations
100 cards -> 30 iterations
1020 cards -> 1018 iterations
1024 cards -> 10 iterations
5000 cards -> 357 iterations
</pre>
=={{header|Ada}}==
<
procedure perfect_shuffle is
Line 154 ⟶ 229:
put_line ("For" & size'img & " cards, there are "& count_shuffle (size / 2)'img & " shuffles needed.");
end loop;
end perfect_shuffle;</
{{out}}
<pre>
Line 167 ⟶ 242:
=={{header|ALGOL 68}}==
<
OP DECK = ( INT length )[]INT:
BEGIN
Line 224 ⟶ 299:
FOR l FROM LWB lengths TO UPB lengths DO
print( ( whole( lengths[ l ], -8 ) + ": " + whole( count shuffles( lengths[ l ] ), -6 ), newline ) )
OD</
{{out}}
<pre>
Line 238 ⟶ 313:
=={{header|APL}}==
{{works with|Dyalog APL}}
<
count ← {⍺←⍵ ⋄ ⍺≡r←⍺⍺ ⍵:1 ⋄ 1+⍺∇r}
(⊢,[1.5] (faro count ⍳)¨) 8 24 52 100 1020 1024 10000</
{{out}}
<pre> 8 3
Line 252 ⟶ 327:
=={{header|Arturo}}==
<
deck: 1..deckSize
original: new deck
Line 259 ⟶ 334:
i: 1
while [true][
deck: flatten
if deck = original -> return i
i: i+1
Line 269 ⟶ 344:
pad.right join @["Perfect shuffles required for deck size " to :string s ":"] 48
perfectShuffle s
]</
{{out}}
Line 282 ⟶ 357:
=={{header|AutoHotkey}}==
<
n := cards.MaxIndex()/2, res := []
loop % n
res.push(cards[A_Index]), res.push(cards[round(A_Index + n)])
return res
}</
Examples:<
for each, val in test
{
Line 304 ⟶ 379:
}
MsgBox % result
return</
Outputs:<pre>8 3
24 11
Line 315 ⟶ 390:
=={{header|C}}==
<
#include <stdlib.h>
#include <stdio.h>
Line 425 ⟶ 500:
}
}
</syntaxhighlight>
{{out}}
Line 443 ⟶ 518:
=={{header|C sharp}}==
{{works with|C sharp|6}}
<
using System.Collections.Generic;
using System.Linq;
Line 475 ⟶ 550:
}
}</
{{out}}
<pre>
Line 488 ⟶ 563:
=={{header|C++}}==
<
#include <iostream>
#include <algorithm>
Line 527 ⟶ 602:
return 0;
}
</syntaxhighlight>
{{out}}
<pre>
Line 540 ⟶ 615:
=={{header|Clojure}}==
<
(let [half (split-at (/ (count deck) 2) deck)]
(interleave (first half) (last half))))
Line 551 ⟶ 626:
(inc (some identity (map-indexed (fn [i x] (when (predicate x) i)) trials)))))))
(map solve [8 24 52 100 1020 1024 10000])</
{{out}}
Line 565 ⟶ 640:
=={{header|Common Lisp}}==
<
(let* ((half (floor (length deck) 2))
(left (subseq deck 0 half))
Line 585 ⟶ 660:
(solve 1020)
(solve 1024)
(solve 10000)</
{{out}}
<pre> 8: 3
Line 597 ⟶ 672:
=={{header|D}}==
{{trans|Java}}
<
void main() {
Line 627 ⟶ 702:
assert(false, "How did this get here?");
}</
{{out}}
Line 640 ⟶ 715:
{{libheader| System.SysUtils}}
{{Trans|Go}}
<syntaxhighlight lang="delphi">
program Perfect_shuffle;
Line 740 ⟶ 815:
end;
readln;
end.</
=={{header|Dyalect}}==
Line 746 ⟶ 821:
{{trans|C#}}
<
if arr.
throw
}
var half = arr.
var result = Array.
var (t, l, r) = (0, 0, half)
while l < half {
result[t] = arr[l]
Line 763 ⟶ 838:
result
}
func arrayEqual(xs, ys) {
if xs.
return false
}
for i in xs.
if xs[i] != ys[i] {
return false
Line 775 ⟶ 850:
return true
}
func shuffleThrough(original) {
var copy = original.
while true {
copy = shuffle(copy)
Line 787 ⟶ 862:
}
}
for input in yields { 8, 24, 52, 100, 1020, 1024, 10000} {
var numbers = [1..input]
print("\(input) cards: \(shuffleThrough(numbers).
}</
{{out}}
Line 802 ⟶ 877:
1024 cards: 10
10000 cards: 300</pre>
=={{header|EasyLang}}==
{{trans|Phix}}
<syntaxhighlight>
proc pshuffle . deck[] .
mp = len deck[] / 2
in[] = deck[]
for i = 1 to mp
deck[2 * i - 1] = in[i]
deck[2 * i] = in[i + mp]
.
.
proc test size . .
for i to size
deck0[] &= i
.
deck[] = deck0[]
repeat
pshuffle deck[]
cnt += 1
until deck[] = deck0[]
.
print cnt
.
for size in [ 8 24 52 100 1020 1024 10000 ]
test size
.
</syntaxhighlight>
=={{header|EchoLisp}}==
<
;; shuffler : a permutation vector which interleaves both halves of deck
(define (make-shuffler n)
Line 824 ⟶ 927:
#:break (eqv? deck dock) ;; compare to first
1)))))
</syntaxhighlight>
{{out}}
<
map magic-shuffle '(8 24 52 100 1020 1024 10000))
→ ((8 . 3) (24 . 11) (52 . 8) (100 . 30) (1020 . 1018) (1024 . 10) (10000 . 300))
Line 840 ⟶ 943:
(oeis '(1 2 4 3 6 10 12 4))
→ Sequence A002326 found
</syntaxhighlight>
=={{header|Elixir}}==
{{trans|Ruby}}
<
def shuffle(n) do
start = Enum.to_list(1..n)
Line 867 ⟶ 970:
step = Perfect.shuffle(n)
IO.puts "#{n} : #{step}"
end)</
{{out}}
Line 881 ⟶ 984:
=={{header|F_Sharp|F#}}==
<
let perfectShuffle xs =
let h = (List.length xs) / 2
Line 897 ⟶ 1,000:
[ 8; 24; 52; 100; 1020; 1024; 10000 ] |> List.iter (fun n->n |> orderCount |> printfn "%d %d" n)
</syntaxhighlight>
{{out}}
Line 911 ⟶ 1,014:
=={{header|Factor}}==
<
sequences.merged ;
IN: rosetta-code.perfect-shuffle
Line 924 ⟶ 1,027:
"Deck size" "Number of shuffles required" "%-11s %-11s\n" printf
test-cases [ dup shuffle-count "%-11d %-11d\n" printf ] each</
{{out}}
<pre>
Line 938 ⟶ 1,041:
=={{header|Fortran}}==
<
IMPLICIT NONE
Line 1,020 ⟶ 1,123:
WRITE(*,'(I17, A, I35)') DECK_SIZES(I), " | ", COUNTER
END DO
END PROGRAM DEMO_PERFECT_SHUFFLE</
<pre>
input (deck size) | output (number of shuffles required)
Line 1,034 ⟶ 1,137:
=={{header|FreeBASIC}}==
<
'tests if a deck is in order
for i as uinteger = lbound(d) to ubound(d)-1
Line 1,077 ⟶ 1,180:
for i = 1 to 7
print tests(i);" cards require "; shufs_needed(tests(i)); " shuffles."
next i</
{{out}}<pre>
8 cards require 3 shuffles.
Line 1,089 ⟶ 1,192:
=={{header|Go}}==
<
import "fmt"
Line 1,147 ⟶ 1,250:
}
return
}</
{{out}}
<pre>Cards count: 8, shuffles required: 3
Line 1,158 ⟶ 1,261:
=={{header|Haskell}}==
<
shuffle lst = let (a,b) = splitAt (length lst `div` 2) lst
in foldMap (\(x,y) -> [x,y]) $ zip a b
Line 1,169 ⟶ 1,272:
report n = putStrLn ("deck of " ++ show n ++ " cards: "
++ show (countSuffles n) ++ " shuffles!")
countSuffles n = 1 + length (findCycle shuffle [1..n])</
{{out}}
Line 1,185 ⟶ 1,288:
The shuffle routine:
<
Here, the phrase ($ $ 0 1"_) would generate a sequence of 0s and 1s the same length as the argument sequence:
<
0 1 0 1 0 1</
And we can use ''grade up'' <code>(/:)</code> to find the indices which would sort the argument sequence so that the values in the positions corresponding to our generated zeros would come before the values in the positions corresponding to our ones.
<
0 2 4 1 3 5</
But we can use ''grade up'' again to find what would have been the original permutation (''grade up'' is a self inverting function for this domain).
<
0 3 1 4 2 5</
And, that means it can also sort the original sequence into that order:
<
adbecf
shuf 'abcdefgh'
aebfcgdh</
And this will work for sequences of arbitrary length.
Line 1,215 ⟶ 1,318:
Meanwhile, the cycle length routine could look like this:
<
Here, we first generate a list of integers of the required length in their natural order. We then reorder them using our <code>shuf</code> function, find the [[j:Vocabulary/ccapdot|cycles]] which result, find the lengths of each of these cycles then find the least common multiple of those lengths.
Line 1,221 ⟶ 1,324:
So here is the task example (with most of the middle trimmed out to avoid crashing the rosettacode wiki implementation):
<
1 2 4 3 6 10 12 4 8 18 6 11 20 18 28 5 10 12 36 12 20 14 12 23 21 8 52 20 18 ... 4278 816 222 1332 384</
Task example:
<
┌─────────┬─────────────────┐
│deck size│required shuffles│
Line 1,243 ⟶ 1,346:
├─────────┼─────────────────┤
│10000 │300 │
└─────────┴─────────────────┘</
Note that the implementation of <code>shuf</code> defines a behavior for odd length "decks". Experimentation shows that cycle length for an odd length deck is often the same as the cycle length for an even length deck which is one "card" longer.
Line 1,249 ⟶ 1,352:
=={{header|Java}}==
{{works with|Java|8}}
<
import java.util.stream.IntStream;
Line 1,281 ⟶ 1,384:
}
}
}</
<pre> 8 : 3
Line 1,293 ⟶ 1,396:
=={{header|JavaScript}}==
===ES6===
<
'use strict';
Line 1,414 ⟶ 1,517:
.map(row => row.join(''))
.join('\n');
})();</
{{Out}}
Line 1,430 ⟶ 1,533:
A small point of interest in the following is the `recurrence` function as it is generic.
<
. as $a
| if (length % 2) == 1 then "cannot perform perfect shuffle on odd-length array" | error
Line 1,453 ⟶ 1,556:
(8, 24, 52, 100, 1020, 1024, 10000, 100000)
| [., count_perfect_shuffles]</
{{out}}
<pre>
Line 1,468 ⟶ 1,571:
=={{header|Julia}}==
<
function perfect_shuffle(a::Array)::Array
Line 1,495 ⟶ 1,598:
count = count_perfect_shuffles(i)
@printf("%7i%7i\n", i, count)
end</
{{out}}
Line 1,509 ⟶ 1,612:
=={{header|Kotlin}}==
<
fun areSame(a: IntArray, b: IntArray): Boolean {
Line 1,549 ⟶ 1,652:
println("${"%-9d".format(size)} $count")
}
}</
{{out}}
Line 1,565 ⟶ 1,668:
=={{header|Lua}}==
<
function shuffle (cards)
local pile1, pile2 = {}, {}
Line 1,600 ⟶ 1,703:
local testCases = {8, 24, 52, 100, 1020, 1024, 10000}
print("Input", "Output")
for _, case in pairs(testCases) do print(case, countShuffles(case)) end</
{{out}}
<pre>Input Output
Line 1,612 ⟶ 1,715:
=={{header|Mathematica}}/{{header|Wolfram Language}}==
<
shuffleCount[n_] := Block[{count=0}, NestWhile[shuffle, shuffle[Range[n]], (count++; OrderedQ[#] )&];count];
Map[shuffleCount, {8, 24, 52, 100, 1020, 1024, 10000}]</
{{out}}
<pre>{3, 11, 8, 30, 1018, 10, 300}</pre>
Line 1,620 ⟶ 1,723:
=={{header|MATLAB}}==
PerfectShuffle.m:
<
if mod(Nitems,2)==0 %only if even number
X=1:Nitems; %define deck
Line 1,628 ⟶ 1,731:
end
New=X; %result of multiple shufflings
end</
Main:
<
Q=[8, 24, 52, 100, 1020, 1024, 10000]; %queries
for n=Q %for each query
Line 1,643 ⟶ 1,746:
Result=[Result;T]; %collect results
end
disp([Q', Result])</
{{out}}
<pre> 8 3
Line 1,655 ⟶ 1,758:
=={{header|Modula-2}}==
{{trans|C}}
<
FROM FormatString IMPORT FormatString;
FROM Storage IMPORT ALLOCATE,DEALLOCATE;
Line 1,745 ⟶ 1,848:
ReadChar
END PerfectShuffle.</
{{out}}
<pre>8: 3
Line 1,756 ⟶ 1,859:
=={{header|Nim}}==
<
proc newValList(size: Positive): seq[int] =
Line 1,781 ⟶ 1,884:
if valList == initList:
break
echo ($size).align(5), ": ", ($count).align(4)</
Line 1,795 ⟶ 1,898:
=={{header|Oforth}}==
<
: nbShuffles(l) 1 l while( shuffle dup l <> ) [ 1 under+ ] drop ;</
{{out}}
Line 1,807 ⟶ 1,910:
{{improve|PARI/GP|The task description was updated; please update this solution accordingly and then remove this template.}}
<
shuffles_slow(n)=my(v=[1..n],o=v,s=1);while((v=magic(v))!=o,s++);s;
shuffles(n)=znorder(Mod(2,n-1));
vector(5000,n,shuffles_slow(2*n))</
{{out}}
<pre>%1 = [1, 2, 4, 3, 6, 10, 12, 4, 8, 18, 6, 11, 20, 18, 28, 5, 10, 12, 36, 12,
Line 1,842 ⟶ 1,945:
=={{header|Perl}}==
<syntaxhighlight lang
use List::Util 'all';
sub perfect_shuffle (@deck) {
my $
map { @
}
for my $size (8, 24, 52, 100, 1020, 1024, 10000) {
my @shuffled = my @deck = 1..$size;
my
do { $n++; @shuffled = perfect_shuffle @shuffled }
until all { $shuffled[$_] == $deck[$_] } 0..$#shuffled;
printf "%5d cards: %4d\n", $size, $n;
}</
{{out}}
Line 1,871 ⟶ 1,973:
=={{header|Phix}}==
<!--<syntaxhighlight lang="phix">(phixonline)-->
<span style="color: #008080;">with</span> <span style="color: #008080;">javascript_semantics</span>
<span style="color: #008080;">function</span> <span style="color: #000000;">perfect_shuffle</span><span style="color: #0000FF;">(</span><span style="color: #004080;">sequence</span> <span style="color: #000000;">deck</span><span style="color: #0000FF;">)</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">l</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">deck</span><span style="color: #0000FF;">),</span> <span style="color: #000000;">mp</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">l</span><span style="color: #0000FF;">/</span><span style="color: #000000;">2</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">k</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">1</span>
<span style="color: #004080;">sequence</span> <span style="color: #000000;">res</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">repeat</span><span style="color: #0000FF;">(</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">l</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #000000;">mp</span> <span style="color: #008080;">do</span>
<span style="color: #000000;">res</span><span style="color: #0000FF;">[</span><span style="color: #000000;">k</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">deck</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]</span> <span style="color: #000000;">k</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">1</span>
<span style="color: #000000;">res</span><span style="color: #0000FF;">[</span><span style="color: #000000;">k</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">deck</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">+</span><span style="color: #000000;">mp</span><span style="color: #0000FF;">]</span> <span style="color: #000000;">k</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">1</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<span style="color: #008080;">return</span> <span style="color: #000000;">res</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
<span style="color: #008080;">constant</span> <span style="color: #000000;">testsizes</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">8</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">24</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">52</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">100</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">1020</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">1024</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">10000</span><span style="color: #0000FF;">}</span>
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">testsizes</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span>
<span style="color: #004080;">sequence</span> <span style="color: #000000;">deck</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">tagset</span><span style="color: #0000FF;">(</span><span style="color: #000000;">testsizes</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">])</span>
<span style="color: #004080;">sequence</span> <span style="color: #000000;">work</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">perfect_shuffle</span><span style="color: #0000FF;">(</span><span style="color: #000000;">deck</span><span style="color: #0000FF;">)</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">count</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">1</span>
<span style="color: #008080;">while</span> <span style="color: #000000;">work</span><span style="color: #0000FF;">!=</span><span style="color: #000000;">deck</span> <span style="color: #008080;">do</span>
<span style="color: #000000;">work</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">perfect_shuffle</span><span style="color: #0000FF;">(</span><span style="color: #000000;">work</span><span style="color: #0000FF;">)</span>
<span style="color: #000000;">count</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">1</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">while</span>
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"%5d cards: %4d\n"</span><span style="color: #0000FF;">,</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">testsizes</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">],</span><span style="color: #000000;">count</span><span style="color: #0000FF;">})</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<!--</syntaxhighlight>-->
{{out}}
<pre>
Line 1,903 ⟶ 2,007:
10000 cards: 300
</pre>
=={{header|Picat}}==
A perfect shuffle can be done in two ways:
* '''in''': first card in top half is the first card in the new deck
* '''out''': first card in bottom half is the first card in the new deck
The method used here supports both shuffle types. The task states an '''out''' shuffling.
===Out shuffle===
<syntaxhighlight lang="picat">go =>
member(N,[8,24,52,100,1020,1024,10_000]),
println(n=N),
InOut = out, % in/out shuffling
println(inOut=InOut),
Print = cond(N < 100, true,false),
if Print then
println(1..N),
end,
Count = show_all_shuffles(N,InOut,Print),
println(count=Count),
nl,
fail,
nl.
%
% Show all the shuffles
%
show_all_shuffles(N,InOut) = show_all_shuffles(N,InOut,false).
show_all_shuffles(N,InOut,Print) = Count =>
Order = 1..N,
Perfect1 = perfect_shuffle(1..N,InOut),
Perfect = copy_term(Perfect1),
if Print == true then
println(Perfect)
end,
Count = 1,
while (Perfect != Order)
Perfect := [Perfect1[Perfect[I]] : I in 1..N],
if Print == true then
println(Perfect)
end,
Count := Count + 1
end.
%
% Perfect shuffle a list
%
% InOut = in|out
% in: first card in Top half is the first card in the new deck
% out: first card in Bottom half is the first card in the new deck
%
perfect_shuffle(List,InOut) = Perfect =>
[Top,Bottom] = split_deck(List,InOut),
if InOut = out then
Perfect = zip2(Top,Bottom)
else
Perfect = zip2(Bottom,Top)
end.
%
% split the deck in two "halves"
%
% For odd out shuffles, we have to adjust the
% range of the top and bottom.
%
split_deck(L,InOut) = [Top,Bottom] =>
N = L.len,
if InOut = out, N mod 2 = 1 then
Top = 1..(N div 2)+1,
Bottom = (N div 2)+2..N
else
Top = 1..(N div 2),
Bottom = (N div 2)+1..N
end.
%
% If L1 and L2 has uneven lengths, we add the odd element last
% in the resulting list.
%
zip2(L1,L2) = R =>
L1Len = L1.len,
L2Len = L2.len,
R1 = [],
foreach(I in 1..min(L1Len,L2Len))
R1 := R1 ++ [L1[I],L2[I]]
end,
if L1Len < L2Len then
R1 := R1 ++ [L2[L2Len]]
elseif L1Len > L2Len then
R1 := R1 ++ [L1[L1Len]]
end,
R = R1.</syntaxhighlight>
{{out}}
<pre>n = 8
inOut = out
[1,2,3,4,5,6,7,8]
[1,5,2,6,3,7,4,8]
[1,3,5,7,2,4,6,8]
[1,2,3,4,5,6,7,8]
count = 3
n = 24
inOut = out
[1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24]
[1,13,2,14,3,15,4,16,5,17,6,18,7,19,8,20,9,21,10,22,11,23,12,24]
[1,7,13,19,2,8,14,20,3,9,15,21,4,10,16,22,5,11,17,23,6,12,18,24]
[1,4,7,10,13,16,19,22,2,5,8,11,14,17,20,23,3,6,9,12,15,18,21,24]
[1,14,4,17,7,20,10,23,13,3,16,6,19,9,22,12,2,15,5,18,8,21,11,24]
[1,19,14,9,4,22,17,12,7,2,20,15,10,5,23,18,13,8,3,21,16,11,6,24]
[1,10,19,5,14,23,9,18,4,13,22,8,17,3,12,21,7,16,2,11,20,6,15,24]
[1,17,10,3,19,12,5,21,14,7,23,16,9,2,18,11,4,20,13,6,22,15,8,24]
[1,9,17,2,10,18,3,11,19,4,12,20,5,13,21,6,14,22,7,15,23,8,16,24]
[1,5,9,13,17,21,2,6,10,14,18,22,3,7,11,15,19,23,4,8,12,16,20,24]
[1,3,5,7,9,11,13,15,17,19,21,23,2,4,6,8,10,12,14,16,18,20,22,24]
[1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24]
count = 11
n = 52
inOut = out
[1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52]
[1,27,2,28,3,29,4,30,5,31,6,32,7,33,8,34,9,35,10,36,11,37,12,38,13,39,14,40,15,41,16,42,17,43,18,44,19,45,20,46,21,47,22,48,23,49,24,50,25,51,26,52]
[1,14,27,40,2,15,28,41,3,16,29,42,4,17,30,43,5,18,31,44,6,19,32,45,7,20,33,46,8,21,34,47,9,22,35,48,10,23,36,49,11,24,37,50,12,25,38,51,13,26,39,52]
[1,33,14,46,27,8,40,21,2,34,15,47,28,9,41,22,3,35,16,48,29,10,42,23,4,36,17,49,30,11,43,24,5,37,18,50,31,12,44,25,6,38,19,51,32,13,45,26,7,39,20,52]
[1,17,33,49,14,30,46,11,27,43,8,24,40,5,21,37,2,18,34,50,15,31,47,12,28,44,9,25,41,6,22,38,3,19,35,51,16,32,48,13,29,45,10,26,42,7,23,39,4,20,36,52]
[1,9,17,25,33,41,49,6,14,22,30,38,46,3,11,19,27,35,43,51,8,16,24,32,40,48,5,13,21,29,37,45,2,10,18,26,34,42,50,7,15,23,31,39,47,4,12,20,28,36,44,52]
[1,5,9,13,17,21,25,29,33,37,41,45,49,2,6,10,14,18,22,26,30,34,38,42,46,50,3,7,11,15,19,23,27,31,35,39,43,47,51,4,8,12,16,20,24,28,32,36,40,44,48,52]
[1,3,5,7,9,11,13,15,17,19,21,23,25,27,29,31,33,35,37,39,41,43,45,47,49,51,2,4,6,8,10,12,14,16,18,20,22,24,26,28,30,32,34,36,38,40,42,44,46,48,50,52]
[1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52]
count = 8
n = 100
inOut = out
count = 30
n = 1020
inOut = out
count = 1018
n = 1024
inOut = out
count = 10
n = 10000
inOut = out
count = 300</pre>
===In shuffle===
Here's an example of an '''in''' shuffle. It takes 6 shuffles to get an 8 card deck back to its original order (compare with 3 for an out shuffle).
<syntaxhighlight lang="picat">main =>
N = 8,
println(1..N),
InOut = in, % in shuffling
Count = show_all_shuffles(N,InOut,true),
println(count=Count),
nl.</syntaxhighlight>
{{out}}
<pre>[1,2,3,4,5,6,7,8]
[5,1,6,2,7,3,8,4]
[7,5,3,1,8,6,4,2]
[8,7,6,5,4,3,2,1]
[4,8,3,7,2,6,1,5]
[2,4,6,8,1,3,5,7]
[1,2,3,4,5,6,7,8]
count = 6</pre>
===Uneven decks===
The method supports decks of uneven lengths, here size 11 (using an out shuffle).
<syntaxhighlight lang="picat">main =>
N = 11,
println(1..N),
InOut = out, % in/out shuffling
Count = show_all_shuffles(N,InOut,true),
println(count=Count),
nl.</syntaxhighlight>
{{out}}
<pre>[1,2,3,4,5,6,7,8,9,10,11]
[1,7,2,8,3,9,4,10,5,11,6]
[1,4,7,10,2,5,8,11,3,6,9]
[1,8,4,11,7,3,10,6,2,9,5]
[1,10,8,6,4,2,11,9,7,5,3]
[1,11,10,9,8,7,6,5,4,3,2]
[1,6,11,5,10,4,9,3,8,2,7]
[1,9,6,3,11,8,5,2,10,7,4]
[1,5,9,2,6,10,3,7,11,4,8]
[1,3,5,7,9,11,2,4,6,8,10]
[1,2,3,4,5,6,7,8,9,10,11]
count = 10</pre>
=={{header|PicoLisp}}==
<
(mapcan '((B A) (list A B))
(cdr (nth Lst (/ (length Lst) 2)))
Line 1,914 ⟶ 2,208:
(until (= Lst (setq L (perfectShuffle L)))
(inc 'Cnt) )
(tab (5 6) N Cnt) ) )</
Output:
<pre> 8 3
Line 1,926 ⟶ 2,220:
=={{header|Python}}==
<
import doctest
import random
Line 1,972 ⟶ 2,266:
main()
</syntaxhighlight>
More functional version of the same code:
<
"""
Brute force solution for the Perfect Shuffle problem.
Line 2,041 ⟶ 2,335:
if __name__ == "__main__":
main()
</
{{Out}}
<pre>Deck length | Shuffles
Line 2,052 ⟶ 2,346:
10000 | 300</pre>
Reversed shuffle or just calculate how many shuffles are needed:
<
# directly calculate how many shuffles are needed to restore
# initial order: 2^o mod(n-1) == 1
Line 2,076 ⟶ 2,370:
for n in range(2, 10000, 2):
#print(n, mul_ord2(n))
print(n, shuffles(n))</
=={{header|Quackery}}==
<
times [ i^ join ] ] is deck ( n --> [ )
Line 2,099 ⟶ 2,393:
dup echo say " cards needs "
shuffles echo say " shuffles."
cr ]</
{{Out}}
Line 2,114 ⟶ 2,408:
=={{header|R}}==
===Matrix solution===
<
deck <- 1:n ## create the original deck
new.deck <- c(matrix(data = deck, ncol = 2, byrow = TRUE)) ## shuffle the deck once
Line 2,129 ⟶ 2,423:
test <- sapply(test.values, wave.shuffle) ## apply the wave.shuffle function on each element
names(test) <- test.values ## name the result
test ## print the result out</
{{out}}
<pre>> test
Line 2,136 ⟶ 2,430:
===Sequence solution===
The previous solution exploits R's matrix construction; This solution exploits its array indexing.
<
pShuffle <- function(deck)
{
n <- length(deck)#Assumed even (as in task description).
shuffled
}
task2 <- function(deck)
{
count <- 0
repeat
{
count <- count + 1
if(all(
}
cat("It takes", count, "shuffles of a deck of size", length(deck), "to return to the original deck.","\n")
invisible(count)#For the unit tests. The task wanted this printed so we only return it invisibly.
}
#Tests - All done in one line.
mapply(function(x, y) task2(1:x) == y, c(8, 24, 52, 100, 1020, 1024, 10000), c(3, 11, 8, 30, 1018, 10, 300))</
{{out}}
<pre>> mapply(function(x, y) task2(1:x) == y, c(8, 24, 52, 100, 1020, 1024, 10000), c(3, 11, 8, 30, 1018, 10, 300))
It takes 3 shuffles of a deck of size 8 to return to the original deck.
It takes 11 shuffles of a deck of size 24 to return to the original deck.
Line 2,174 ⟶ 2,468:
=={{header|Racket}}==
<
(require racket/list)
Line 2,200 ⟶ 2,494:
(for-each test-perfect-shuffles-needed
'(8 24 52 100 1020 1024 10000)
'(3 11 8 30 1018 10 300)))</
{{out}}
Line 2,213 ⟶ 2,507:
=={{header|Raku}}==
(formerly Perl 6)
<syntaxhighlight lang="raku" line>for 8, 24, 52, 100, 1020, 1024, 10000 -> $size {
my ($n, @deck) = 1, |^$size;
$n++ until [<] @deck = flat [Z] @deck.rotor: @deck/2;
printf "%5d cards: %4d\n", $size, $n;
}</
{{out}}
Line 2,245 ⟶ 2,526:
=={{header|REXX}}==
===unoptimized===
<
parse arg X /*optional list of test cases from C.L.*/
if X='' then X=8 24 52 100 1020 1024 10000 /*Not specified? Then use the default.*/
Line 2,269 ⟶ 2,550:
do r=1 for y; @.r=!.r; end /*re─assign to the original card deck. */
return</
'''output''' (abbreviated) when using the default input:
<pre>
Line 2,283 ⟶ 2,564:
===optimized===
This REXX version takes advantage that the 1<sup>st</sup> and last cards of the deck don't change.
<
parse arg X /*optional list of test cases from C.L.*/
if X='' then X=8 24 52 100 1020 1024 10000 /*Not specified? Use default.*/
Line 2,303 ⟶ 2,584:
do R=2 by 2 for h-1; h=h+1; !.R=@.h; end /* " right " " " */
do a=2 for y-2; @.a=!.a; end /*re─assign──►original deck*/
return</
'''output''' is the same as the 1<sup>st</sup> version.
<br><br>
Line 2,309 ⟶ 2,590:
=={{header|Ruby}}==
<
deck = (1..deck_size).to_a
original = deck.dup
Line 2,320 ⟶ 2,601:
[8, 24, 52, 100, 1020, 1024, 10000].each {|i| puts "Perfect shuffles required for deck size #{i}: #{perfect_shuffle(i)}"}
</syntaxhighlight>
{{out}}
Line 2,334 ⟶ 2,615:
=={{header|Rust}}==
<
fn shuffle<T>(mut deck: Vec<T>) -> Vec<T> {
Line 2,356 ⟶ 2,637:
println!("{: >5}: {: >4}", size, iterations);
}
}</
{{out}}
<pre> 8: 3
Line 2,371 ⟶ 2,652:
{{trans|Java}}
{{Out}}Best seen running in your browser either by [https://scalafiddle.io/sf/Ux9RKDx/0 ScalaFiddle (ES aka JavaScript, non JVM)] or [https://scastie.scala-lang.org/eWeiDIBbQMGpNIQAmvXfLg Scastie (remote JVM)].
<
private def sizes = Seq(8, 24, 52, 100, 1020, 1024, 10000)
Line 2,394 ⟶ 2,675:
for (size <- sizes) println(f"$size%5d : ${perfectShuffle(size)}%5d")
}</
=={{header|Scilab}}==
{{trans|MATLAB}}
<syntaxhighlight lang="text">function New=PerfectShuffle(Nitems,Nturns)
if modulo(Nitems,2)==0 then
X=1:Nitems;
Line 2,425 ⟶ 2,706:
Result=[Result;T];
end
disp([Q', Result])</
{{out}}
Line 2,436 ⟶ 2,717:
1024. 10.
10000. 300.</pre>
=={{header|SETL}}==
<syntaxhighlight lang="setl">program faro_shuffle;
loop for test in [8, 24, 52, 100, 1020, 1024, 10000] do
print(lpad(str test, 5) + " cards: " + lpad(str cycle [1..test], 4));
end loop;
op cycle(l);
start := l;
loop until l = start do
l := shuffle l;
n +:= 1;
end loop;
return n;
end op;
op shuffle(l);
return [l(mapindex(i,#l)) : i in [1..#l]];
end op;
proc mapindex(i, size);
return if odd i then i div 2+1 else (i+size) div 2 end;
end proc;
end program;</syntaxhighlight>
{{out}}
<pre> 8 cards: 3
24 cards: 11
52 cards: 8
100 cards: 30
1020 cards: 1018
1024 cards: 10
10000 cards: 300</pre>
=={{header|Sidef}}==
{{trans|Perl}}
<
deck/2 -> zip.flat
}
Line 2,452 ⟶ 2,765:
printf("%5d cards: %4d\n", size, n)
}</
{{out}}
Line 2,467 ⟶ 2,780:
=={{header|Swift}}==
<
guard arr.count & 1 == 0 else {
return nil
Line 2,503 ⟶ 2,816:
print("Deck of \(shuffled.count) took \(shuffles) shuffles to get back to original order")
}</
{{out}}
Line 2,519 ⟶ 2,832:
Using <tt>tcltest</tt> to include an executable test case ..
<
proc perfect {deck} {
Line 2,564 ⟶ 2,877:
shuffle::cycle_length perfect [range $size]
}
} -result {3 11 8 30 1018 10 300}</
=={{header|UNIX Shell}}==
{{works with|Bourne Again SHell}}
{{works with|Korn Shell}}
{{works with|Zsh}}
<syntaxhighlight lang="bash">function faro {
if (( $# % 2 )); then
printf >&2 'Can only shuffle an even number of elements!\n'
return 1
fi
typeset -i half=$(($#/2)) i
typeset argv=("$@")
for (( i=0; i<half; ++i )); do
printf '%s\n%s\n' "${argv[i${ZSH_VERSION:++1}]}" "${argv[i+half${ZSH_VERSION:++1}]}"
done
}
function count_faros {
typeset argv=("$@")
typeset -i count=0
argv=($(faro "${argv[@]}"))
(( count += 1 ))
while [[ "${argv[*]}" != "$*" ]]; do
argv=($(faro "${argv[@]}"))
(( count += 1 ))
done
printf '%d\n' "$count"
}
# Include time taken, which is combined from the three shells in the output below
printf '%s\t%s\t%s\n' Size Shuffles Seconds
for size in 8 24 52 100 1020 1024 10000; do
eval "array=({1..$size})"
start=$(date +%s)
count=$(count_faros "${array[@]}")
taken=$(( $(date +%s) - start ))
printf '%d\t%d\t%d\n' "$size" "$count" "$taken"
done
</syntaxhighlight>
{{Out}}
<pre>
Size Shuffles Seconds (Bash/Ksh/Zsh)
8 3 0/0/0
24 11 0/0/0
52 8 0/0/0
100 30 0/0/0
1020 1018 20/4/8
1024 10 0/0/0
10000 300 87/12/29</pre>
=={{header|VBA}}==
<
Sub Main()
Line 2,628 ⟶ 2,991:
Private Function IsEven(Number As Long) As Boolean
IsEven = (Number Mod 2 = 0)
End Function</
{{out}}
<pre> For 8 cards => 3 shuffles needed.
Line 2,641 ⟶ 3,004:
{{trans|Kotlin}}
{{libheader|Wren-fmt}}
<
var areSame = Fn.new { |a, b|
Line 2,682 ⟶ 3,045:
var count = countShuffles.call(a)
Fmt.print("$-9d $d", size, count)
}</
{{out}}
Line 2,698 ⟶ 3,061:
=={{header|XPL0}}==
<
int Cases, Count, Test, Size, I;
Line 2,724 ⟶ 3,087:
IntOut(0, Size); ChOut(0, 9\tab\); IntOut(0, Count); CrLf(0);
];
]</
{{out}}
Line 2,738 ⟶ 3,101:
=={{header|zkl}}==
<
deck,shuffle,n,N:=numCards.pump(List),deck,0,numCards/2;
do{ shuffle=shuffle[0,N].zip(shuffle[N,*]).flatten(); n+=1 }
Line 2,746 ⟶ 3,109:
foreach n in (T(8,24,52,100,1020,1024,10000)){
println("%5d : %d".fmt(n,perfectShuffle(n)));
}</
{{out}}
<pre>
|