2015 Day 13 in Haskell

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