finished Day 17 part1

- part 2 crashes the computer

1 files changed, 28 insertions, 0 deletions

diff --git a/Puzzle17.hs b/Puzzle17.hs
new file mode 100644
index 0000000..ff2d0d7
--- /dev/null
+++ b/Puzzle17.hs
@@ -0,0 +1,28 @@
+insert :: Int -> Int -> [Int] -> [Int]
+insert k x xs = let (ys, zs) = splitAt k xs in ys ++ (x:zs)
+
+step :: Int -> ([Int], Int, Int) -> ([Int], Int, Int)
+step n (xs, pos, l) = let newpos = (pos + n) `rem` l + 1 in (insert newpos l xs, newpos, l + 1)
+
+step' :: Int -> (Int, Int, Int) -> (Int, Int, Int)
+step' n (x, pos, l) = let newpos = (pos + n) `rem` l + 1 in 
+  (if newpos == 1 then l else x, newpos, l + 1)
+
+f :: Int -> Int -> ([Int], Int, Int)
+f n m = foldl1 (.) (replicate m (step n)) ([0], 0, 1)
+
+f' :: Int -> Int -> (Int, Int, Int)
+f' n m = foldl1 (.) (replicate m (step' n)) (-1, 0, 1)
+
+solve1 :: Int -> Int
+solve1 n = let (xs, pos, l) = f n 2017 in xs !! (pos + 1)
+
+solve2 :: Int -> Int
+solve2 n = let (x, pos, l) = f' n 50000000 in x
+
+input0 :: Int
+input0 = 3
+input :: Int
+input = 354
+
+main = (putStrLn . show . solve2) input