diff --git a/hs/src/Aoc/Y2020/D09.hs b/hs/src/Aoc/Y2020/D09.hs index 2ac0ee8..e6f97ca 100644 --- a/hs/src/Aoc/Y2020/D09.hs +++ b/hs/src/Aoc/Y2020/D09.hs @@ -1,9 +1,15 @@ +{-# LANGUAGE RecordWildCards #-} + module Aoc.Y2020.D09 ( day ) where import Control.Monad +import Data.Foldable import Data.List +import Data.Maybe + +import qualified Data.Sequence as Seq import Aoc.Day import Aoc.Parse @@ -25,15 +31,31 @@ isValid nums n = not $ null $ do guard $ a + b == n pure () --- Fast enough to give me a result, but not linear time. I couldn't figure out a --- way to implement the linear time algorithm that didn't look like a mess. --- Maybe I'll have another go for the cleanup. -findRange :: Int -> [Int] -> [Int] -findRange n - = head - . filter ((== n) . sum) - . map (head . dropWhile ((< n) . sum) . inits) - . tails +data State = State + { sTarget :: Int + , sSeq :: Seq.Seq Int + , sSum :: Int + , sRest :: [Int] + } deriving (Show) + +newState :: Int -> [Int] -> State +newState target = State target Seq.empty 0 + +step :: State -> Either (Maybe [Int]) State +step s@State{..} = case compare sSum sTarget of + EQ -> Left $ Just $ toList sSeq + GT -> case Seq.viewl sSeq of + Seq.EmptyL -> Left Nothing -- Should only happen if sTarget is negative + l Seq.:< ls -> Right s{ sSeq = ls, sSum = sSum - l } + LT -> case sRest of + [] -> Left Nothing -- Can happen if no sequence of correct sum is found + (r:rs) -> Right s{ sSeq = sSeq Seq.|> r, sSum = sSum + r, sRest = rs } + +untilLeft :: (b -> Either a b) -> b -> a +untilLeft f a = either id (untilLeft f) $ f a + +findRange :: Int -> [Int] -> Maybe [Int] +findRange target nums = untilLeft step $ newState target nums solver :: [Int] -> IO () solver nums = do @@ -43,7 +65,7 @@ solver nums = do putStrLn "" putStrLn ">> Part 2" - let weakness = findRange invalidN nums + let weakness = fromJust $ findRange invalidN nums print $ minimum weakness + maximum weakness day :: Day