module AOC.Challenge.Day09 (
day09a
, day09b
) where
import AOC.Common (slidingWindows, firstJust)
import AOC.Solver ((:~>)(..), dyno_)
import Control.Monad (guard)
import Data.Foldable (toList)
import Data.List (scanl', tails)
import Data.Sequence (Seq(..))
import Text.Read (readMaybe)
import qualified Data.Vector as V
isBad :: Seq Int -> Maybe Int
isBad :: Seq Int -> Maybe Int
isBad Seq Int
xs0 = do
(Seq Int
xs :|> Int
x) <- Seq Int -> Maybe (Seq Int)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Seq Int
xs0
let badCheck :: Bool
badCheck = [()] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null do
Int
y:[Int]
ys <- [Int] -> [[Int]]
forall a. [a] -> [[a]]
tails (Seq Int -> [Int]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq Int
xs)
Int
z <- [Int]
ys
Bool -> [()]
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> [()]) -> Bool -> [()]
forall a b. (a -> b) -> a -> b
$ (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
z) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
x
Int
x Int -> Maybe () -> Maybe Int
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard Bool
badCheck
oddOneOut :: Int -> [Int] -> Maybe Int
oddOneOut :: Int -> [Int] -> Maybe Int
oddOneOut Int
w = (Seq Int -> Maybe Int) -> [Seq Int] -> Maybe Int
forall (t :: * -> *) a b.
Foldable t =>
(a -> Maybe b) -> t a -> Maybe b
firstJust Seq Int -> Maybe Int
isBad ([Seq Int] -> Maybe Int)
-> ([Int] -> [Seq Int]) -> [Int] -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Int] -> [Seq Int]
forall a. Int -> [a] -> [Seq a]
slidingWindows (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
day09a :: [Int] :~> Int
day09a :: [Int] :~> Int
day09a = MkSol :: forall a b.
(String -> Maybe a)
-> ((?dyno::DynoMap) => a -> Maybe b) -> (b -> String) -> a :~> b
MkSol
{ sParse :: String -> Maybe [Int]
sParse = (String -> Maybe Int) -> [String] -> Maybe [Int]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe ([String] -> Maybe [Int])
-> (String -> [String]) -> String -> Maybe [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines
, sShow :: Int -> String
sShow = Int -> String
forall a. Show a => a -> String
show
, sSolve :: (?dyno::DynoMap) => [Int] -> Maybe Int
sSolve = Int -> [Int] -> Maybe Int
oddOneOut (String -> Int -> Int
forall a. (Typeable a, ?dyno::DynoMap) => String -> a -> a
dyno_ String
"window" Int
25)
}
findBounds :: V.Vector Int -> Int -> Maybe (Int, Int)
findBounds :: Vector Int -> Int -> Maybe (Int, Int)
findBounds Vector Int
ns Int
goal = Int -> Int -> Maybe (Int, Int)
go Int
0 Int
1
where
go :: Int -> Int -> Maybe (Int, Int)
go !Int
i !Int
j = do
Int
x <- Vector Int
ns Vector Int -> Int -> Maybe Int
forall a. Vector a -> Int -> Maybe a
V.!? Int
i
Int
y <- Vector Int
ns Vector Int -> Int -> Maybe Int
forall a. Vector a -> Int -> Maybe a
V.!? Int
j
case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
x) Int
goal of
Ordering
LT -> Int -> Int -> Maybe (Int, Int)
go Int
i (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
Ordering
EQ -> (Int, Int) -> Maybe (Int, Int)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
i, Int
j)
Ordering
GT -> Int -> Int -> Maybe (Int, Int)
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
j
day09b :: [Int] :~> (Int, Int)
day09b :: [Int] :~> (Int, Int)
day09b = MkSol :: forall a b.
(String -> Maybe a)
-> ((?dyno::DynoMap) => a -> Maybe b) -> (b -> String) -> a :~> b
MkSol
{ sParse :: String -> Maybe [Int]
sParse = (String -> Maybe Int) -> [String] -> Maybe [Int]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe ([String] -> Maybe [Int])
-> (String -> [String]) -> String -> Maybe [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines
, sShow :: (Int, Int) -> String
sShow = \(Int
x,Int
y) -> Int -> String
forall a. Show a => a -> String
show (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
y)
, sSolve :: (?dyno::DynoMap) => [Int] -> Maybe (Int, Int)
sSolve = \[Int]
ns -> do
Int
goal <- Int -> [Int] -> Maybe Int
oddOneOut (String -> Int -> Int
forall a. (Typeable a, ?dyno::DynoMap) => String -> a -> a
dyno_ String
"window" Int
25) [Int]
ns
let cumsum :: Vector Int
cumsum = [Int] -> Vector Int
forall a. [a] -> Vector a
V.fromList ((Int -> Int -> Int) -> Int -> [Int] -> [Int]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl' Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) Int
0 [Int]
ns)
(Int
i, Int
j) <- Vector Int -> Int -> Maybe (Int, Int)
findBounds Vector Int
cumsum Int
goal
let xs :: [Int]
xs = Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i) ([Int] -> [Int]) -> ([Int] -> [Int]) -> [Int] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
drop Int
i ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ [Int]
ns
(Int, Int) -> Maybe (Int, Int)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [Int]
xs, [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Int]
xs)
}