Data commit

Task/Topswops/Haskell/topswops-1.hs

@@ -0,0 +1,12 @@
+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_ (putStrLn . ((++) <$> show <*> (":\t" ++) . show . topswops)) [1 .. 10]

Task/Topswops/Haskell/topswops-2.hs

@@ -0,0 +1,20 @@
+import Data.List (permutations, inits)
+import Control.Arrow (first)
+
+derangements :: [Int] -> [[Int]]
+derangements = (\x -> filter (and . zipWith (/=) x)) <*> permutations
+
+topswop :: Int -> [a] -> [a]
+topswop x xs = uncurry (++) (first reverse (splitAt x xs))
+
+topswopIter :: [Int] -> [[Int]]
+topswopIter = takeWhile ((/= 1) . head) . iterate (topswop =<< head)
+
+swops :: [Int] -> [Int]
+swops = fmap (length . topswopIter) . derangements
+
+topSwops :: [Int] -> [(Int, Int)]
+topSwops = zip [1 ..] . fmap (maximum . (0 :) . swops) . tail . inits
+
+main :: IO ()
+main = mapM_ print $ take 10 $ topSwops [1 ..]

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