Done day 23

diff --git a/advent23/Main.hs b/advent23/Main.hs
new file mode 100644 (file)
index 0000000..8287d07
--- /dev/null
+++ b/advent23/Main.hs
@@ -0,0 +1,101 @@
+-- Writeup at https://work.njae.me.uk/2024/12/24/advent-of-code-2024-day-22/
+import AoC
+
+import Data.Text (Text)
+import qualified Data.Text.IO as TIO
+import Data.Attoparsec.Text hiding (take)
+-- import Control.Applicative
+import qualified Data.Map.Strict as M
+import qualified Data.Set as S
+import Combinatorics
+import Data.List
+import Data.Function (on)
+
+data Edge = Edge String String
+  deriving (Show, Eq, Ord)
+
+type Vertex = String
+type Vertices = S.Set Vertex
+type Graph = M.Map Vertex Vertices
+type Clique = [Vertex]
+
+
+main :: IO ()
+main = 
+  do  dataFileName <- getDataFileName
+      text <- TIO.readFile dataFileName
+      let edges = successfulParse text
+      -- print edges
+      let graph = mkGraph edges
+      -- print graph
+      print $ part1 graph
+      -- print $ getMaximalCliques graph
+      putStrLn $ part2 graph
+      
+
+      -- print $ part1 codes
+      -- print $ part2 codes
+
+-- part1, part2 :: [Int] -> Int
+-- part1 codes = sum $ fmap (followingSecret 2000) codes
+
+-- part1 :: Graph -> Int
+part1 graph = length $ filter couldBeHistorian $ find3Cliques graph
+-- part1 graph = find3Cliques graph
+part2 graph = intercalate "," $ sort maxClique
+  where maxClique = maximumBy (compare `on` length) $ getMaximalCliques graph
+
+
+find3Cliques :: Graph -> [[Vertex]]
+find3Cliques graph = filter isClique possibles
+  where possibles = tuples 3 $ M.keys graph
+        isClique [a,b,c] = b `S.member` (graph M.! a) && c `S.member` (graph M.! a) && c `S.member` (graph M.! b)
+        isClique _ = False
+
+couldBeHistorian :: [Vertex] -> Bool
+couldBeHistorian cliques = any ((== 't') . head) cliques
+
+
+-- Implementation from https://www.cs.columbia.edu/~sedwards/classes/2023/4995-fall/reports/MaximalClique-report.pdf
+
+getMaximalCliques :: Graph -> [Clique]
+getMaximalCliques graph = bronKerbosch graph [] (M.keys graph) [] 
+
+bronKerbosch :: Graph -> Clique -> [Vertex] -> [Vertex] -> [Clique]
+bronKerbosch graph partialClique candidateVertices excludedVertices
+  | null candidateVertices && null excludedVertices = [ partialClique ]
+  | otherwise = exploreCandidates graph partialClique candidateVertices excludedVertices
+
+exploreCandidates :: Graph -> Clique -> [Vertex] -> [Vertex] -> [Clique]
+exploreCandidates _ _ [] _ = []
+exploreCandidates graph partialClique (currentVertex : remainingCandidates) currentExcluded =
+  bronKerbosch graph 
+                (currentVertex : partialClique)
+                (restrictVertices graph remainingCandidates currentVertex)
+                (restrictVertices graph currentExcluded currentVertex) ++
+  exploreCandidates graph partialClique remainingCandidates ( currentVertex : currentExcluded)
+
+restrictVertices :: Graph -> [Vertex] -> Vertex -> [Vertex]
+restrictVertices graph curvertices vertex = filter ( isConnected graph vertex ) curvertices
+
+isConnected :: Graph -> Vertex -> Vertex -> Bool
+isConnected graph a b = b `S.member` (graph M.! a)
+
+
+mkGraph :: [Edge] -> Graph
+mkGraph edges = M.fromListWith S.union $ fmap (\(Edge a b) -> (a, S.singleton b)) biEdges
+  where biEdges = edges ++ fmap (\(Edge a b) -> Edge b a) edges
+
+-- parse the input file
+
+edgesP :: Parser [Edge]
+edgeP :: Parser Edge
+
+edgesP = edgeP `sepBy` endOfLine
+edgeP = Edge <$> (many1 letter) <* string "-" <*> (many1 letter)
+
+successfulParse :: Text -> [Edge]
+successfulParse input = 
+  case parseOnly edgesP input of
+    Left  _err -> [] -- TIO.putStr $ T.pack $ parseErrorPretty err
+    Right edges -> edges

diff --git a/adventofcode24.cabal b/adventofcode24.cabal
index 35c9ac6ce790502d7b40ac4d0177d9d15f5605c9..0d0bc3218d23d52dfb50a4e606e8d94003a5768f 100644 (file)
--- a/adventofcode24.cabal
+++ b/adventofcode24.cabal
@@ -212,4 +212,9 @@ executable advent22
 executable advent22bf
   import: warnings, common-extensions, build-directives, common-modules
   main-is: advent22/MainBruteForce.hs
-  build-depends: split  
\ No newline at end of file
+  build-depends: split  
+
+executable advent23
+  import: warnings, common-extensions, build-directives, common-modules
+  main-is: advent23/Main.hs
+  build-depends: attoparsec, text, containers, combinatorial