1 files changed, 32 insertions, 0 deletions
diff --git a/2017/6.hs b/2017/6.hs
new file mode 100644
index 0000000..d4390ab
--- /dev/null
+++ b/2017/6.hs
@@ -0,0 +1,32 @@
+import Control.Monad
+import Data.List
+import qualified Data.Map.Strict as Map
+
+
+modifyAt :: Show a => Int -> (a -> a) -> [a] -> [a]
+modifyAt i f l =
+    let (pre, v : post) = splitAt i l
+    in pre ++ f v : post
+
+redistribute :: [Int] -> [Int]
+redistribute blocks =
+    let Just idx = findIndex (== maximum blocks) blocks
+        amt = blocks !! idx
+        len = length blocks
+        spread _ 0 b = b
+        spread i a b = spread (succ i `mod` len) (pred a) (modifyAt i succ b)
+    in spread (succ idx `mod` len) amt (modifyAt idx (const 0) blocks)
+
+cycledetect :: [Int] -> (Int, Int)
+cycledetect blocks = go Map.empty 0 blocks
+  where
+    go mp idx bl = case Map.lookup bl mp of
+        Nothing -> go (Map.insert bl idx mp) (succ idx) (redistribute bl)
+        Just i -> (idx, idx - i)
+
+main :: IO ()
+main = do
+    blocks <- liftM (map read . words) (readFile "6.in")
+    let (q1, q2) = cycledetect blocks
+    print q1
+    print q2