diff options
Diffstat (limited to '2019/16.hs')
-rw-r--r-- | 2019/16.hs | 45 |
1 files changed, 45 insertions, 0 deletions
diff --git a/2019/16.hs b/2019/16.hs new file mode 100644 index 0000000..004cbf7 --- /dev/null +++ b/2019/16.hs @@ -0,0 +1,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)))))) |