update

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,11 @@
+jseq n k = f n [1 .. n] where
+    f 0 _ = []
+    f m s = x:f (m-1) (right ++ left) where
+        (left,x:right) = splitAt ((k-1) `mod` m) s
+
+-- the final survivor is ((k + ...((k + ((k + 0)`mod` 1)) `mod` 2) ... ) `mod` n)
+jos n k = 1 + foldl (\x->((k+x)`mod`)) 0 [2..n]
+
+main = do
+    print $ jseq 41 3
+    print $ jos 10000 100