From 01a4f6bcfc4453a3df332899388caeb9c61fe9f0 Mon Sep 17 00:00:00 2001
From: Amneesh Singh <natto@weirdnatto.in>
Date: Mon, 23 Dec 2024 22:33:46 +0530
Subject: [PATCH] day 23

Signed-off-by: Amneesh Singh <natto@weirdnatto.in>
---
 aoc2024.cabal |  6 +++++
 src/Day23.hs  | 67 +++++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 73 insertions(+)
 create mode 100644 src/Day23.hs

diff --git a/aoc2024.cabal b/aoc2024.cabal
index d09089c..6be0ef5 100644
--- a/aoc2024.cabal
+++ b/aoc2024.cabal
@@ -170,3 +170,9 @@ executable day22
   hs-source-dirs: src
   main-is:        Day22.hs
   build-depends:  containers
+
+executable day23
+  import:         common
+  hs-source-dirs: src
+  main-is:        Day23.hs
+  build-depends:  containers
diff --git a/src/Day23.hs b/src/Day23.hs
new file mode 100644
index 0000000..c0309f8
--- /dev/null
+++ b/src/Day23.hs
@@ -0,0 +1,67 @@
+module Main where
+
+import Data.Char (chr, ord)
+import qualified Data.IntMap as M
+import qualified Data.IntSet as S
+import Data.List (intercalate, mapAccumL, maximumBy)
+import Data.Ord (comparing)
+
+type Set = S.IntSet
+
+type Connections = M.IntMap Set
+
+hash :: Char -> Char -> Int
+hash a b = (ord a - ord 'a') * 26 + (ord b - ord 'a')
+
+unhash :: Int -> String
+unhash x = [chr $ x `div` 26 + ord 'a', chr $ x `mod` 26 + ord 'a']
+
+parse :: [String] -> Connections
+parse [] = M.empty
+parse ([a, b, '-', c, d] : xs) =
+  let x = hash a b
+      y = hash c d
+   in insert x y . insert y x $ parse xs
+  where
+    insert :: Int -> Int -> Connections -> Connections
+    insert x y m = case x `M.lookup` m of
+      Just s -> M.insert x (y `S.insert` s) m
+      Nothing -> M.insert x (S.singleton y) m
+
+bornKerbosch :: (Set -> Bool) -> Connections -> [Set]
+bornKerbosch terminate connections = go S.empty (M.keysSet connections) S.empty
+  where
+    go :: Set -> Set -> Set -> [Set]
+    go r p x
+      | (S.null p && S.null x) || terminate r = [r]
+      | otherwise = concat . snd . mapAccumL loop (p, x) $ S.elems p
+      where
+        loop :: (Set, Set) -> Int -> ((Set, Set), [Set])
+        loop (p', x') v =
+          let n = connections M.! v
+           in ( (v `S.delete` p', v `S.insert` x'),
+                go (v `S.insert` r) (p' `S.intersection` n) (x' `S.intersection` n)
+              )
+
+part1 :: Connections -> Int
+part1 =
+  length
+    . filter (any ((== 't') . head . unhash) . S.elems)
+    . filter ((== 3) . S.size)
+    . bornKerbosch ((== 3) . S.size)
+
+part2 :: Connections -> String
+part2 =
+  intercalate ","
+    . map unhash
+    . S.elems
+    . maximumBy (comparing S.size)
+    . bornKerbosch (const False)
+
+main :: IO ()
+main =
+  do
+    connections <- parse . words <$> readFile "./inputs/day23.in"
+
+    putStr "Part 1: " >> print (part1 connections)
+    putStr "Part 2: " >> print (part2 connections)