Data commit

Task/Josephus-problem/Haskell/josephus-problem-1.hs

@@ -0,0 +1,40 @@
+import Data.List ((\\))
+import System.Environment (getArgs)
+
+prisoners :: Int -> [Int]
+prisoners n = [0 .. n - 1]
+
+counter :: Int -> [Int]
+counter k = cycle [k, k-1 .. 1]
+
+killList :: [Int] -> [Int] -> ([Int], [Int], [Int])
+killList xs cs = (killed, survivors, newCs)
+    where
+        (killed, newCs) = kill xs cs []
+        survivors = xs \\ killed
+        kill [] cs rs = (rs, cs)
+        kill (x:xs) (c:cs) rs
+            | c == 1 =
+                let ts = rs ++ [x]
+                in  kill xs cs ts
+            | otherwise =
+                kill xs cs rs
+
+killRecursive :: [Int] -> [Int] -> Int -> ([Int], [Int])
+killRecursive xs cs m = killR ([], xs, cs)
+    where
+        killR (killed, remaining, counter)
+            | length remaining <= m = (killed, remaining)
+            | otherwise =
+                let (newKilled, newRemaining, newCounter) =
+                        killList remaining counter
+                    allKilled = killed ++ newKilled
+                in  killR (allKilled, newRemaining, newCounter)
+
+main :: IO ()
+main = do
+    args <- getArgs
+    case args of
+        [n, k, m] -> print $ snd $ killRecursive (prisoners (read n))
+                        (counter (read k)) (read m)
+        _         -> print $ snd $ killRecursive (prisoners 41) (counter 3) 1

Task/Josephus-problem/Haskell/josephus-problem-2.hs

@@ -0,0 +1,16 @@
+jseq :: Int -> Int -> [Int]
+jseq n k = f n [1 .. n]
+  where
+    f 0 _ = []
+    f m s = x : f (m - 1) (right ++ left)
+      where
+        (left, x:right) = splitAt (mod (k - 1) m) s
+
+-- the final survivor is ((k + ...((k + ((k + 0)`mod` 1)) `mod` 2) ... ) `mod` n)
+jos :: Int -> Int -> Int
+jos n k = 1 + foldl (mod . (k +)) 0 [2 .. n]
+
+main :: IO ()
+main = do
+  print $ jseq 41 3
+  print $ jos 10000 100