-
Notifications
You must be signed in to change notification settings - Fork 1
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
Showing
3 changed files
with
1,271 additions
and
0 deletions.
There are no files selected for viewing
Large diffs are not rendered by default.
Oops, something went wrong.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,57 @@ | ||
{-# Language QuasiQuotes #-} | ||
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} | ||
{-| | ||
Module : Main | ||
Description : Day 25 solution | ||
Copyright : (c) Eric Mertens, 2023 | ||
License : ISC | ||
Maintainer : emertens@gmail.com | ||
<https://adventofcode.com/2023/day/25> | ||
<https://en.wikipedia.org/wiki/Karger%27s_algorithm> | ||
-} | ||
module Main (main) where | ||
|
||
import Advent (format, ordNub) | ||
import Data.Graph.Inductive.Graph | ||
import Data.Graph.Inductive.NodeMap (mkEdges, mkNodes, new, NodeMap) | ||
import Data.Graph.Inductive.PatriciaTree (Gr) | ||
import Data.Maybe (fromJust) | ||
import System.Random (randomRIO) | ||
|
||
main :: IO () | ||
main = | ||
do input <- [format|2023 25 (%s:( %s)*%n)*|] | ||
let nodeMap :: NodeMap String | ||
(ns, nodeMap) = mkNodes new (ordNub [n | (k,vs) <- input, n <- k:vs ]) | ||
let g :: Gr Int () | ||
g = mkGraph [(n,1) | (n,_) <- ns] | ||
(fromJust $ mkEdges nodeMap | ||
[(k,v,()) | ||
| (k,vs) <- input | ||
, v <- vs | ||
]) | ||
|
||
let loop = | ||
do g' <- contract (+) g | ||
if length (edges g') == 3 then | ||
print (product [sz | (_, sz) <- labNodes g']) | ||
else putStrLn "retry" >> loop | ||
loop | ||
|
||
contract :: (a -> a -> a) -> Gr a b -> IO (Gr a b) | ||
contract f g | ||
| noNodes g <= 2 = pure g | ||
| otherwise = | ||
do let es = edges g | ||
n = length es | ||
i <- randomRIO (0, n-1) | ||
let (l,r) = es !! i -- pick a random edge to contract | ||
g1 = delEdge (r,l) (delEdge (l,r) g) | ||
nei = lneighbors g1 l ++ lneighbors g1 r | ||
Just sza = lab g l | ||
Just szb = lab g r | ||
g2 = insNode (l, f sza szb) (delNodes [l,r] g1) | ||
contract f (insEdges [(bb,l,aa) | (aa,bb) <- nei] g2) |