diff --git a/README.md b/README.md index 26e8eb7..41e7df6 100644 --- a/README.md +++ b/README.md @@ -2,8 +2,8 @@ |Day|Stars|Day|Stars| |---|-----|---|-----| -|01 |★ ★ |07 | | -|02 |★ ★ |08 | | +|01 |★ ★ |07 |★ | +|02 |★ ★ |08 |★ | |03 |★ ★ |09 | | |04 |★ ★ |10 | | |05 |★ ★ |11 | | diff --git a/adventofcode2025.cabal b/adventofcode2025.cabal index eb5756f..0bef9e9 100644 --- a/adventofcode2025.cabal +++ b/adventofcode2025.cabal @@ -38,3 +38,4 @@ executable adventofcode2025 Day05 Day06 Day07 + Day08 diff --git a/src/Day08.hs b/src/Day08.hs new file mode 100644 index 0000000..52aec0c --- /dev/null +++ b/src/Day08.hs @@ -0,0 +1,63 @@ +{-# OPTIONS_GHC -Wno-incomplete-patterns #-} + +module Day08 + ( day08_1, + ) +where + +import Data.Function (on) +import Data.List (find, nubBy, sortBy, (\\)) +import Data.List.Split (splitOn) +import Data.Maybe (fromJust) +import Data.Ord + +type Point = (Int, Int, Int) + +readPoint :: [String] -> Point +readPoint (x : y : z : _) = (read x, read y, read z) + +distance :: Point -> Point -> Float +distance (x1, y1, z1) (x2, y2, z2) = + sqrt $ + (fromIntegral x2 - fromIntegral x1) ** 2 + + (fromIntegral y2 - fromIntegral y1) ** 2 + + (fromIntegral z2 - fromIntegral z1) ** 2 + +getSortedDistances :: [Point] -> [(Point, Point, Float)] +getSortedDistances points = nubBy same $ sortBy (compare `on` trd) [(x, y, distance x y) | x <- points, y <- points, x /= y] + where + trd (_, _, d) = d + same (x, y, _) (w, z, _) = x == z && y == w + +contains :: [Point] -> Point -> Bool +contains circuits point = point `elem` circuits + +mergeCircuits :: Point -> Point -> [[Point]] -> [[Point]] +mergeCircuits x y circuits = + let c1 = fromJust $ find (`contains` x) circuits + c2 = fromJust $ find (`contains` y) circuits + in if c1 == c2 + then circuits + else ((circuits \\ [c1]) \\ [c2]) ++ [c1 ++ c2] + +buildCircuits :: [(Point, Point, Float)] -> [[Point]] -> Int -> [[Point]] +buildCircuits [] circuits _ = circuits +buildCircuits _ circuits 0 = circuits +buildCircuits ((x, y, _) : xs) circuits n = buildCircuits xs (mergeCircuits x y circuits) (n - 1) + +parseInput :: IO [Point] +parseInput = do + input <- lines <$> readFile "input/day8.txt" + let points = map (readPoint . splitOn ",") input + return points + +day08_1 :: IO () +day08_1 = do + points <- parseInput + let distances = getSortedDistances points + points' = map (: []) points + circuits = buildCircuits distances points' 1000 + result = product . take 3 . sortBy (comparing Down) $ map length circuits + putStrLn $ + "Day 8, Puzzle 1 solution: " + ++ show result diff --git a/src/Main.hs b/src/Main.hs index ae2b0df..0d50156 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -7,6 +7,7 @@ import Day04 (day04_1, day04_2) import Day05 (day05_1, day05_2) import Day06 (day06_1, day06_2) import Day07 (day07_1) +import Day08 (day08_1) import System.Environment (getArgs) main :: IO () @@ -46,6 +47,9 @@ main = do "7" : "1" : _ -> day07_1 "7" : _ -> do day07_1 + "8" : "1" : _ -> day08_1 + "8" : _ -> do + day08_1 "all" : _ -> do day01_1 day01_2 @@ -60,4 +64,5 @@ main = do day06_1 day06_2 day07_1 + day08_1 _ -> error "Not implemented"