Sync

Task/Topswops/Ada/topswops.ada

@@ -0,0 +1,39 @@
+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;

Task/Topswops/Fortran/topswops.f

@@ -0,0 +1,56 @@
+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

Task/Topswops/Haskell/topswops-2.hs

@@ -2,11 +2,10 @@ import Data.List
 import Control.Arrow
 import Control.Monad
 
-derangements [1] = [[1]]
-derangements xs = filter (and . zipWith (/=) [1..] ). permutations $ xs
+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. swops). drop 1. inits
+topSwops = zip [1..]. map (maximum. (0:). swops). tail. inits

Task/Topswops/Haskell/topswops-3.hs

@@ -0,0 +1,21 @@
+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

Task/Topswops/Julia/topswops.julia

@@ -1,16 +1,65 @@
-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
+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
-			push!(swapsa,swaps)
 		end
 	end
-	return max(swapsa)
 end

Task/Topswops/Python/topswops-1.py

@@ -1,15 +1,15 @@
 >>> from itertools import permutations
 >>> def f1(p):
-	i, p0 = 0, p[0]
-	while p0:
-		i  += 1
-		p0 += 1
-		p[:p0] = p[:p0][::-1]
+	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(n)))
+	return max(f1(list(p)) for p in permutations(range(1, n+1)))
 
 >>> for n in range(1, 11): print(n,fannkuch(n))
 

Task/Topswops/Racket/topswops.rkt

@@ -0,0 +1,17 @@
+#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)))

Task/Topswops/Ruby/topswops-1.rb

@@ -0,0 +1,18 @@
+def f1(a)
+  i = 0
+  loop do
+    a0 = a[0]
+    break if a0 == 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

Task/Topswops/Ruby/topswops-2.rb

@@ -0,0 +1,31 @@
+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