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

module AOC.Challenge.Day01 (
    day01a
  , day01b
  , knapsack
  ) where

import           AOC.Common       (firstJust)
import           AOC.Solver       ((:~>)(..))
import           Data.IntSet      (IntSet)
import           Data.Type.Nat    (Nat(..), Nat1, Nat2, SNat(..), SNatI(..), snat)
import           Text.Read        (readMaybe)
import qualified Data.IntSet      as IS
import qualified Data.Vec.Lazy    as Vec

-- | Given a goal sum and a set of numbers to pick from, finds the @n@
-- numbers in the set that add to the goal sum.  The number of items
-- desired is inferred from the desired length of the return type.
knapsack
    :: forall n. SNatI n
    => Int                             -- ^ goal sum
    -> IntSet                          -- ^ set of options
    -> Maybe (Vec.Vec ('S n) Int)      -- ^ resulting n items that sum to the goal
knapsack :: forall (n :: Nat).
SNatI n =>
Int -> IntSet -> Maybe (Vec ('S n) Int)
knapsack = case SNat n
forall (n :: Nat). SNatI n => SNat n
snat :: SNat n of
    SNat n
SZ -> \Int
goal IntSet
xs ->
      if Int
goal Int -> IntSet -> Bool
`IS.member` IntSet
xs
        then Vec ('S 'Z) Int -> Maybe (Vec ('S 'Z) Int)
forall a. a -> Maybe a
Just (Vec ('S 'Z) Int -> Maybe (Vec ('S 'Z) Int))
-> Vec ('S 'Z) Int -> Maybe (Vec ('S 'Z) Int)
forall a b. (a -> b) -> a -> b
$ Int -> Vec ('S 'Z) Int
forall a. a -> Vec ('S 'Z) a
Vec.singleton Int
goal
        else Maybe (Vec ('S n) Int)
forall a. Maybe a
Nothing
    SNat n
SS -> \Int
goal IntSet
xs -> ((Int -> Maybe (Vec ('S ('S n1)) Int))
 -> [Int] -> Maybe (Vec ('S ('S n1)) Int))
-> [Int]
-> (Int -> Maybe (Vec ('S ('S n1)) Int))
-> Maybe (Vec ('S ('S n1)) Int)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Int -> Maybe (Vec ('S ('S n1)) Int))
-> [Int] -> Maybe (Vec ('S ('S n1)) Int)
forall (t :: * -> *) a b.
Foldable t =>
(a -> Maybe b) -> t a -> Maybe b
firstJust (IntSet -> [Int]
IS.toList IntSet
xs) ((Int -> Maybe (Vec ('S ('S n1)) Int))
 -> Maybe (Vec ('S ('S n1)) Int))
-> (Int -> Maybe (Vec ('S ('S n1)) Int))
-> Maybe (Vec ('S ('S n1)) Int)
forall a b. (a -> b) -> a -> b
$ \Int
x ->
      let goal' :: Int
goal'   = Int
goal Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
x
          (IntSet
_, IntSet
ys) = Int -> IntSet -> (IntSet, IntSet)
IS.split Int
x IntSet
xs
      in  (Int
x Int -> Vec ('S n1) Int -> Vec ('S ('S n1)) Int
forall a (n1 :: Nat). a -> Vec n1 a -> Vec ('S n1) a
Vec.:::) (Vec ('S n1) Int -> Vec ('S ('S n1)) Int)
-> Maybe (Vec ('S n1) Int) -> Maybe (Vec ('S ('S n1)) Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> IntSet -> Maybe (Vec ('S n1) Int)
forall (n :: Nat).
SNatI n =>
Int -> IntSet -> Maybe (Vec ('S n) Int)
knapsack Int
goal' IntSet
ys

day01a :: [Int] :~> Int
day01a :: [Int] :~> Int
day01a = 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 = (Vec ('S ('S 'Z)) Int -> Int)
-> Maybe (Vec ('S ('S 'Z)) Int) -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Vec ('S ('S 'Z)) Int -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product (Maybe (Vec ('S ('S 'Z)) Int) -> Maybe Int)
-> ([Int] -> Maybe (Vec ('S ('S 'Z)) Int)) -> [Int] -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (n :: Nat).
SNatI n =>
Int -> IntSet -> Maybe (Vec ('S n) Int)
knapsack @Nat1 Int
2020 (IntSet -> Maybe (Vec ('S ('S 'Z)) Int))
-> ([Int] -> IntSet) -> [Int] -> Maybe (Vec ('S ('S 'Z)) Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> IntSet
IS.fromList
    }

day01b :: [Int] :~> Int
day01b :: [Int] :~> Int
day01b = 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 = (Vec ('S ('S ('S 'Z))) Int -> Int)
-> Maybe (Vec ('S ('S ('S 'Z))) Int) -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Vec ('S ('S ('S 'Z))) Int -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product (Maybe (Vec ('S ('S ('S 'Z))) Int) -> Maybe Int)
-> ([Int] -> Maybe (Vec ('S ('S ('S 'Z))) Int))
-> [Int]
-> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (n :: Nat).
SNatI n =>
Int -> IntSet -> Maybe (Vec ('S n) Int)
knapsack @Nat2 Int
2020 (IntSet -> Maybe (Vec ('S ('S ('S 'Z))) Int))
-> ([Int] -> IntSet) -> [Int] -> Maybe (Vec ('S ('S ('S 'Z))) Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> IntSet
IS.fromList
    }