Steve Dunham
3ec2f90770
- parse types in let (everything but parser was there) - add sugar for `data` - move `joinBy` to prelude - fix highlighting for char in vscode - better errors for missing imports
92 lines
2.7 KiB
Agda
92 lines
2.7 KiB
Agda
module Day23
|
||
|
||
import Prelude
|
||
import Node
|
||
import Aoc
|
||
import SortedMap
|
||
|
||
Graph Edge EdgeSet VSet : U
|
||
Graph = SortedMap String (List String)
|
||
Edge = String × String
|
||
EdgeSet = SortedMap Edge Unit
|
||
VSet = SortedMap String Unit
|
||
|
||
addEdge : Graph -> String × String -> Graph
|
||
addEdge g (a,b) = updateMap a (b :: fromMaybe Nil (snd <$> lookupMap a g)) g
|
||
|
||
ppair : String → Maybe Edge
|
||
ppair s = case split s "-" of
|
||
(a :: b :: Nil) => Just (a, b)
|
||
_ => Nothing
|
||
|
||
pfile : String → Maybe (List Edge)
|
||
pfile text = traverse ppair $ split (trim text) "\n"
|
||
|
||
startT : String → Bool
|
||
startT s = case unpack s of
|
||
('t' :: _) => True
|
||
_ => False
|
||
|
||
isJust : ∀ a. Maybe a → Bool
|
||
isJust (Just x) = True
|
||
isJust _ = False
|
||
|
||
checkK3 : Graph → EdgeSet → Edge → Int
|
||
checkK3 g es (a,b) =
|
||
let cand = fromMaybe Nil $ snd <$> lookupMap b g
|
||
cand = if startT a || startT b then cand else filter startT cand
|
||
in cast $ length $ filter (\c => isJust $ lookupMap (c,a) es) cand
|
||
|
||
isect : List String → List String → List String
|
||
isect as bs = filter (flip elem bs) as
|
||
|
||
remove : String → List String → List String
|
||
remove s Nil = Nil
|
||
remove s (x :: xs) = if x == s then xs else x :: remove s xs
|
||
|
||
bronKerbosch : Graph → List String → List String → List String → Maybe (List String)
|
||
bronKerbosch g rs Nil Nil = Just rs
|
||
bronKerbosch g rs Nil xs = Nothing
|
||
bronKerbosch g rs (p :: ps) xs =
|
||
let np = neighbors p
|
||
ps' = p :: filter (\x => not (elem x np)) ps in
|
||
foldl best Nothing $ map check ps'
|
||
where
|
||
neighbors : String → List String
|
||
neighbors p = fromMaybe Nil $ snd <$> lookupMap p g
|
||
|
||
check : String → Maybe (List String)
|
||
check p = let nv = neighbors p in
|
||
bronKerbosch g (p :: rs) (isect ps nv) (isect xs nv)
|
||
|
||
best : Maybe (List String) → Maybe (List String) → Maybe (List String)
|
||
best Nothing Nothing = Nothing
|
||
best Nothing a = a
|
||
best a Nothing = a
|
||
best (Just a) (Just b) = if length a < length b then Just b else Just a
|
||
|
||
run : String -> IO Unit
|
||
run fn = do
|
||
putStrLn fn
|
||
text <- readFile fn
|
||
let (Just pairs) = pfile text | _ => putStrLn "parse error"
|
||
let dpairs = pairs ++ map swap pairs
|
||
let g = foldl addEdge EmptyMap dpairs
|
||
let es = foldl (\g e => updateMap e MkUnit g) EmptyMap dpairs
|
||
putStrLn $ show (length pairs) ++ " pairs"
|
||
putStrLn $ show (length dpairs) ++ " dpairs"
|
||
|
||
-- one direction, counting each K3 3 times
|
||
let p1 = (foldl _+_ 0 $ map (checkK3 g es) pairs) / 3
|
||
putStrLn $ "part1 " ++ show p1
|
||
let verts = map fst $ toList g
|
||
let (Just result) = bronKerbosch g Nil verts Nil | _ => putStrLn "fail"
|
||
let p2 = joinBy "," $ qsort _<_ result
|
||
|
||
putStrLn $ "part2 " ++ p2
|
||
|
||
main : IO Unit
|
||
main = do
|
||
run "aoc2024/day23/eg.txt"
|
||
run "aoc2024/day23/input.txt"
|