From e689580094e12993d44996e6b9d933155e735e27 Mon Sep 17 00:00:00 2001 From: tomsmeding Date: Wed, 18 Dec 2019 21:52:25 +0100 Subject: Day 16 (lazy slow solution) --- 2019/16.hs | 45 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 45 insertions(+) create mode 100644 2019/16.hs (limited to '2019/16.hs') 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)))))) -- cgit v1.2.3-54-g00ecf