{- Copyright (C) 2017 Yuchen Pei. This program is free software: you can redistribute it and/or modify it under the terms of the GNU Affero General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU Affero General Public License along with this program. If not, see . -} -- 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