Add Day 8, Puzzle 1 solution

README.md

@@ -2,8 +2,8 @@
 
 |Day|Stars|Day|Stars|
 |---|-----|---|-----|
-|01 |★ ★  |07 |     |
+|01 |★ ★  |07 |★    |
-|02 |★ ★  |08 |     |
+|02 |★ ★  |08 |★    |
 |03 |★ ★  |09 |     |
 |04 |★ ★  |10 |     |
 |05 |★ ★  |11 |     |

adventofcode2025.cabal

@@ -38,3 +38,4 @@ executable adventofcode2025
     Day05
     Day06
     Day07
+    Day08

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

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"