Topswops: Difference between revisions

From Rosetta Code
Content added Content deleted
(D language: simpler first entry)
Line 22: Line 22:
* [[Number reversal game]]
* [[Number reversal game]]
* [[Sorting algorithms/Pancake sort]]
* [[Sorting algorithms/Pancake sort]]

=={{header|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 ised [[http://rosettacode.org/wiki/Permutations#The_generic_package_Generic_Perm]].

<lang Ada>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;</lang>

{{out}}<pre> 0 1 2 4 7 10 16 22 30 38</pre>


=={{header|C}}==
=={{header|C}}==

Revision as of 10:00, 22 April 2013

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.

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 ised [[1]].

<lang Ada>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;</lang>

Output:
  0  1  2  4  7 10 16 22 30 38

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): <lang c>#include <stdio.h>

  1. 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) {

  1. define A a->v
  2. 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; }</lang> 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. <lang c>#define _GNU_SOURCE

  1. include <stdio.h>
  2. include <string.h>
  3. include <pthread.h>
  4. include <sched.h>
  1. 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.

  1. 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) {

  1. define A a->v
  2. define B b->v

while (best[n] < d) { int t = best[n]; SWAP_OR_RETRY(best[n], t, d); }

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

  1. undef TEST

deck *b = a + 1; *b = *a; d++;

  1. 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);

  1. 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; }</lang>

D

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

Translation of: Haskell

<lang d>import std.stdio, std.algorithm, std.range, permutations2;

int topswops(in int n) { 

   static int flip(int[] xa) pure nothrow {
       if (!xa[0]) return 0;
       xa[0 .. xa[0] + 1].reverse(); // Slow with DMD.
       return 1 + flip(xa);
   }
   return n.iota.array.permutations.map!flip.reduce!max;

}

void main() { 

   foreach (immutable i; 1 .. 11)
       writeln(i, ": ", i.topswops);

}</lang>

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

D: Faster Version

Translation of: C

<lang d>import std.stdio, std.typetuple;

template Range(int start, int stop) { 

   static if (stop <= start)
       alias TypeTuple!() Range;
   else
       alias TypeTuple!(Range!(start, stop - 1), stop - 1) Range;

}

__gshared uint[32] best;

uint topswops(size_t n)() nothrow { 

   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 {
       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] = cast(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());

}</lang>

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.

Go

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

}</lang>

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


Haskell

<lang 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]</lang>
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. <lang Haskell>import Data.List import Control.Arrow import Control.Monad

derangements [1] = 1 derangements xs = filter (and . zipWith (/=) [1..] ). permutations $ xs 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. swops). drop 1. inits</lang> 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)

J

Solution:<lang j> swops =: ((|.@:{. , }.)~ {.)^:a:</lang> Example (from task introduction):<lang j> 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</lang> Example (topswops of all permutations of the integers 1..10):<lang j> (,. _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</lang> Notes: Readers less familiar with array-oriented programming may find an alternate solution written in the structured programming style more accessible.

Java

Translation of: D

<lang java>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));
   }

}</lang>

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

Julia

Brute force method <lang julia>function topswops(n) first = [1:n]; swapsa = ref(Int) for perm = 2:(factorial(n)/factorial(n-n)) swaps = 0 a = nthperm(first,perm) if a == first break else while a[1] != 1 a[1:a[1]] = reverse(a[1:a[1]]); swaps+= 1 end push!(swapsa,swaps) end end return max(swapsa) end</lang> 

julia> for i = 1:10 println(topswops(i)) end
0
1
2
4
7
10
16
22
30
38

Mathematica

An exhaustive search of all possible permutations is done <lang Mathematica>flip[a_] := 

Block[{a1 = First@a},
 If[a1 == Length@a, Reverse[a], 
  Join[Reverse[a;; a1], aa1 + 1 ;;]]]

swaps[a_] := Length@FixedPointList[flip, a] - 2

Print[#, ": ", Max[swaps /@ Permutations[Range@#]]] & /@ Range[10];</lang>

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

Perl 6

<lang perl6>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;</lang>

Output follows that of Python.

Python

This solution uses cards numbered from 0..n-1 and variable p0 is introduced as a speed optimisation <lang python>>>> from itertools import permutations >>> def f1(p): i, p0 = 0, p[0] while p0: i += 1 p0 += 1 p[:p0] = p[:p0][::-1] p0 = p[0] return i

>>> def fannkuch(n): return max(f1(list(p)) for p in permutations(range(n)))

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

Python: Faster Version

Translation of: C

<lang python>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))</lang>
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

REXX

The deckSets subroutine is a modified permSets (permutation sets) subroutine,
and is optimized somewhat to take advantage by eliminating one-swop "decks". <lang rexx>/*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   /*_*/</lang>

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

Tcl

Library: Tcllib (Package: struct::list)

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

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

<lang 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);
   ];

]</lang>

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

XPL0: Faster Version

Translation of: C

<lang XPL0>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);
       ];

]</lang>

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
Retrieved from "https://rosettacode.org/wiki/Topswops?oldid=222031"