-- |
-- Module      : AOC.Challenge.Day09
-- License     : BSD3
--
-- Stability   : experimental
-- Portability : non-portable
--
-- Day 9.  See "AOC.Solver" for the types used in this module!

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)
    }

-- an implementation using a priority search queue, which should have
-- efficient lookup and popping. but unfortunately it has too much overhead
-- to offer any overall advantage

-- isBad2 :: IntPSQ Int () -> Maybe Int
-- isBad2 q = do
--     (goal, _, _, xs) <- IntPSQ.minView q
--     let badCheck = null do
--           (x,_,_) <- IntPSQ.toList xs
--           let y = goal - x
--           guard $ y > x
--           guard $ y `IntPSQ.member` xs
--     goal <$ guard badCheck

-- oddOneOut2 :: Int -> [Int] -> Maybe Int
-- oddOneOut2 w = firstJust isBad2
--              . reverse
--              . sortedSlidingWindowsInt (w + 1)
--              . reverse
--              . map (,())