Topswops

From Rosetta Code
Jump to: navigation, search
Task
Topswops
You are encouraged to solve this task according to the task description, using any language you may know.

Topswops is a card game created by John Conway in the 1970's.

Assume you have a particular permutation of a set of n cards numbered 1..n on both of their faces, for example the arrangement of four cards given by [2, 4, 1, 3] where the leftmost card is on top. A round is composed of reversing the first m cards where m is the value of the topmost card. rounds are repeated until the topmost card is the number 1 and the number of swaps is recorded. For our example the swaps produce:

    [2, 4, 1, 3]    # Initial shuffle
    [4, 2, 1, 3]
    [3, 1, 2, 4]
    [2, 1, 3, 4]
    [1, 2, 3, 4]

For a total of four swaps from the initial ordering to produce the terminating case where 1 is on top.


For a particular number n of cards, topswops(n) is the maximum swaps needed for any starting permutation of the n cards.

Task

The task is to generate and show here a table of n vs topswops(n) for n in the range 1..10 inclusive.

Note

Topswops is also known as Fannkuch from the German Pfannkuchen meaning pancake.

Cf.

Contents

[edit] Ada

This is a straightforward approach that counts the number of swaps for each permutation. To generate all permutations over 1 .. N, for each of N in 1 .. 10, the package Generic_Perm from the Permutations task is used [[1]].

with Ada.Integer_Text_IO, Generic_Perm;
 
procedure Topswaps is
 
function Topswaps(Size: Positive) return Natural is
package Perms is new Generic_Perm(Size);
P: Perms.Permutation;
Done: Boolean;
Max: Natural;
 
function Swapper_Calls(P: Perms.Permutation) return Natural is
Q: Perms.Permutation := P;
I: Perms.Element := P(1);
begin
if I = 1 then
return 0;
else
for Idx in 1 .. I loop
Q(Idx) := P(I-Idx+1);
end loop;
return 1 + Swapper_Calls(Q);
end if;
end Swapper_Calls;
 
begin
Perms.Set_To_First(P, Done);
Max:= Swapper_Calls(P);
while not Done loop
Perms.Go_To_Next(P, Done);
Max := natural'Max(Max, Swapper_Calls(P));
end loop;
return Max;
end Topswaps;
 
begin
for I in 1 .. 10 loop
Ada.Integer_Text_IO.Put(Item => Topswaps(I), Width => 3);
end loop;
end Topswaps;
Output:
  0  1  2  4  7 10 16 22 30 38

[edit] AutoHotkey

Topswops(Obj, n){
R := []
for i, val in obj{
if (i <=n)
res := val (A_Index=1?"":",") res
else
res .= "," val
}
Loop, Parse, res, `,
R[A_Index]:= A_LoopField
return R
}
Examples:
Cards := [2, 4, 1, 3]
Res := Print(Cards)
while (Cards[1]<>1)
{
Cards := Topswops(Cards, Cards[1])
Res .= "`n"Print(Cards)
}
MsgBox % Res
 
Print(M){
for i, val in M
Res .= (A_Index=1?"":"`t") val
return Trim(Res,"`n")
}
Outputs:
2	4	1	3
4	2	1	3
3	1	2	4
2	1	3	4
1	2	3	4

[edit] C

An algorithm that doesn't go through all permutations, per Knuth tAoCP 7.2.1.2 exercise 107 (possible bad implementation on my part notwithstanding):

#include <stdio.h>
#include <string.h>
 
typedef struct { char v[16]; } deck;
typedef unsigned int uint;
 
uint n, d, best[16];
 
void tryswaps(deck *a, uint f, uint s) {
# define A a->v
# define B b.v
if (d > best[n]) best[n] = d;
while (1) {
if ((A[s] == s || (A[s] == -1 && !(f & 1U << s)))
&& (d + best[s] >= best[n] || A[s] == -1))
break;
 
if (d + best[s] <= best[n]) return;
if (!--s) return;
}
 
d++;
deck b = *a;
for (uint i = 1, k = 2; i <= s; k <<= 1, i++) {
if (A[i] != i && (A[i] != -1 || (f & k)))
continue;
 
for (uint j = B[0] = i; j--;) B[i - j] = A[j];
tryswaps(&b, f | k, s);
}
d--;
}
 
int main(void) {
deck x;
memset(&x, -1, sizeof(x));
x.v[0] = 0;
 
for (n = 1; n < 13; n++) {
tryswaps(&x, 1, n - 1);
printf("%2d: %d\n", n, best[n]);
}
 
return 0;
}

The code contains critical small loops, which can be manually unrolled for those with OCD. POSIX thread support is useful if you got more than one CPUs.

#define _GNU_SOURCE
#include <stdio.h>
#include <string.h>
#include <pthread.h>
#include <sched.h>
 
#define MAX_CPUS 8 // increase this if you got more CPUs/cores
 
typedef struct { char v[16]; } deck;
 
int n, best[16];
 
// Update a shared variable by spinlock. Since this program really only
// enters locks dozens of times, a pthread_mutex_lock() would work
// equally fine, but RC already has plenty of examples for that.
#define SWAP_OR_RETRY(var, old, new) \
if (!__sync_bool_compare_and_swap(&(var), old, new)) { \
volatile int spin = 64; \
while (spin--); \
continue; }

 
void tryswaps(deck *a, int f, int s, int d) {
#define A a->v
#define B b->v
 
while (best[n] < d) {
int t = best[n];
SWAP_OR_RETRY(best[n], t, d);
}
 
#define TEST(x) \
case x: if ((A[15-x] == 15-x || (A[15-x] == -1 && !(f & 1<<(15-x)))) \
&& (A[15-x] == -1 || d + best[15-x] >= best[n])) \
break; \
if (d + best[15-x] <= best[n]) return; \
s = 14 - x

 
switch (15 - s) {
TEST(0); TEST(1); TEST(2); TEST(3); TEST(4);
TEST(5); TEST(6); TEST(7); TEST(8); TEST(9);
TEST(10); TEST(11); TEST(12); TEST(13); TEST(14);
return;
}
#undef TEST
 
deck *b = a + 1;
*b = *a;
d++;
 
#define FLIP(x) \
if (A[x] == x || ((A[x] == -1) && !(f & (1<<x)))) { \
B[0] = x; \
for (int j = x; j--; ) B[x-j] = A[j]; \
tryswaps(b, f|(1<<x), s, d); } \
if (s == x) return;

 
FLIP(1); FLIP(2); FLIP(3); FLIP(4); FLIP(5);
FLIP(6); FLIP(7); FLIP(8); FLIP(9); FLIP(10);
FLIP(11); FLIP(12); FLIP(13); FLIP(14); FLIP(15);
#undef FLIP
}
 
int num_cpus(void) {
cpu_set_t ct;
sched_getaffinity(0, sizeof(ct), &ct);
 
int cnt = 0;
for (int i = 0; i < MAX_CPUS; i++)
if (CPU_ISSET(i, &ct))
cnt++;
 
return cnt;
}
 
struct work { int id; deck x[256]; } jobs[MAX_CPUS];
int first_swap;
 
void *thread_start(void *arg) {
struct work *job = arg;
while (1) {
int at = first_swap;
if (at >= n) return 0;
 
SWAP_OR_RETRY(first_swap, at, at + 1);
 
memset(job->x, -1, sizeof(deck));
job->x[0].v[at] = 0;
job->x[0].v[0] = at;
tryswaps(job->x, 1 | (1 << at), n - 1, 1);
}
}
 
int main(void) {
int n_cpus = num_cpus();
 
for (int i = 0; i < MAX_CPUS; i++)
jobs[i].id = i;
 
pthread_t tid[MAX_CPUS];
 
for (n = 2; n <= 14; n++) {
int top = n_cpus;
if (top > n) top = n;
 
first_swap = 1;
for (int i = 0; i < top; i++)
pthread_create(tid + i, 0, thread_start, jobs + i);
 
for (int i = 0; i < top; i++)
pthread_join(tid[i], 0);
 
printf("%2d: %2d\n", n, best[n]);
}
 
return 0;
}

[edit] D

Permutations generator from: http://rosettacode.org/wiki/Permutations#Faster_Lazy_Version

Translation of: Haskell
import std.stdio, std.algorithm, std.range, permutations2;
 
int topswops(in int n) pure @safe {
static int flip(int[] xa) pure nothrow @safe @nogc {
if (!xa[0]) return 0;
xa[0 .. xa[0] + 1].reverse();
return 1 + flip(xa);
}
return n.iota.array.permutations.map!flip.reduce!max;
}
 
void main() {
foreach (immutable i; 1 .. 11)
writeln(i, ": ", i.topswops);
}
Output:
1: 0
2: 1
3: 2
4: 4
5: 7
6: 10
7: 16
8: 22
9: 30
10: 38

[edit] D: Faster Version

Translation of: C
import std.stdio, std.typetuple;
 
template Range(int start, int stop) {
static if (stop <= start)
alias Range = TypeTuple!();
else
alias Range = TypeTuple!(Range!(start, stop - 1), stop - 1);
}
 
__gshared uint[32] best;
 
uint topswops(size_t n)() nothrow @nogc {
static assert(n > 0 && n < best.length);
size_t d = 0;
 
alias T = byte;
alias Deck = T[n];
 
void trySwaps(in ref Deck deck, in uint f) nothrow @nogc {
if (d > best[n])
best[n] = d;
 
foreach_reverse (immutable i; Range!(0, n)) {
if ((deck[i] == i || (deck[i] == -1 && !(f & (1U << i))))
&& (d + best[i] >= best[n] || deck[i] == -1))
break;
if (d + best[i] <= best[n])
return;
}
 
Deck deck2 = void;
foreach (immutable i; Range!(0, n)) // Copy.
deck2[i] = deck[i];
 
d++;
foreach (immutable i; Range!(1, n)) {
enum uint k = 1U << i;
if (deck[i] != i && (deck[i] != -1 || (f & k)))
continue;
 
deck2[0] = T(i);
foreach_reverse (immutable j; Range!(0, i))
deck2[i - j] = deck[j]; // Reverse copy.
trySwaps(deck2, f | k);
}
d--;
}
 
best[n] = 0;
Deck deck0 = -1;
deck0[0] = 0;
trySwaps(deck0, 1);
return best[n];
}
 
void main() {
foreach (i; Range!(1, 14))
writefln("%2d: %d", i, topswops!i());
}
Output:
 1: 0
 2: 1
 3: 2
 4: 4
 5: 7
 6: 10
 7: 16
 8: 22
 9: 30
10: 38
11: 51
12: 65
13: 80

With templates to speed up the computation, using the DMD compiler it's almost as fast as the second C version.

[edit] Erlang

This code is using the permutation code by someone else. Thank you.

 
-module( topswops ).
 
-export( [get_1_first/1, swap/1, task/0] ).
 
get_1_first( [1 | _T] ) -> 0;
get_1_first( List ) -> 1 + get_1_first( swap(List) ).
 
swap( [N | _T]=List ) ->
{Swaps, Remains} = lists:split( N, List ),
lists:reverse( Swaps ) ++ Remains.
 
task() ->
Permutations = [{X, permute:permute(lists:seq(1, X))} || X <- lists:seq(1, 10)],
Swops = [{N, get_1_first_many(N_permutations)} || {N, N_permutations} <- Permutations],
Topswops = [{N, lists:max(N_swops)} || {N, N_swops} <- Swops],
io:fwrite( "N topswaps~n" ),
[io:fwrite("~p ~p~n", [N, Max]) || {N, Max} <- Topswops].
 
 
 
get_1_first_many( N_permutations ) -> [get_1_first(X) || X <- N_permutations].
 
Output:
42> topswops:task().
N       topswaps
1       0
2       1
3       2
4       4
5       7
6       10
7       16
8       22
9       30
10      38

[edit] Fortran

module top
implicit none
contains
recursive function f(x) result(m)
integer :: n, m, x(:),y(size(x)), fst
fst = x(1)
if (fst == 1) then
m = 0
else
y(1:fst) = x(fst:1:-1)
y(fst+1:) = x(fst+1:)
m = 1 + f(y)
end if
end function
 
recursive function perms(x) result(p)
integer, pointer :: p(:,:), q(:,:)
integer :: x(:), n, k, i
n = size(x)
if (n == 1) then
allocate(p(1,1))
p(1,:) = x
else
q => perms(x(2:n))
k = ubound(q,1)
allocate(p(k*n,n))
p = 0
do i = 1,n
p(1+k*(i-1):k*i,1:i-1) = q(:,1:i-1)
p(1+k*(i-1):k*i,i) = x(1)
p(1+k*(i-1):k*i,i+1:) = q(:,i:)
end do
end if
end function
end module
 
program topswort
use top
implicit none
integer :: x(10)
integer, pointer :: p(:,:)
integer :: i, j, m
 
forall(i=1:10)
x(i) = i
end forall
 
do i = 1,10
p=>perms(x(1:i))
m = 0
do j = 1, ubound(p,1)
m = max(m, f(p(j,:)))
end do
print "(i3,a,i3)", i,": ",m
end do
end program
 

[edit] Go

// Adapted from http://www-cs-faculty.stanford.edu/~uno/programs/topswops.w
// at Donald Knuth's web site. Algorithm credited there to Pepperdine
// and referenced to Mathematical Gazette 73 (1989), 131-133.
package main
 
import "fmt"
 
const ( // array sizes
maxn = 10 // max number of cards
maxl = 50 // upper bound for number of steps
)
 
func main() {
for i := 1; i <= maxn; i++ {
fmt.Printf("%d: %d\n", i, steps(i))
}
}
 
func steps(n int) int {
var a, b [maxl][maxn + 1]int
var x [maxl]int
a[0][0] = 1
var m int
for l := 0; ; {
x[l]++
k := int(x[l])
if k >= n {
if l <= 0 {
break
}
l--
continue
}
if a[l][k] == 0 {
if b[l][k+1] != 0 {
continue
}
} else if a[l][k] != k+1 {
continue
}
a[l+1] = a[l]
for j := 1; j <= k; j++ {
a[l+1][j] = a[l][k-j]
}
b[l+1] = b[l]
a[l+1][0] = k + 1
b[l+1][k+1] = 1
if l > m-1 {
m = l + 1
}
l++
x[l] = 0
}
return m
}
Output:
1: 0
2: 1
3: 2
4: 4
5: 7
6: 10
7: 16
8: 22
9: 30
10: 38

[edit] Haskell

import Data.List (permutations)
 
topswops :: Int -> Int
topswops n = maximum $ map tops $ permutations [1 .. n]
where
tops (1 : _) = 0
tops xa@(x : _) = 1 + tops reordered
where
reordered = reverse (take x xa) ++ drop x xa
 
main = mapM_
(\x -> putStrLn $ show x ++ ":\t" ++ show (topswops x))
[1 .. 10]
Output:
1:	0
2:	1
3:	2
4:	4
5:	7
6:	10
7:	16
8:	22
9:	30
10:	38

Alternate version
Uses only permutations with all elements out of place.

import Data.List
import Control.Arrow
import Control.Monad
 
derangements = filter (and . zipWith (/=) [1..] ). permutations
topswop = ((uncurry (++). first reverse).). splitAt
topswopIter = takeWhile((/=1).head). iterate (topswop =<< head)
swops = map (length. topswopIter). derangements
 
topSwops :: [Int] -> [(Int, Int)]
topSwops = zip [1..]. map (maximum. (0:). swops). tail. inits

Output

*Main> mapM_ print $ take 10 $ topSwops [1..]
(1,0)
(2,1)
(3,2)
(4,4)
(5,7)
(6,10)
(7,16)
(8,22)
(9,30)
(10,38)

[edit] Icon and Unicon

This doesn't compile in Icon only because of the use of list comprehension to build the original list of 1..n values.

procedure main()
every n := 1 to 10 do {
ts := 0
every (ts := 0) <:= swop(permute([: 1 to n :]))
write(right(n, 3),": ",right(ts,4))
}
end
 
procedure swop(A)
count := 0
while A[1] ~= 1 do {
A := reverse(A[1+:A[1]]) ||| A[(A[1]+1):0]
count +:= 1
}
return count
end
 
procedure permute(A)
if *A <= 1 then return A
suspend [(A[1]<->A[i := 1 to *A])] ||| permute(A[2:0])
end

Sample run:

->topswop
  1:    0
  2:    1
  3:    2
  4:    4
  5:    7
  6:   10
  7:   16
  8:   22
  9:   30
 10:   38
->

[edit] J

Solution:
   swops =:  ((|.@:{. , }.)~ {.)^:a:
Example (from task introduction):
   swops 2 4 1 3
2 4 1 3
4 2 1 3
3 1 2 4
2 1 3 4
1 2 3 4
Example (topswops of all permutations of the integers 1..10):
   (,. _1 + ! >./@:(#@swops@A. >:)&i. ])&> 1+i.10
1 0
2 1
3 2
4 4
5 7
6 10
7 16
8 22
9 30
10 38

Notes: Readers less familiar with array-oriented programming may find an alternate solution written in the structured programming style more accessible.

[edit] Java

Translation of: D
public class Topswops {
static final int maxBest = 32;
static int[] best;
 
static private void trySwaps(int[] deck, int f, int d, int n) {
if (d > best[n])
best[n] = d;
 
for (int i = n - 1; i >= 0; i--) {
if (deck[i] == -1 || deck[i] == i)
break;
if (d + best[i] <= best[n])
return;
}
 
int[] deck2 = deck.clone();
for (int i = 1; i < n; i++) {
final int k = 1 << i;
if (deck2[i] == -1) {
if ((f & k) != 0)
continue;
} else if (deck2[i] != i)
continue;
 
deck2[0] = i;
for (int j = i - 1; j >= 0; j--)
deck2[i - j] = deck[j]; // Reverse copy.
trySwaps(deck2, f | k, d + 1, n);
}
}
 
static int topswops(int n) {
assert(n > 0 && n < maxBest);
best[n] = 0;
int[] deck0 = new int[n + 1];
for (int i = 1; i < n; i++)
deck0[i] = -1;
trySwaps(deck0, 1, 0, n);
return best[n];
}
 
public static void main(String[] args) {
best = new int[maxBest];
for (int i = 1; i < 11; i++)
System.out.println(i + ": " + topswops(i));
}
}
Output:
1: 0
2: 1
3: 2
4: 4
5: 7
6: 10
7: 16
8: 22
9: 30
10: 38

[edit] Julia

Fast, efficient version

function fannkuch(n)
n == 1 && return 0
n == 2 && return 1
p = [1:n]
q = copy(p)
s = copy(p)
sign = 1; maxflips = sum = 0
while true
q0 = p[1]
if q0 != 1
for i = 2:n
q[i] = p[i]
end
flips = 1
while true
qq = q[q0] #??
if qq == 1
sum += sign*flips
flips > maxflips && (maxflips = flips)
break
end
q[q0] = q0
if q0 >= 4
i = 2; j = q0-1
while true
t = q[i]
q[i] = q[j]
q[j] = t
i += 1
j -= 1
i >= j && break
end
end
q0 = qq
flips += 1
end
end
#permute
if sign == 1
t = p[2]
p[2] = p[1]
p[1] = t
sign = -1
else
t = p[2]
p[2] = p[3]
p[3] = t
sign = 1
for i = 3:n
sx = s[i]
if sx != 1
s[i] = sx-1
break
end
i == n && return maxflips
s[i] = i
t = p[1]
for j = 1:i
p[j] = p[j+1]
end
p[i+1] = t
end
end
end
end
Output:
julia> function main()
for i = 1:10
	println(fannkuch(i))
end
end
# methods for generic function main
main() at none:2

julia> @time main()
0
1
2
4
7
10
16
22
30
38
elapsed time: 0.299617582 seconds

[edit] Mathematica

An exhaustive search of all possible permutations is done

flip[a_] :=
Block[{a1 = First@a},
If[a1 == Length@a, Reverse[a],
Join[Reverse[a[[;; a1]]], a[[a1 + 1 ;;]]]]]
 
swaps[a_] := Length@FixedPointList[flip, a] - 2
 
Print[#, ": ", Max[swaps /@ Permutations[Range@#]]] & /@ Range[10];
Output:
1: 0
2: 1
3: 2
4: 4
5: 7
6: 10
7: 16
8: 22
9: 30
10: 38

[edit] Perl

Recursive backtracking solution, starting with the final state and going backwards.

 
sub next_swop {
my( $max, $level, $p, $d ) = @_;
my $swopped = 0;
for( 2..@$p ){ # find possibilities
my @now = @$p;
if( $_ == $now[$_-1] ) {
splice @now, 0, 0, reverse splice @now, 0, $_;
$swopped = 1;
next_swop( $max, $level+1, \@now, [ @$d ] );
}
}
for( 1..@$d ) { # create possibilities
my @now = @$p;
my $next = shift @$d;
if( not $now[$next-1] ) {
$now[$next-1] = $next;
splice @now, 0, 0, reverse splice @now, 0, $next;
$swopped = 1;
next_swop( $max, $level+1, \@now, [ @$d ] );
}
push @$d, $next;
}
$$max = $level if !$swopped and $level > $$max;
}
 
sub topswops {
my $n = shift;
my @d = 2..$n;
my @p = ( 1, (0) x ($n-1) );
my $max = 0;
next_swop( \$max, 0, \@p, \@d );
return $max;
}
 
printf "Maximum swops for %2d cards: %2d\n", $_, topswops $_ for 1..10;
 
Output:
Maximum swops for  1 cards:  0
Maximum swops for  2 cards:  1
Maximum swops for  3 cards:  2
Maximum swops for  4 cards:  4
Maximum swops for  5 cards:  7
Maximum swops for  6 cards: 10
Maximum swops for  7 cards: 16
Maximum swops for  8 cards: 22
Maximum swops for  9 cards: 30
Maximum swops for 10 cards: 38


[edit] Perl 6

sub postfix:<!>(@a) {
@a == 1
?? [@a]
!! do for @a -> $a {
[ $a, @$_ ] for @a.grep(* != $a)!
}
}
 
sub swops(@a is copy) {
my $count = 0;
until @a[0] == 1 {
@a[ ^@a[0] ] .= reverse;
$count++;
}
return $count;
}
sub topswops($n) { [max] map &swops, (1 .. $n)! }
 
say "$_ {topswops $_}" for 1 .. 10;

Output follows that of Python.

[edit] PL/I

 
(subscriptrange):
topswap: procedure options (main); /* 12 November 2013 */
declare cards(*) fixed (2) controlled, t fixed (2);
declare dealt(*) bit(1) controlled;
declare (count, i, m, n, c1, c2) fixed binary;
declare random builtin;
 
do n = 1 to 10;
allocate cards(n), dealt(n);
/* Take the n cards, in order ... */
do i = 1 to n; cards(i) = i; end;
/* ... and shuffle them. */
do i = 1 to n;
c1 = random*n+1; c2 = random*n+1;
t = cards(c1); cards(c1) = cards(c2); cards(c2) = t;
end;
/* If '1' is the first card, game is trivial; swap it with another. */
if cards(1) = 1 & n > 1 then
do; t = cards(1); cards(1) = cards(2); cards(2) = t; end;
 
count = 0;
do until (cards(1) = 1);
/* take the value of the first card, M, and reverse the first M cards. */
m = cards(1);
do i = 1 to m/2;
t = cards(i); cards(i) = cards(m-i+1); cards(m-i+1) = t;
end;
count = count + 1;
end;
put skip edit (n, ':', count) (f(2), a, f(4));
end;
end topswap;
 
 1:   1
 2:   1
 3:   2
 4:   2
 5:   4
 6:   2
 7:   1
 8:   9
 9:  16
10:   1

[edit] Potion

range = (a, b):
i = 0, l = list(b-a+1)
while (a + i <= b):
l (i) = a + i++.
l.
 
fannkuch = (n):
flips = 0, maxf = 0, k = 0, m = n - 1, r = n, check = 0
perml = range(0, n), count = list(n), perm = list(n)
 
loop:
if (check < 30):
perml join print, "\n" print
check++.
 
while (r != 1):
count (r-1) = r
r--.
 
if (perml (0) != 0 and perml (m) != m):
flips = 0, i = 1
while (i < n):
perm (i) = perml (i)
i++.
k = perml (0)
loop:
i = 1, j = k - 1
while (i < j):
t = perm (i), perm (i) = perm (j), perm (j) = t
i++, j--.
flips++
j = perm (k), perm (k) = k, k = j
if (k == 0): break.
.
if (flips > maxf): maxf = flips.
.
 
loop:
if (r == n):
maxf string print, "\n" print
return (maxf).
 
i = 0, j = perml (0)
while (i < r):
k = i + 1
perml (i) = perml (k)
i = k.
perml (r) = j
 
j = count (r) - 1
count (r) = j
if (j > 0): break.
r++
_ n
 
fannkuch(11)
 

Output follows that of Perl6 and Python.

[edit] Python

This solution uses cards numbered from 0..n-1 and variable p0 is introduced as a speed optimisation

>>> from itertools import permutations
>>> def f1(p):
i = 0
while True:
p0 = p[0]
if p0 == 1: break
p[:p0] = p[:p0][::-1]
i += 1
return i
 
>>> def fannkuch(n):
return max(f1(list(p)) for p in permutations(range(1, n+1)))
 
>>> for n in range(1, 11): print(n,fannkuch(n))
 
1 0
2 1
3 2
4 4
5 7
6 10
7 16
8 22
9 30
10 38
>>>

[edit] Python: Faster Version

Translation of: C
try:
import psyco
psyco.full()
except ImportError:
pass
 
best = [0] * 16
 
def try_swaps(deck, f, s, d, n):
if d > best[n]:
best[n] = d
 
i = 0
k = 1 << s
while s:
k >>= 1
s -= 1
if deck[s] == -1 or deck[s] == s:
break
i |= k
if (i & f) == i and d + best[s] <= best[n]:
return d
s += 1
 
deck2 = list(deck)
k = 1
for i2 in xrange(1, s):
k <<= 1
if deck2[i2] == -1:
if f & k: continue
elif deck2[i2] != i2:
continue
 
deck[i2] = i2
deck2[:i2 + 1] = reversed(deck[:i2 + 1])
try_swaps(deck2, f | k, s, 1 + d, n)
 
def topswops(n):
best[n] = 0
deck0 = [-1] * 16
deck0[0] = 0
try_swaps(deck0, 1, n, 0, n)
return best[n]
 
for i in xrange(1, 13):
print "%2d: %d" % (i, topswops(i))
Output:
 1: 0
 2: 1
 3: 2
 4: 4
 5: 7
 6: 10
 7: 16
 8: 22
 9: 30
10: 38
11: 51
12: 65

[edit] Racket

Simple search, only "optimization" is to consider only all-misplaced permutations (as in the alternative Haskell solution), which shaves off around 2 seconds (from ~5).

 
#lang racket
 
(define (all-misplaced? l)
(for/and ([x (in-list l)] [n (in-naturals 1)]) (not (= x n))))
 
(define (topswops n)
(for/fold ([m 0]) ([p (in-permutations (range 1 (add1 n)))]
#:when (all-misplaced? p))
(let loop ([p p] [n 0])
(if (= 1 (car p))
(max n m)
(loop (let loop ([l '()] [r p] [n (car p)])
(if (zero? n) (append l r)
(loop (cons (car r) l) (cdr r) (sub1 n))))
(add1 n))))))
 
(for ([i (in-range 1 11)]) (printf "~a\t~a\n" i (topswops i)))
 

Output:

1	0
2	1
3	2
4	4
5	7
6	10
7	16
8	22
9	30
10	38

[edit] REXX

The deckSets subroutine is a modified permSets (permutation sets) subroutine,
and is optimized somewhat to take advantage by eliminating one-swop "decks".

/*REXX pgm gens N decks of numbered cards and finds the maximum "swops".*/
parse arg things .; if things=='' then things=10; thingsX= things>9
 
do n=1 for things; #=deckSets(n,n) /*create "decks".*/
mx= n\==1 /*handle case of a one-card deck.*/
do i=1 for #
mx=max(mx,swops(!.i))
end /*i*/
say '──────── maximum swops for a deck of' right(n,2) ' cards is' right(mx,4)
end /*n*/
exit /*stick a fork in it, we're done.*/
/*──────────────────────────────────DECKSETS subroutine─────────────────*/
deckSets: procedure expose !. /*X things taken Y at a time.*/
parse arg x,y,,$ @.; #=0; call .deckset 1 /*set $ & @. to null.*/
return # /*return # permutations (decks).*/
.deckset: procedure expose @. x y $ # !.; parse arg ?
if ?>y then do; _=@.1; do j=2 to y; _=_ @.j; end /*j*/; #=#+1;  !.#=_
end
else do
 ?m=?-1 /*used in the FOR for faster DO.*/
if ?==1 then qs=2 /*¬ use 1-swops that start with 1*/
else do
qs=1
if @.1==? then qs=2 /*skip 1-swops: 3 x 1 x */
end
do q=qs to x /*build permutation recursively. */
do k=1 for ?m; if @.k==q then iterate q; end /*k*/
@.?=q; call .deckset(?+1)
end /*q*/
end
return
/*──────────────────────────────────SWOPS subroutine────────────────────*/
swops: parse arg z; do _=1; t=word(z,1)
if word(z,t)==1 then return _
if thingsX then do h=10 to things
z=changestr(h,z,d2x(h))
end /*h*/
z=reverse(subword(z,1,t)) subword(z,t+1)
if thingsX then do d=10 to things
z=changestr(d2x(d),z,d)
end /*_*/

Some older REXXes don't have a changestr bif, so one is included here ──► CHANGESTR.REX.

output when using the default input

──────── maximum swops for a deck of  1  cards is    0
──────── maximum swops for a deck of  2  cards is    1
──────── maximum swops for a deck of  3  cards is    2
──────── maximum swops for a deck of  4  cards is    4
──────── maximum swops for a deck of  5  cards is    7
──────── maximum swops for a deck of  6  cards is   10
──────── maximum swops for a deck of  7  cards is   16
──────── maximum swops for a deck of  8  cards is   22
──────── maximum swops for a deck of  9  cards is   30
──────── maximum swops for a deck of 10  cards is   38

[edit] Ruby

Translation of: Python
def f1(a)
i = 0
while (a0 = a[0]) > 1
a[0...a0] = a[0...a0].reverse
i += 1
end
i
end
 
def fannkuch(n)
[*1..n].permutation.map{|a| f1(a)}.max
end
 
for n in 1..10
puts "%2d : %d" % [n, fannkuch(n)]
end
Output:
 1 : 0
 2 : 1
 3 : 2
 4 : 4
 5 : 7
 6 : 10
 7 : 16
 8 : 22
 9 : 30
10 : 38

Faster Version

Translation of: Java
def try_swaps(deck, f, d, n)
@best[n] = d if d > @best[n]
(n-1).downto(0) do |i|
break if deck[i] == -1 || deck[i] == i
return if d + @best[i] <= @best[n]
end
deck2 = deck.dup
for i in 1...n
k = 1 << i
if deck2[i] == -1
next if f & k != 0
elsif deck2[i] != i
next
end
deck2[0] = i
deck2[1..i] = deck[0...i].reverse
try_swaps(deck2, f | k, d+1, n)
end
end
 
def topswops(n)
@best[n] = 0
deck0 = [-1] * (n + 1)
try_swaps(deck0, 1, 0, n)
@best[n]
end
 
@best = [0] * 16
for i in 1..10
puts "%2d : %d" % [i, topswops(i)]
end

[edit] Scala

Library: Scala
object Fannkuch extends App {
 
def fannkuchen(l: List[Int], n: Int, i: Int, acc: Int): Int = {
def flips(l: List[Int]): Int = (l: @unchecked) match {
case 1 :: ls => 0
case n :: ls => {
val splitted = l.splitAt(n)
flips(splitted._2.reverse_:::(splitted._1)) + 1
}
}
 
def rotateLeft(l: List[Int]) =
l match {
case Nil => List()
case x :: xs => xs ::: List(x)
}
 
if (i < n) {
if (n == 1)
acc.max(flips(l))
else {
val split = l.splitAt(n)
fannkuchen(rotateLeft(split._1) ::: split._2, n, i + 1, fannkuchen(l, n - 1, 0, acc))
}
} else acc
} // def fannkuchen(
 
val result = (1 to 10).map(i => (i, fannkuchen(List.range(1, i + 1), i, 0, 0)))
println("Computing results...")
result.foreach(x => println(f"Pfannkuchen(${x._1})\t= ${x._2}"))
assert(result == Vector((1, 0), (2, 1), (3, 2), (4, 4), (5, 7), (6, 10), (7, 16), (8, 22), (9, 30), (10, 38)), "Bad results")
println(s"Successfully completed without errors. [total ${scala.compat.Platform.currentTime - executionStart} ms]")
}
Output:
Computing results...
Pfannkuchen(1)	= 0
Pfannkuchen(2)	= 1
Pfannkuchen(3)	= 2
Pfannkuchen(4)	= 4
Pfannkuchen(5)	= 7
Pfannkuchen(6)	= 10
Pfannkuchen(7)	= 16
Pfannkuchen(8)	= 22
Pfannkuchen(9)	= 30
Pfannkuchen(10)	= 38
Successfully completed without errors. [total 10461 ms]

Process finished with exit code 0

[edit] Tcl

Library: Tcllib (Package: struct::list)
Probably an integer overflow at n=10.
package require struct::list
 
proc swap {listVar} {
upvar 1 $listVar list
set n [lindex $list 0]
for {set i 0; set j [expr {$n-1}]} {$i<$j} {incr i;incr j -1} {
set tmp [lindex $list $i]
lset list $i [lindex $list $j]
lset list $j $tmp
}
}
 
proc swaps {list} {
for {set i 0} {[lindex $list 0] > 1} {incr i} {
swap list
}
return $i
}
 
proc topswops list {
set n 0
 ::struct::list foreachperm p $list {
set n [expr {max($n,[swaps $p])}]
}
return $n
}
 
proc topswopsTo n {
puts "n\ttopswops(n)"
for {set i 1} {$i <= $n} {incr i} {
puts $i\t[topswops [lappend list $i]]
}
}
topswopsTo 10
Output:
n	topswops(n)
1	0
2	1
3	2
4	4
5	7
6	10
7	16
8	22
9	30
10	38

[edit] XPL0

code ChOut=8, CrLf=9, IntOut=11;
int N, Max, Card1(16), Card2(16);
 
proc Topswop(D); \Conway's card swopping game
int D; \depth of recursion
int I, J, C, T;
[if D # N then \generate N! permutations of 1..N in Card1
[for I:= 0 to N-1 do
[for J:= 0 to D-1 do \check if object (letter) already used
if Card1(J) = I+1 then J:=100;
if J < 100 then
[Card1(D):= I+1; \card number not used so append it
Topswop(D+1); \recurse next level deeper
];
];
]
else [\determine number of topswops to get card 1 at beginning
for I:= 0 to N-1 do Card2(I):= Card1(I); \make working copy of deck
C:= 0; \initialize swop counter
while Card2(0) # 1 do
[I:= 0; J:= Card2(0)-1;
while I < J do
[T:= Card2(I); Card2(I):= Card2(J); Card2(J):= T;
I:= I+1; J:= J-1;
];
C:= C+1;
];
if C>Max then Max:= C;
];
];
 
[for N:= 1 to 10 do
[Max:= 0;
Topswop(0);
IntOut(0, N); ChOut(0, ^ ); IntOut(0, Max); CrLf(0);
];
]
Output:
1 0
2 1
3 2
4 4
5 7
6 10
7 16
8 22
9 30
10 38

[edit] XPL0: Faster Version

Translation of: C
code CrLf=9, IntOut=11, Text=12;
int N, D, Best(16);
 
proc TrySwaps(A, F, S);
int A, F, S;
int B(16), I, J, K;
[if D > Best(N) then Best(N):= D;
loop [if A(S)=-1 ! A(S)=S then quit;
if D+Best(S) <= Best(N) then return;
if S = 0 then quit;
S:= S-1;
];
D:= D+1;
for I:= 0 to S do B(I):= A(I);
K:= 1;
for I:= 1 to S do
[K:= K<<1;
if B(I)=-1 & (F&K)=0 ! B(I)=I then
[J:= I; B(0):= J;
while J do [J:= J-1; B(I-J):= A(J)];
TrySwaps(B, F!K, S);
];
];
D:= D-1;
];
 
int I, X(16);
[for I:= 0 to 16-1 do
[X(I):= -1; Best(I):= 0];
X(0):= 0;
for N:= 1 to 13 do
[D:= 0;
TrySwaps(X, 1, N-1);
IntOut(0, N); Text(0, ": "); IntOut(0, Best(N)); CrLf(0);
];
]
Output:
1: 0
2: 1
3: 2
4: 4
5: 7
6: 10
7: 16
8: 22
9: 30
10: 38
11: 51
12: 65
13: 80

[edit] zkl

Translation of: D

Slow version

fcn topswops(n){
flip:=fcn(xa){
if (not xa[0]) return(0);
xa.reverse(0,xa[0]+1); // inplace, ~4x faster than making new lists
return(1 + self.fcn(xa));
};
(0).pump(n,List):Utils.Helpers.permute(_).apply("copy").apply(flip).reduce("max");
}
 
foreach n in ([1 .. 10]){ println(n, ": ", topswops(n)) }
Output:
1: 0
2: 1
3: 2
4: 4
5: 7
6: 10
7: 16
8: 22
9: 30
10: 38
Personal tools
Namespaces

Variants
Actions
Community
Explore
Misc
Toolbox