CloudFlare suffered a massive security issue affecting all of its customers, including Rosetta Code. All passwords not changed since February 19th 2017 have been expired, and session cookie longevity will be reduced until late March.--Michael Mol (talk) 05:15, 25 February 2017 (UTC)

Topswops

From Rosetta Code
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.


Related tasks



360 Assembly[edit]

The program uses two ASSIST macro (XDECO,XPRNT) to keep the code as short as possible.

*        Topswops optimized        12/07/2016
TOPSWOPS CSECT
USING TOPSWOPS,R13 base register
B 72(R15) skip savearea
DC 17F'0' savearea
STM R14,R12,12(R13) prolog
ST R13,4(R15) " <-
ST R15,8(R13) " ->
LR R13,R15 " addressability
MVC N,=F'1' n=1
LOOPN L R4,N n; do n=1 to 10 ===-------------==*
C R4,=F'10' " *
BH ELOOPN . *
MVC P(40),PINIT p=pinit
MVC COUNTM,=F'0' countm=0
REPEAT MVC CARDS(40),P cards=p -------------------------+
SR R11,R11 count=0 |
WHILE CLC CARDS,=F'1' do while cards(1)^=1 ---------+
BE EWHILE . |
MVC M,CARDS m=cards(1)
L R2,M m
SRA R2,1 m/2
ST R2,MD2 md2=m/2
L R3,M @card(mm)=m
SLA R3,2 *4
LA R3,CARDS-4(R3) @card(mm)
LA R2,CARDS @card(i)=0
LA R6,1 i=1
LOOPI C R6,MD2 do i=1 to m/2 -------------+
BH ELOOPI . |
L R0,0(R2) swap r0=cards(i)
MVC 0(4,R2),0(R3) swap cards(i)=cards(mm)
ST R0,0(R3) swap cards(mm)=r0
AH R2,=H'4' @card(i)[email protected](i)+4
SH R3,=H'4' @card(mm)[email protected](mm)-4
LA R6,1(R6) i=i+1 |
B LOOPI ----------------------------+
ELOOPI LA R11,1(R11) count=count+1 |
B WHILE -------------------------------+
EWHILE C R11,COUNTM if count>countm
BNH NOTGT then
ST R11,COUNTM countm=count
NOTGT BAL R14,NEXTPERM call nextperm
LTR R0,R0 until nextperm=0 |
BNZ REPEAT ---------------------------------+
L R1,N n
XDECO R1,XDEC edit n
MVC PG(2),XDEC+10 output n
MVI PG+2,C':' output ':'
L R1,COUNTM countm
XDECO R1,XDEC edit countm
MVC PG+3(4),XDEC+8 output countm
XPRNT PG,L'PG print buffer
L R1,N n *
LA R1,1(R1) +1 *
ST R1,N n=n+1 *
B LOOPN ===------------------------------==*
ELOOPN L R13,4(0,R13) epilog
LM R14,R12,12(R13) " restore
XR R15,R15 " rc=0
BR R14 exit
PINIT DC F'1',F'2',F'3',F'4',F'5',F'6',F'7',F'8',F'9',F'10'
CARDS DS 10F cards
P DS 10F p
COUNTM DS F countm
M DS F m
N DS F n
MD2 DS F m/2
PG DC CL20' ' buffer
XDEC DS CL12 temp
*------- ---- nextperm ----------{-----------------------------------
NEXTPERM L R9,N nn=n
SR R8,R8 jj=0
LR R7,R9 nn
BCTR R7,0 j=nn-1
LTR R7,R7 if j=0
BZ ELOOPJ1 then skip do loop
LOOPJ1 LR R1,R7 do j=nn-1 to 1 by -1; j ----+
SLA R1,2 . |
L R2,P-4(R1) p(j)
C R2,P(R1) if p(j)<p(j+1)
BNL PJGEPJP then
LR R8,R7 jj=j
B ELOOPJ1 leave j |
PJGEPJP BCT R7,LOOPJ1 j=j-1 ---------------------+
ELOOPJ1 LA R7,1(R8) j=jj+1
LOOPJ2 CR R7,R9 do j=jj+1 while j<nn ------+
BNL ELOOPJ2 . |
LR R2,R7 j
SLA R2,2 .
LR R3,R9 nn
SLA R3,2 .
L R0,P-4(R2) swap p(j),p(nn)
L R1,P-4(R3) "
ST R0,P-4(R3) "
ST R1,P-4(R2) "
BCTR R9,0 nn=nn-1
LA R7,1(R7) j=j+1 |
B LOOPJ2 ----------------------------+
ELOOPJ2 LTR R8,R8 if jj=0
BNZ JJNE0 then
LA R0,0 return(0)
BR R14 "
JJNE0 LA R7,1(R8) j=jj+1
LR R2,R7 j
SLA R2,2 [email protected](j)
LR R3,R8 jj
SLA R3,2 [email protected](jj)
LOOPJ3 L R0,P-4(R2) p(j) ----------------------+
C R0,P-4(R3) do j=jj+1 while p(j)<p(jj) |
BNL ELOOPJ3
LA R2,4(R2) [email protected](j)[email protected](j)+4
LA R7,1(R7) j=j+1 |
B LOOPJ3 ----------------------------+
ELOOPJ3 L R1,P-4(R3) swap p(j),p(jj)
ST R0,P-4(R3) "
ST R1,P-4(R2) "
LA R0,1 return(1)
BR R14 ---------------}-----------------------------------
YREGS
END TOPSWOPS
Output:
 1:   0
 2:   1
 3:   2
 4:   4
 5:   7
 6:  10
 7:  16
 8:  22
 9:  30
10:  38

Ada[edit]

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

AutoHotkey[edit]

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

C[edit]

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;
}

D[edit]

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

D: Faster Version[edit]

Translation of: C
import std.stdio, std.typecons;
 
__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; staticIota!(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; staticIota!(0, n)) // Copy.
deck2[i] = deck[i];
 
d++;
foreach (immutable i; staticIota!(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; staticIota!(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 (immutable i; staticIota!(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.

Eiffel[edit]

 
class
TOPSWOPS
 
create
make
 
feature
 
make (n: INTEGER)
-- Topswop game.
local
perm, ar: ARRAY [INTEGER]
tcount, count: INTEGER
do
create perm_sol.make_empty
create solution.make_empty
across
1 |..| n as c
loop
create ar.make_filled (0, 1, c.item)
across
1 |..| c.item as d
loop
ar [d.item] := d.item
end
permute (ar, 1)
across
1 |..| perm_sol.count as e
loop
tcount := 0
from
until
perm_sol.at (e.item).at (1) = 1
loop
perm_sol.at (e.item) := reverse_array (perm_sol.at (e.item))
tcount := tcount + 1
end
if tcount > count then
count := tcount
end
end
solution.force (count, c.item)
end
end
 
solution: ARRAY [INTEGER]
 
feature {NONE}
 
perm_sol: ARRAY [ARRAY [INTEGER]]
 
reverse_array (ar: ARRAY [INTEGER]): ARRAY [INTEGER]
-- Array with 'ar[1]' elements reversed.
require
ar_not_void: ar /= Void
local
i, j: INTEGER
do
create Result.make_empty
Result.deep_copy (ar)
from
i := 1
j := ar [1]
until
i > j
loop
Result [i] := ar [j]
Result [j] := ar [i]
i := i + 1
j := j - 1
end
ensure
same_elements: across ar as a all Result.has (a.item) end
end
 
permute (a: ARRAY [INTEGER]; k: INTEGER)
-- All permutations of array 'a' stored in perm_sol.
require
ar_not_void: a.count >= 1
k_valid_index: k > 0
local
i, t: INTEGER
temp: ARRAY [INTEGER]
do
create temp.make_empty
if k = a.count then
across
a as ar
loop
temp.force (ar.item, temp.count + 1)
end
perm_sol.force (temp, perm_sol.count + 1)
else
from
i := k
until
i > a.count
loop
t := a [k]
a [k] := a [i]
a [i] := t
permute (a, k + 1)
t := a [k]
a [k] := a [i]
a [i] := t
i := i + 1
end
end
end
 
end
 

Test:

 
class
APPLICATION
 
create
make
 
feature
 
make
do
create topswop.make (10)
across
topswop.solution as t
loop
io.put_string (t.item.out + "%N")
end
end
 
topswop: TOPSWOPS
 
end
 
Output:
0 
1 
2 
4 
7 
10 
16 
22 
30 
38

Elixir[edit]

Translation of: Erlang
defmodule Topswops do
def get_1_first( [1 | _t] ), do: 0
def get_1_first( list ), do: 1 + get_1_first( swap(list) )
 
defp swap( [n | _t]=list ) do
{swaps, remains} = Enum.split( list, n )
Enum.reverse( swaps, remains )
end
 
def task do
IO.puts "N\ttopswaps"
Enum.map(1..10, fn n -> {n, permute(Enum.to_list(1..n))} end)
|> Enum.map(fn {n, n_permutations} -> {n, get_1_first_many(n_permutations)} end)
|> Enum.map(fn {n, n_swops} -> {n, Enum.max(n_swops)} end)
|> Enum.each(fn {n, max} -> IO.puts "#{n}\t#{max}" end)
end
 
def get_1_first_many( n_permutations ), do: (for x <- n_permutations, do: get_1_first(x))
 
defp permute([]), do: [[]]
defp permute(list), do: for x <- list, y <- permute(list -- [x]), do: [x|y]
end
 
Topswops.task
Output:
N       topswaps
1       0
2       1
3       2
4       4
5       7
6       10
7       16
8       22
9       30
10      38

Erlang[edit]

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

Fortran[edit]

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
 

Go[edit]

// 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

Haskell[edit]

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)

Icon and Unicon[edit]

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
->

J[edit]

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 + ! >./@:([email protected]@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.

Java[edit]

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

jq[edit]

The following uses permutations and is therefore impractical for n>10 or so.

Infrastructure:

# "while" as defined here is included in recent versions (>1.4) of jq:
def until(cond; next):
def _until:
if cond then . else (next|_until) end;
_until;
 
# Generate a stream of permutations of [1, ... n].
# This implementation uses arity-0 filters for speed.
def permutations:
# Given a single array, insert generates a stream by inserting (length+1) at different positions
def insert: # state: [m, array]
.[0] as $m | (1+(.[1]|length)) as $n
| .[1]
| if $m >= 0 then (.[0:$m] + [$n] + .[$m:]), ([$m-1, .] | insert) else empty end;
 
if .==0 then []
elif . == 1 then [1]
else
. as $n | ($n-1) | permutations | [$n-1, .] | insert
end;

Topswops:

# Input: a permutation; output: an integer
def flips:
# state: [i, array]
[0, .]
| until( .[1][0] == 1;
.[1] as $p | $p[0] as $p0
| [.[0] + 1, ($p[:$p0] | reverse) + $p[$p0:] ] )
| .[0];
 
# input: n, the number of items
def fannkuch:
reduce permutations as $p
(0; [., ($p|flips) ] | max);

Example:

range(1; 11) | [., fannkuch ]
Output:
$ jq -n -c -f topswops.jq
[1,0]
[2,1]
[3,2]
[4,4]
[5,7]
[6,10]
[7,16]
[8,22]
[9,30]
[10,38]

Julia[edit]

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

Lua[edit]

-- Return an iterator to produce every permutation of list
function permute (list)
local function perm (list, n)
if n == 0 then coroutine.yield(list) end
for i = 1, n do
list[i], list[n] = list[n], list[i]
perm(list, n - 1)
list[i], list[n] = list[n], list[i]
end
end
return coroutine.wrap(function() perm(list, #list) end)
end
 
-- Perform one topswop round on table t
function swap (t)
local new, limit = {}, t[1]
for i = 1, #t do
if i <= limit then
new[i] = t[limit - i + 1]
else
new[i] = t[i]
end
end
return new
end
 
-- Find the most swaps needed for any starting permutation of n cards
function topswops (n)
local numTab, highest, count = {}, 0
for i = 1, n do numTab[i] = i end
for numList in permute(numTab) do
count = 0
while numList[1] ~= 1 do
numList = swap(numList)
count = count + 1
end
if count > highest then highest = count end
end
return highest
end
 
-- Main procedure
for i = 1, 10 do print(i, topswops(i)) end
Output:
1       0
2       1
3       2
4       4
5       7
6       10
7       16
8       22
9       30
10      38

Mathematica[edit]

An exhaustive search of all possible permutations is done

flip[a_] :=
Block[{a1 = [email protected]},
If[a1 == [email protected], Reverse[a],
Join[Reverse[a[[;; a1]]], a[[a1 + 1 ;;]]]]]
 
swaps[a_] := [email protected][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

PARI/GP[edit]

Naive solution:

flip(v:vec)={
my(t=v[1]+1);
if (t==2, return(0));
for(i=1,t\2, [v[t-i],v[i]]=[v[i],v[t-i]]);
1+flip(v)
}
topswops(n)={
my(mx);
for(i=0,n!-1,
mx=max(flip(Vecsmall(numtoperm(n,i))),mx)
);
mx;
}
vector(10,n,topswops(n))
Output:
%1 = [0, 1, 2, 4, 7, 10, 16, 22, 30, 38]

An efficient solution would use PARI, following the C solution.

Perl[edit]

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

Perl 6[edit]

sub swops(@a is copy) {
my $count = 0;
until @a[0] == 1 {
@a[ ^@a[0] ] .= reverse;
$count++;
}
return $count;
}
 
sub topswops($n) { (sort map &swops, (1..$n).permutations)[*-1] }
 
say "$_ {topswops $_}" for 1 .. 10;

Output follows that of Python.

Phix[edit]

Originally contributed by Jason Gade as part of the Euphoria version of the Great Computer Language Shootout benchmarks.

function fannkuch(integer n)
sequence start = tagset(n),
perm,
perm1 = start,
count = start
integer maxFlipsCount = 0, r = n+1
integer perm0, flipsCount, k, k2, j, j2
 
while 1 do
while r!=1 do count[r-1] = r r -= 1 end while
if not (perm1[1]=1 or perm1[n]=n) then
perm = perm1
flipsCount = 0
k = perm[1]
while k!=1 do
k2 = floor((k+1)/2)
perm = reverse(perm[1..k]) & perm[k+1..n]
flipsCount += 1
k = perm[1]
end while
if flipsCount>maxFlipsCount then
maxFlipsCount = flipsCount
end if
end if
-- Use incremental change to generate another permutation
while 1 do
if r>n then return maxFlipsCount end if
perm0 = perm1[1]
j2 = 1
while j2<r do
j = j2+1
perm1[j2] = perm1[j]
j2 = j
end while
perm1[r] = perm0
count[r] = count[r]-1
if count[r]>1 then exit else r += 1 end if
end while
end while
end function -- fannkuch
 
for i=1 to 10 do
 ? fannkuch(i)
end for
Output:
0
1
2
4
7
10
16
22
30
38

PicoLisp[edit]

(de fannkuch (N)
(let (Lst (range 1 N) L Lst Max)
(recur (L) # Permute
(if (cdr L)
(do (length L)
(recurse (cdr L))
(rot L) )
(zero N) # For each permutation
(for (P (copy Lst) (> (car P) 1) (flip P (car P)))
(inc 'N) )
(setq Max (max N Max)) ) )
Max ) )
 
(for I 10
(println I (fannkuch I)) )

Output:

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

PL/I[edit]

 
(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

Potion[edit]

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
perml = range(0, n), count = list(n), perm = list(n)
 
loop:
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):
(n, maxf) say
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
 
n = argv(1) number
if (n<1): n=10.
fannkuch(n)
 

Output follows that of Perl6 and Python, ~2.5x faster than perl5

Python[edit]

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
>>>

Python: Faster Version[edit]

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

Racket[edit]

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

REXX[edit]

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

Ruby[edit]

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

Scala[edit]

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) acc
else {
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))
}
}
} // 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(s"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 7401 ms]

Process finished with exit code 0

Tcl[edit]

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

XPL0[edit]

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

XPL0: Faster Version[edit]

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

zkl[edit]

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(_).pump(List,"copy",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