From 10764fdb1b8fce91551a4ce963251a40f7f11cbf Mon Sep 17 00:00:00 2001
From: germax26 <maximburykin1@gmail.com>
Date: Tue, 3 Dec 2024 13:21:05 +1100
Subject: [PATCH] 2015 Day 15 in Haskell

---
 2015/day15/day15.hs | 21 +++++++++++++++++++++
 aoc.hs              |  8 +++++++-
 2 files changed, 28 insertions(+), 1 deletion(-)
 create mode 100644 2015/day15/day15.hs

diff --git a/2015/day15/day15.hs b/2015/day15/day15.hs
new file mode 100644
index 0000000..cc33c31
--- /dev/null
+++ b/2015/day15/day15.hs
@@ -0,0 +1,21 @@
+import Aoc
+import Data.List ( transpose )
+import Data.Bifunctor ( bimap )
+
+parseLine :: String -> (String, [Int])
+parseLine line =
+    let [name, "capacity", capacity, "durability", durability, "flavor", flavor, "texture", texture, "calories", calories] = words line in
+    let read' = read . init in
+    (init name, [read calories, read' capacity, read' durability, read' flavor, read' texture])
+
+part1' :: (Int -> Bool) -> [(String, [Int])] -> Int
+part1' cond ingredients = maximum $ map (product . tail) $ filter (cond . head) $ map (map (max 0 . sum) . transpose . map (uncurry map . bimap (*) snd) . (`zip` ingredients)) $ starsAndBars 100 (length ingredients - 1)
+
+part1 :: [(String, [Int])] -> Int
+part1 = part1' $ const True
+
+part2 :: [(String, [Int])] -> Int
+part2 = part1' (==500)
+
+main :: IO ()
+main = aocMain (map parseLine) part1 part2
\ No newline at end of file
diff --git a/aoc.hs b/aoc.hs
index b030b74..01c62ad 100644
--- a/aoc.hs
+++ b/aoc.hs
@@ -50,4 +50,10 @@ permutations [] = [[]]
 permutations xs = concatMap (\n -> let (a, rest) = remove n xs in map (a:) $ permutations rest) [0..length xs-1]
 
 adjacents :: [a] -> [(a, a)]
-adjacents as = zip as $ tail as
\ No newline at end of file
+adjacents as = zip as $ tail as
+
+-- starsAndBars n b returns all lists of non-negative integers of length `b+1` where the sum is `n`
+starsAndBars :: Int -> Int -> [[Int]]
+starsAndBars 0 b = [replicate (b+1) 0]
+starsAndBars n 0 = [[n]]
+starsAndBars n b = map (0:) (starsAndBars n (b-1)) ++ map (\xs -> head xs + 1 : tail xs) (starsAndBars (n-1) b)