1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
|
-- Acknowledgement: Thanks to Bob Grudem for helping solve part 2 of the puzzle.
{-# LANGUAGE BangPatterns #-}
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) -> (Int, Int, Int)
f' n 0 acc = acc
f' n m !acc = f' n (m - 1) (step' n acc)
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 (-1, 0, 1) in x
input0 :: Int
input0 = 3
input :: Int
input = 354
main = (putStrLn . show . solve2) input
|
