From abfe80e58fdb6659234d2b68c6ab0b9245868604 Mon Sep 17 00:00:00 2001
From: germax26 <maximburykin1@gmail.com>
Date: Tue, 3 Dec 2024 11:18:01 +1100
Subject: [PATCH] 2015 Day 13 in Haskell

---
 2015/day13/day13.hs | 32 ++++++++++++++++++++++++++++++++
 1 file changed, 32 insertions(+)
 create mode 100644 2015/day13/day13.hs

diff --git a/2015/day13/day13.hs b/2015/day13/day13.hs
new file mode 100644
index 0000000..36389c7
--- /dev/null
+++ b/2015/day13/day13.hs
@@ -0,0 +1,32 @@
+import Aoc
+import Data.List.Split ( splitOn )
+import Data.List ( nub )
+import Data.Tuple ( swap )
+import Data.Maybe ( fromJust )
+
+type Pref = ((String, String), Int)
+
+parseLine :: String -> Pref
+parseLine line =
+    let [a, "would", verb, points, "happiness", "units", "by", "sitting", "next", "to", b] = words line in
+    let [b', ""] = splitOn "." b in
+    let sign = case verb of { "lose" -> -1; "gain" -> 1 } in
+    ((a, b'), sign * read points)
+
+process :: [Pref] -> ([String], [Pref])
+process prefs = (people, prefs)
+    where people = nub $ concatMap (unpair . fst) prefs
+
+scoreLookup :: [Pref] -> (String, String) -> Int
+scoreLookup prefs pair = fromJust (lookup pair prefs) + fromJust (lookup (swap pair) prefs)
+
+part1 :: ([String], [Pref]) -> Int
+part1 (people, prefs) = maximum $ map (sum . map (scoreLookup prefs) . adjacents . (first:).(++[first])) $ permutations $ tail people
+    where first = head people
+
+-- it's probably more efficient to actually go through the list of prefs to find the one that is decreasing the score the most for each permutation, rather than just doing part1 again with another person, but it is fast enough for me to not bother.
+part2 :: ([String], [Pref]) -> Int
+part2 (people, prefs) = part1 ("":people, concatMap (\p -> [(("", p), 0), ((p, ""), 0)]) people ++ prefs)
+
+main :: IO ()
+main = aocMain (process . map parseLine) part1 part2
\ No newline at end of file