{-# Language QuasiQuotes #-}
{-|
Module      : Main
Description : Day 17 solution
Copyright   : (c) Eric Mertens, 2021
License     : ISC
Maintainer  : emertens@gmail.com

<https://adventofcode.com/2015/day/17>

-}
module Main where

import Advent (counts, format)

main :: IO ()
IO ()
main =
  do [Int]
input <- [format|2015 17 (%u%n)*|]
     let combos :: [Int]
combos = Int -> [Int] -> Int -> [Int] -> [Int]
combinations Int
0 [Int]
input Int
150 []
     Int -> IO ()
forall a. Show a => a -> IO ()
print ([Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
combos)
     Int -> IO ()
forall a. Show a => a -> IO ()
print ((Int -> Int -> Int) -> Int -> Map Int Int -> Int
forall a b. (a -> b -> b) -> b -> Map Int a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Int -> Int -> Int
forall a b. a -> b -> a
const Int
forall a. HasCallStack => a
undefined ([Int] -> Map Int Int
forall (f :: * -> *) a. (Foldable f, Ord a) => f a -> Map a Int
counts [Int]
combos))

-- | Given a list of container sizes and an amount,
-- return a list of the ways to chose a subset of those containers
-- so that they sum to the desired amount. The resulting list
-- is arranged by number of containers used. The nth element uses
-- n-containers (zero-indexed).
combinations :: Int -> [Int] -> Int -> [Int] -> [Int]
combinations :: Int -> [Int] -> Int -> [Int] -> [Int]
combinations Int
used [Int]
_ Int
0 = (Int
usedInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:)
combinations Int
_ [] Int
_ = [Int] -> [Int]
forall a. a -> a
id
combinations Int
used (Int
x:[Int]
xs) Int
amt =
  (if Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
amt then Int -> [Int] -> Int -> [Int] -> [Int]
combinations (Int
usedInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [Int]
xs (Int
amtInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
x) else [Int] -> [Int]
forall a. a -> a
id)
  ([Int] -> [Int]) -> ([Int] -> [Int]) -> [Int] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Int] -> Int -> [Int] -> [Int]
combinations Int
used [Int]
xs Int
amt