Data commit

Task/Knuth-shuffle/Haskell/knuth-shuffle-1.hs

@@ -0,0 +1,17 @@
+import System.Random (randomRIO)
+
+mkRands :: Int -> IO [Int]
+mkRands = mapM (randomRIO . (,) 0) . enumFromTo 1 . pred
+
+replaceAt :: Int -> a -> [a] -> [a]
+replaceAt i c l =
+  let (a, b) = splitAt i l
+  in a ++ c : drop 1 b
+
+swapElems :: (Int, Int) -> [a] -> [a]
+swapElems (i, j) xs
+  | i == j = xs
+  | otherwise = replaceAt j (xs !! i) $ replaceAt i (xs !! j) xs
+
+knuthShuffle :: [a] -> IO [a]
+knuthShuffle xs = (foldr swapElems xs . zip [1 ..]) <$> mkRands (length xs)

Task/Knuth-shuffle/Haskell/knuth-shuffle-2.hs

@@ -0,0 +1,22 @@
+import System.Random (randomRIO)
+import Data.Bool (bool)
+
+knuthShuffle :: [a] -> IO [a]
+knuthShuffle xs = (foldr swapped xs . zip [1 ..]) <$> randoms (length xs)
+
+swapped :: (Int, Int) -> [a] -> [a]
+swapped (i, j) xs =
+  let go (a, b)
+        | a == b = xs
+        | otherwise =
+          let (m, n) = bool (b, a) (a, b) (b > a)
+              (l, hi:t) = splitAt m xs
+              (ys, lo:zs) = splitAt (pred (n - m)) t
+          in concat [l, lo : ys, hi : zs]
+  in bool xs (go (i, j)) $ ((&&) . (i <) <*> (j <)) $ length xs
+
+randoms :: Int -> IO [Int]
+randoms x = mapM (randomRIO . (,) 0) [1 .. pred x]
+
+main :: IO ()
+main = knuthShuffle ['a' .. 'k'] >>= print

Task/Knuth-shuffle/Haskell/knuth-shuffle-3.hs

@@ -0,0 +1,3 @@
+knuthShuffleProcess :: (Show a) => [a] -> IO ()
+knuthShuffleProcess =
+   (mapM_ print. reverse =<<). ap (fmap. (. zip [1..]). scanr swapElems) (mkRands. length)

Task/Knuth-shuffle/Haskell/knuth-shuffle-4.hs

@@ -0,0 +1,21 @@
+import Data.Array.ST
+import Data.STRef
+import Control.Monad
+import Control.Monad.ST
+import Control.Arrow
+import System.Random
+
+shuffle :: RandomGen g => [a] -> g -> ([a], g)
+shuffle list g = runST $ do
+    r <- newSTRef g
+    let rand range = liftM (randomR range) (readSTRef r) >>=
+            runKleisli (second (Kleisli $ writeSTRef r) >>> arr fst)
+    a <- newAry (1, len) list
+    forM_ [len, len - 1 .. 2] $ \n -> do
+        k <- rand (1, n)
+        liftM2 (,) (readArray a k) (readArray a n) >>=
+           runKleisli (Kleisli (writeArray a n) *** Kleisli (writeArray a k))
+    liftM2 (,) (getElems a) (readSTRef r)
+  where len = length list
+        newAry :: (Int, Int) -> [a] -> ST s (STArray s Int a)
+        newAry = newListArray