blob: 004cbf7d2894f929c6c509194ccc79b6917789eb (
plain)
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
34
35
36
37
38
39
40
41
42
43
44
45
|
{-# LANGUAGE BangPatterns #-}
module Main where
import qualified Data.Array.Unboxed as A
import Input
lastDigit :: Int -> Int
lastDigit = abs . (`rem` 10)
type Array = A.UArray Int
prefixSums :: Array Int -> Array Int
prefixSums input = A.listArray (0, snd (A.bounds input) + 1) (scanl (+) 0 (A.elems input))
phase :: Array Int -> Array Int
phase !input =
let end = snd (A.bounds input)
prefixes = prefixSums input
rangeSum from to = prefixes A.! to - prefixes A.! from
intervalSum acc offset step sign
| offset + step > end =
if offset > end
then acc
else acc + sign * rangeSum offset (end + 1)
| otherwise =
let acc' = acc + sign * rangeSum offset (offset + step)
in intervalSum acc' (offset + 2 * step) step (negate sign)
in A.listArray (0, end) [lastDigit (intervalSum 0 (i-1) i 1) | i <- [1..end+1]]
fft :: Int -> [Int] -> [Int]
fft times list = A.elems (iterate phase (A.listArray (0, length list - 1) list) !! times)
main :: IO ()
main = do
inpString <- head <$> getInput 16
let inpList = map (read . pure) inpString
putStrLn (concatMap show (take 8 (fft 100 inpList)))
let messageOffset = read (take 7 inpString)
-- Note: Part 2 takes 3m20s for me
putStrLn (concatMap show (take 8 (drop messageOffset (fft 100 (concat (replicate 10000 inpList))))))
|
