README.md

@@ -1,10 +1,10 @@
 # Advent of Code 2024
-I started learning Haskell very recently, and I just learned this year that [Advent of Code](https://adventofcode.com 'Advent of Code website') is a thing, so I used AoC to practice Haskell. I got 38 out of 50 stars, which is more than I though I could get, so I'm quite satisfied. Solutions are not optimal, but most of them run in less than a second, while there are a few that take longer than a minute.
+I started learning Haskell very recently, and I just learned this year that Advent of Code is a thing, so I'm using this to practice. I won't be able to solve all problems, but let's see how far I can get.
 
 |Day|Stars|Day|Stars|Day|Stars|Day|Stars|Day|Stars|
 |---|-----|---|-----|---|-----|---|-----|---|-----|
-|01 |★ ★  |06 |★ ★  |11 |★ ★  |16 |★    |21 |     |
+|01 |★ ★  |06 |★ ★  |11 |★ ★  |16 |     |21 |     |
 |02 |★ ★  |07 |★ ★  |12 |★    |17 |★ ★  |22 |★    |
-|03 |★ ★  |08 |★ ★  |13 |★ ★  |18 |★ ★  |23 |★    |
+|03 |★ ★  |08 |★ ★  |13 |★ ★  |18 |★ ★  |23 |     |
-|04 |★ ★  |09 |★ ★  |14 |★ ★  |19 |★    |24 |★    |
+|04 |★ ★  |09 |★ ★  |14 |★ ★  |19 |★    |24 |     |
-|05 |★ ★  |10 |★ ★  |15 |★    |20 |     |25 |★    |
+|05 |★ ★  |10 |★ ★  |15 |★    |20 |     |25 |     |

adventofcode2024.cabal

@@ -53,12 +53,8 @@ executable adventofcode2024
     Day13
     Day14
     Day15
-    Day16
     Day17
     Day18
     Day19
     Day22
-    Day23
-    Day24
-    Day25
     Graph

src/Day01.hs

@@ -1,4 +1,4 @@
-{-# OPTIONS_GHC -Wno-incomplete-uni-patterns -Wno-x-partial #-}
+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
 
 module Day01
   ( day01_1,
@@ -6,14 +6,15 @@ module Day01
   )
 where
 
-import Data.List (group, sort, transpose)
+import Data.List (group, sort, transpose, uncons)
+import Data.Maybe (fromJust)
 
 listDistance :: [Int] -> [Int] -> Int
 listDistance xs ys = sum $ map abs $ zipWith (-) (sort xs) (sort ys)
 
 similarityScore :: [Int] -> [Int] -> Int
 similarityScore xs ys =
-  let elemsY = [(head y, length y) | y <- (group . sort) ys]
+  let elemsY = [(fst . fromJust $ uncons y, length y) | y <- (group . sort) ys]
    in sum [x * snd y | x <- xs, y <- elemsY, x == fst y]
 
 parseInput :: IO [[Int]]

src/Day06.hs

@@ -1,12 +1,10 @@
-{-# OPTIONS_GHC -Wno-x-partial #-}
-
 module Day06
   ( day06_1,
     day06_2,
   )
 where
 
-import Data.List (elemIndex)
+import Data.List (elemIndex, uncons)
 import Data.Maybe (fromJust, fromMaybe, isJust)
 
 type Grid = [String]
@@ -38,7 +36,7 @@ getGridVal :: Position -> Grid -> Char
 getGridVal (x, y) grid = (grid !! x) !! y
 
 isInside :: Position -> Grid -> Bool
-isInside (x, y) grid = x >= 0 && y >= 0 && x < length grid && y < length (head grid)
+isInside (x, y) grid = x >= 0 && y >= 0 && x < length grid && y < length (fst . fromJust $ uncons grid)
 
 getNextPosition :: Position -> Direction -> Grid -> (Position, Direction)
 getNextPosition (x, y) U grid =
@@ -66,6 +64,12 @@ getNextPosition (x, y) L grid =
         then getNextPosition (x, y) U grid
         else (newPos, L)
 
+-- markVisited :: Position -> Char -> Grid -> Grid
+-- markVisited (x, y) c grid =
+--  let row = grid !! x
+--      newRow = take y row ++ [c] ++ drop (y + 1) row
+--   in take x grid ++ [newRow] ++ drop (x + 1) grid
+--
 markVisited :: Position -> Char -> Grid -> Grid
 markVisited (x, y) c grid =
   let gridVal = getGridVal (x, y) grid
@@ -96,14 +100,14 @@ checkGridLoop startPosition direction grid =
 
 setGridObstacles :: Position -> Grid -> [Grid]
 setGridObstacles startPosition grid =
-  let positions = [(x, y) | x <- [0 .. (length grid - 1)], y <- [0 .. (length (head grid) - 1)], (x, y) /= startPosition, getGridVal (x, y) grid == 'X']
+  let positions = [(x, y) | x <- [0 .. (length grid - 1)], y <- [0 .. (length (fst . fromJust $ uncons grid) - 1)], (x, y) /= startPosition, getGridVal (x, y) grid == 'X']
    in zipWith (`markVisited` '#') positions (replicate (length positions) grid)
 
 parseInput :: IO (Int, Int, Direction, [String])
 parseInput = do
   contents <- lines <$> readFile "input/day6.txt"
   let (x, y) =
-        (\a b c d -> head $ filter ((>= 0) . fst) [a, b, c, d])
+        (\a b c d -> fst . fromJust . uncons $ filter ((>= 0) . fst) [a, b, c, d])
           <$> getStartPosition 'v'
           <*> getStartPosition '^'
           <*> getStartPosition '<'

src/Day08.hs

@@ -1,5 +1,3 @@
-{-# OPTIONS_GHC -Wno-x-partial #-}
-
 module Day08
   ( day08_1,
     day08_2,
@@ -8,6 +6,8 @@ where
 
 import Control.Applicative
 import Data.Bifunctor (bimap)
+import Data.List (uncons)
+import Data.Maybe (fromJust)
 import Data.Set (fromList)
 
 type Freq = Char
@@ -66,7 +66,7 @@ parseInput = do
   contents <- lines <$> readFile "input/day8.txt"
   let antennas = getAntennas contents
       x = length contents
-      y = length $ head contents
+      y = length $ fst . fromJust $ uncons contents
   return (x, y, antennas)
 
 day08_1 :: IO ()

src/Day10.hs

@@ -11,30 +11,30 @@ import Graph
 
 type Coords = (Int, Int)
 
-adjacent :: (Num a) => A.Array Coords Int -> Coords -> Coords -> [(Coords, Distance a)]
+adjacent :: A.Array Coords Int -> Coords -> Coords -> [Coords]
-adjacent array (i, j) (maxI, maxJ) = [((a, b), Dist 1) | (a, b) <- [(i, j + 1), (i, j - 1), (i + 1, j), (i - 1, j)], a >= 0, b >= 0, a <= maxI, b <= maxJ, array A.! (a, b) - array A.! (i, j) == 1]
+adjacent array (i, j) (maxI, maxJ) = [(a, b) | (a, b) <- [(i, j + 1), (i, j - 1), (i + 1, j), (i - 1, j)], a >= 0, b >= 0, a <= maxI, b <= maxJ, array A.! (a, b) - array A.! (i, j) == 1]
 
-findAllPaths :: Graph Coords Int -> Coords -> Coords -> [Coords] -> [[Coords]]
+findAllPaths :: Graph Coords -> Coords -> Coords -> [Coords] -> [[Coords]]
 findAllPaths graph start end path = do
-  node <- fst <$> edges graph M.! start
+  node <- edges graph M.! start
   let path' = path ++ [node]
   if node == end
     then return path'
     else findAllPaths graph node end path'
 
-getTrailGraph :: A.Array Coords Int -> (Graph Coords Int, [Coords], [Coords])
-getTrailGraph trailMap =
-  let trailGraph = Graph {edges = M.fromList [(k, adjacent trailMap k (52, 52)) | k <- A.indices trailMap]}
-      startList = map fst . filter (\(_, y) -> y == 0) $ A.assocs trailMap
-      endList = map fst . filter (\(_, y) -> y == 9) $ A.assocs trailMap
-   in (trailGraph, startList, endList)
-
 parseInput :: IO (A.Array (Int, Int) Int)
 parseInput = do
   contents <- lines <$> readFile "input/day10.txt"
   let trailMap = A.listArray ((0, 0), (52, 52)) . map digitToInt $ concat contents
   return trailMap
 
+getTrailGraph :: A.Array Coords Int -> (Graph Coords, [Coords], [Coords])
+getTrailGraph trailMap =
+  let trailGraph = Graph {edges = M.fromList [(k, adjacent trailMap k (52, 52)) | k <- A.indices trailMap]}
+      startList = map fst . filter (\(_, y) -> y == 0) $ A.assocs trailMap
+      endList = map fst . filter (\(_, y) -> y == 9) $ A.assocs trailMap
+   in (trailGraph, startList, endList)
+
 day10_1 :: IO ()
 day10_1 = do
   trailMap <- parseInput

src/Day12.hs

@@ -1,10 +1,10 @@
-{-# OPTIONS_GHC -Wno-x-partial #-}
-
 module Day12 (day12_1) where
 
 import Data.Foldable (toList)
 import Data.Graph (Tree, Vertex, graphFromEdges, scc)
+import Data.List (uncons)
 import Data.List.Split (chunksOf)
+import Data.Maybe (fromJust)
 
 type Coords = (Int, Int)
 
@@ -16,12 +16,12 @@ getValue grid (i, j) = grid !! i !! j
 getEdges :: [[V]] -> Coords -> [Int]
 getEdges grid (i, j) =
   let value = fst $ grid !! i !! j
-      adjI = filter (\x -> fst x >= 0 && fst x < length grid && snd x >= 0 && snd x < length (head grid)) [(i, j + 1), (i + 1, j), (i, j - 1), (i - 1, j)]
+      adjI = filter (\x -> fst x >= 0 && fst x < length grid && snd x >= 0 && snd x < length (fst . fromJust $ uncons grid)) [(i, j + 1), (i + 1, j), (i, j - 1), (i - 1, j)]
-   in [snd x | x <- map (getValue grid) adjI, head value == head (fst x)]
+   in [snd x | x <- map (getValue grid) adjI, (fst . fromJust $ uncons value) == (fst . fromJust $ uncons (fst x))]
 
 listVertices :: [String] -> [[V]]
 listVertices grid =
-  let l = length $ head grid
+  let l = length $ fst . fromJust $ uncons grid
    in chunksOf l $ zip (map (: []) (concat grid)) [0 ..]
 
 calculatePerimeter :: (Vertex -> (String, Vertex, [Vertex])) -> Tree Vertex -> Int
@@ -34,7 +34,7 @@ day12_1 :: IO ()
 day12_1 = do
   contents <- lines <$> readFile "input/day12.txt"
   let grid = listVertices contents
-      edgeCoords = [(x, y) | x <- [0 .. length grid - 1], y <- [0 .. length (head grid) - 1]]
+      edgeCoords = [(x, y) | x <- [0 .. length grid - 1], y <- [0 .. length (fst . fromJust $ uncons grid) - 1]]
       edgeList = [(x, y, z) | ((x, y), z) <- zip (concat grid) (map (getEdges grid) edgeCoords)]
       (graph, nodeFromVertex, _) = graphFromEdges edgeList
       plots = scc graph

src/Day13.hs

@@ -1,4 +1,4 @@
-{-# OPTIONS_GHC -Wno-type-defaults -Wno-x-partial #-}
+{-# OPTIONS_GHC -Wno-type-defaults #-}
 
 module Day13
   ( day13_1,
@@ -8,9 +8,10 @@ where
 
 import Data.Char (isDigit)
 import Data.Either (fromRight)
+import Data.List (uncons)
 import Data.List.Split (chunksOf, splitOn)
 import Data.Matrix (Matrix, fromLists, rref, toList, zero)
-import Data.Maybe (mapMaybe)
+import Data.Maybe (fromJust, mapMaybe)
 
 isAlmostInt :: (RealFrac a) => a -> Bool
 isAlmostInt x =
@@ -24,14 +25,14 @@ multRes xs = xs
 getMatrix :: (Read a) => String -> Matrix a
 getMatrix s =
   let nValues = map (map read . splitOn ",") . splitOn ":" . drop 1 $ filter (\x -> isDigit x || x == ',' || x == ':') s
-      eq1 = map head nValues
+      eq1 = map (fst . fromJust . uncons) nValues
       eq2 = map last nValues
    in fromLists [eq1, eq2]
 
 getMatrix' :: (Num a, Read a) => String -> Matrix a
 getMatrix' s =
   let nValues = map (map read . splitOn ",") . splitOn ":" . drop 1 $ filter (\x -> isDigit x || x == ',' || x == ':') s
-      eq1 = multRes $ map head nValues
+      eq1 = multRes $ map (fst . fromJust . uncons) nValues
       eq2 = multRes $ map last nValues
    in fromLists [eq1, eq2]
 

src/Day15.hs

@@ -1,8 +1,8 @@
-{-# OPTIONS_GHC -Wno-incomplete-uni-patterns -Wno-x-partial #-}
+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
 
 module Day15 (day15_1) where
 
-import Data.List (elemIndex, elemIndices, transpose)
+import Data.List (elemIndex, elemIndices, transpose, uncons)
 import Data.List.Split (splitOn)
 import Data.Maybe (fromJust, fromMaybe, isJust)
 
@@ -70,8 +70,8 @@ shiftUp p1 grid =
             then markPosition p1 '.' (markPosition p2 '@' (markPosition p3 'O' grid))
             else
               let column = reverse $ transpose grid !! snd p1
-                  nextDot = head $ dropWhile (< length column - fst p1) $ elemIndices '.' column
+                  nextDot = fst . fromMaybe (-1, []) $ uncons $ dropWhile (< length column - fst p1) $ elemIndices '.' column
-                  nextHash = head $ dropWhile (< length column - fst p1) $ elemIndices '#' column
+                  nextHash = fst . fromMaybe (-1, []) $ uncons $ dropWhile (< length column - fst p1) $ elemIndices '#' column
                in if nextDot == -1 || nextDot > nextHash
                     then grid
                     else markPosition p1 '.' (markPosition p2 '@' (markPosition (length column - 1 - nextDot, snd p1) 'O' grid))
@@ -88,8 +88,8 @@ shiftRight p1 grid =
             then markPosition p1 '.' (markPosition p2 '@' (markPosition p3 'O' grid))
             else
               let row = grid !! fst p1
-                  nextDot = head $ dropWhile (< snd p1) $ elemIndices '.' row
+                  nextDot = fst . fromMaybe (-1, []) $ uncons $ dropWhile (< snd p1) $ elemIndices '.' row
-                  nextHash = head $ dropWhile (< snd p1) $ elemIndices '#' row
+                  nextHash = fst . fromMaybe (-1, []) $ uncons $ dropWhile (< snd p1) $ elemIndices '#' row
                in if nextDot == -1 || nextDot > nextHash
                     then grid
                     else markPosition p1 '.' (markPosition p2 '@' (markPosition (fst p1, nextDot) 'O' grid))
@@ -106,8 +106,8 @@ shiftDown p1 grid =
             then markPosition p1 '.' (markPosition p2 '@' (markPosition p3 'O' grid))
             else
               let column = transpose grid !! snd p1
-                  nextDot = head $ dropWhile (< fst p1) $ elemIndices '.' column
+                  nextDot = fst . fromMaybe (-1, []) $ uncons $ dropWhile (< fst p1) $ elemIndices '.' column
-                  nextHash = head $ dropWhile (< fst p1) $ elemIndices '#' column
+                  nextHash = fst . fromMaybe (-1, []) $ uncons $ dropWhile (< fst p1) $ elemIndices '#' column
                in if nextDot == -1 || nextDot > nextHash
                     then grid
                     else markPosition p1 '.' (markPosition p2 '@' (markPosition (nextDot, snd p1) 'O' grid))
@@ -124,8 +124,8 @@ shiftLeft p1 grid =
             then markPosition p1 '.' (markPosition p2 '@' (markPosition p3 'O' grid))
             else
               let row = reverse $ grid !! fst p1
-                  nextDot = head $ dropWhile (< length row - snd p1) $ elemIndices '.' row
+                  nextDot = fst . fromMaybe (-1, []) $ uncons $ dropWhile (< length row - snd p1) $ elemIndices '.' row
-                  nextHash = head $ dropWhile (< length row - snd p1) $ elemIndices '#' row
+                  nextHash = fst . fromMaybe (-1, []) $ uncons $ dropWhile (< length row - snd p1) $ elemIndices '#' row
                in if nextDot == -1 || nextDot > nextHash
                     then grid
                     else markPosition p1 '.' (markPosition p2 '@' (markPosition (fst p1, length row - 1 - nextDot) 'O' grid))
@@ -195,7 +195,7 @@ gpsCoords (x, y) = 100 * x + y
 
 boxCoords :: Grid -> [Int]
 boxCoords grid =
-  let coords = [(x, y) | x <- [0 .. length grid - 1], y <- [0 .. length (head grid) - 1], getGridVal (x, y) grid == 'O']
+  let coords = [(x, y) | x <- [0 .. length grid - 1], y <- [0 .. length (fst . fromJust $ uncons grid) - 1], getGridVal (x, y) grid == 'O']
    in map gpsCoords coords
 
 day15_1 :: IO ()

src/Day16.hs

@@ -1,53 +0,0 @@
-{-# LANGUAGE DeriveGeneric #-}
-
-module Day16 (day16_1) where
-
-import qualified Data.Array as A
-import qualified Data.HashMap.Strict as M
-import Data.Hashable
-import Data.Ix
-import GHC.Generics (Generic)
-import Graph
-
-data Direction = N | S | E | W deriving (Eq, Ord, Generic, Ix)
-
-instance Hashable Direction
-
-type Coords = (Int, Int, Direction)
-
-getCost :: Direction -> Direction -> Int
-getCost a b
-  | a == b = 1
-  | otherwise = 1000
-
-adjacent :: A.Array Coords Char -> Coords -> (Int, Int) -> [(Coords, Distance Int)]
-adjacent array (i, j, N) (maxI, maxJ) =
-  [((a, b, d), Dist (getCost N d)) | i >= 0, j >= 0, i <= maxI, j <= maxJ, (a, b, d) <- [(i - 1, j, N), (i, j, W), (i, j, E)], array A.! (i, j, d) /= '#']
-adjacent array (i, j, S) (maxI, maxJ) =
-  [((a, b, d), Dist (getCost S d)) | i >= 0, j >= 0, i <= maxI, j <= maxJ, (a, b, d) <- [(i + 1, j, S), (i, j, W), (i, j, E)], array A.! (i, j, d) /= '#']
-adjacent array (i, j, E) (maxI, maxJ) =
-  [((a, b, d), Dist (getCost E d)) | i >= 0, j >= 0, i <= maxI, j <= maxJ, (a, b, d) <- [(i, j + 1, E), (i, j, N), (i, j, S)], array A.! (i, j, d) /= '#']
-adjacent array (i, j, W) (maxI, maxJ) =
-  [((a, b, d), Dist (getCost W d)) | i >= 0, j >= 0, i <= maxI, j <= maxJ, (a, b, d) <- [(i, j - 1, W), (i, j, N), (i, j, S)], array A.! (i, j, d) /= '#']
-
-getMazeGraph :: A.Array Coords Char -> Int -> Int -> (Graph Coords Int, Coords, [Coords])
-getMazeGraph mazeMap nRow nCol =
-  let mazeGraph = Graph {edges = M.fromList [(k, adjacent mazeMap k (nRow, nCol)) | k <- A.indices mazeMap]}
-      start = fst . last . filter (\((_, _, d), c) -> d == E && c == 'S') $ A.assocs mazeMap
-      end = map fst $ filter (\(_, c) -> c == 'E') $ A.assocs mazeMap
-   in (mazeGraph, start, end)
-
-parseInput :: IO (A.Array (Int, Int, Direction) Char, Int, Int)
-parseInput = do
-  contents <- lines <$> readFile "input/day16.txt"
-  let nRow = length contents - 1
-      nCol = length (last contents) - 1
-      mazeMap = A.listArray ((0, 0, N), (nRow, nCol, W)) (concatMap (replicate 4) $ concat contents)
-  return (mazeMap, nRow, nCol)
-
-day16_1 :: IO ()
-day16_1 = do
-  (mazeMap, nRow, nCol) <- parseInput
-  let (mazeGraph, start, end) = getMazeGraph mazeMap nRow nCol
-      shortestPaths = [findShortestPath mazeGraph start e | e <- end]
-  putStrLn $ "Day 16, Puzzle 1 solution: " ++ show (minimum shortestPaths)

src/Day17.hs

@@ -1,11 +1,14 @@
-{-# OPTIONS_GHC -Wno-incomplete-uni-patterns -Wno-type-defaults -Wno-x-partial #-}
+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
+{-# OPTIONS_GHC -Wno-type-defaults #-}
 
 module Day17 (day17_1, day17_2) where
 
 import Control.Monad.State
 import Data.Bits
 import Data.Char (isDigit)
+import Data.List (uncons)
 import Data.List.Split (splitOn)
+import Data.Maybe (fromJust)
 
 type Program = [Int]
 
@@ -129,7 +132,7 @@ parseInput = do
 day17_1 :: IO ()
 day17_1 = do
   (registers, prog) <- parseInput
-  let computer = Computer {registerA = head registers, registerB = registers !! 1, registerC = registers !! 2, pointer = 0, program = prog, output = ""}
+  let computer = Computer {registerA = fst . fromJust $ uncons registers, registerB = registers !! 1, registerC = registers !! 2, pointer = 0, program = prog, output = ""}
   putStr "Day 17, Puzzle 1 solution: "
   print . drop 1 . output $ execState runProgram computer
 
@@ -140,4 +143,4 @@ day17_2 = do
       regA = [805464 * 2 ^ 27 ..] -- Threshold derived empirically, a better threshold must be possible because this is very slow, but got the correct answer.
   putStrLn $
     "Day 17, Puzzle 2 solution: "
-      ++ show (head $ dropWhile (\x -> not (checkIfCreatesCopy computer {registerA = x})) regA)
+      ++ show (fst . fromJust . uncons $ dropWhile (\x -> not (checkIfCreatesCopy computer {registerA = x})) regA)

src/Day18.hs

@@ -13,8 +13,8 @@ import Graph
 
 type Coords = (Int, Int)
 
-adjacent :: (Num a) => A.Array Coords Char -> Coords -> Coords -> [(Coords, Distance a)]
+adjacent :: A.Array Coords Char -> Coords -> Coords -> [Coords]
-adjacent array (i, j) (maxI, maxJ) = [((a, b), Dist 1) | (a, b) <- [(i, j + 1), (i, j - 1), (i + 1, j), (i - 1, j)], a >= 0, b >= 0, a <= maxI, b <= maxJ, array A.! (a, b) /= '#']
+adjacent array (i, j) (maxI, maxJ) = [(a, b) | (a, b) <- [(i, j + 1), (i, j - 1), (i + 1, j), (i - 1, j)], a >= 0, b >= 0, a <= maxI, b <= maxJ, array A.! (a, b) /= '#']
 
 corruptMemory :: A.Array Coords Char -> [Coords] -> A.Array Coords Char
 corruptMemory = foldl (\a b -> a A.// [(b, '#')])
@@ -32,7 +32,7 @@ getCorruptedMemoryMap fallingBytes =
   let memory = A.listArray ((0, 0), (70, 70)) $ replicate 5041 '.'
       bytesCoords = take 1024 [(read x, read y) | (x : y : _) <- fallingBytes]
       corruptedMemory = corruptMemory memory bytesCoords
-   in corruptedMemory
+  in corruptedMemory
 
 day18_1 :: IO ()
 day18_1 = do

src/Day23.hs

@@ -1,40 +0,0 @@
-module Day23 (day23_1) where
-
-import Control.Monad
-import Data.Containers.ListUtils (nubOrd)
-import Data.List (nub, sort)
-import Data.List.Split (splitOn)
-
-startsWithT :: String -> Bool
-startsWithT [] = False
-startsWithT (x : _)
-  | x == 't' = True
-  | otherwise = False
-
-getConns3 :: [[String]] -> [[String]]
-getConns3 connections = do
-  conn1 <- connections
-  conn2 <- connections
-
-  guard $
-    conn1 /= conn2
-      && length (nub (conn1 ++ conn2)) == 3
-      && any startsWithT (conn1 ++ conn2)
-
-  conn3 <- connections
-
-  guard $
-    conn1 /= conn3
-      && conn2 /= conn3
-      && length (nub (conn1 ++ conn2 ++ conn3)) == 3
-      && any startsWithT (conn1 ++ conn2 ++ conn3)
-
-  return . nub $ conn1 ++ conn2 ++ conn3
-
-day23_1 :: IO ()
-day23_1 = do
-  contents <- lines <$> readFile "input/day23.txt"
-  let connections = map (splitOn "-") contents
-  putStrLn $
-    "Day 23, Puzzle 1 solution: "
-      ++ show (length . nubOrd . map sort $ getConns3 connections)

src/Day24.hs

@@ -1,34 +0,0 @@
-{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
-
-module Day24 (day24_1) where
-
-import Data.Bits
-import qualified Data.HashMap.Strict as M
-import Data.List (sort)
-import Data.List.Split (splitOn)
-
-getWireValue :: String -> M.HashMap String (Maybe Int) -> M.HashMap String String -> Int
-getWireValue w wm cm =
-  case wm M.! w of
-    Just x -> x
-    Nothing ->
-      let (w1 : op : w2 : _) = words $ cm M.! w
-       in if op == "AND"
-            then getWireValue w1 wm cm .&. getWireValue w2 wm cm
-            else
-              if op == "OR"
-                then getWireValue w1 wm cm .|. getWireValue w2 wm cm
-                else getWireValue w1 wm cm `xor` getWireValue w2 wm cm
-
-toDecimal :: [Int] -> Int
-toDecimal n = sum $ zipWith (*) n (iterate (*2) 1)
-
-day24_1 :: IO ()
-day24_1 = do
-  [inputs, connections] <- splitOn [""] . lines <$> readFile "input/day24.txt"
-  let inputsList = [(i, Just (read v)) | [i, v] <- map (splitOn ": ") inputs]
-      wireConnections = [(w, c) | [c, w] <- map (splitOn " -> ") connections]
-      connectionsMap = M.fromList wireConnections
-      wiresMap = M.fromList $ [(fst wc, Nothing) | wc <- wireConnections] ++ inputsList
-      outputs = map (\x -> getWireValue x wiresMap connectionsMap) (filter (\(x : _) -> x == 'z') . sort $ M.keys wiresMap)
-  putStrLn $ "Day 24, Puzzle 1 solution: " ++ show (toDecimal outputs)

src/Day25.hs

@@ -1,31 +0,0 @@
-{-# OPTIONS_GHC -Wno-x-partial #-}
-
-module Day25 (day25_1) where
-
-import Control.Monad (guard)
-import Data.List (transpose)
-import Data.List.Split (splitOn)
-
-parseSchematics :: [String] -> [Int]
-parseSchematics s =
-  let s' = transpose . init $ tail s
-   in map (length . filter (== '#')) s'
-
-keyLockCombinations :: [[Int]] -> [[Int]] -> [[Int]]
-keyLockCombinations keys locks = do
-  key <- keys
-  lock <- locks
-
-  guard $ all (< 6) $ zipWith (+) key lock
-
-  return $ zipWith (+) key lock
-
-day25_1 :: IO ()
-day25_1 = do
-  contents <- lines <$> readFile "input/day25.txt"
-  let schematics = splitOn [""] contents
-      locks = map parseSchematics $ filter (\x -> head x == "#####" && last x == ".....") schematics
-      keys = map parseSchematics $ filter (\x -> head x == "....." && last x == "#####") schematics
-  putStrLn $
-    "Day 25, Puzzle 1 solution: "
-      ++ show (length $ keyLockCombinations keys locks)

src/Graph.hs

@@ -10,6 +10,8 @@ import Data.Hashable (Hashable)
 import Data.Maybe (fromJust)
 import qualified Data.PSQueue as PQ
 
+newtype Graph a = Graph {edges :: M.HashMap a [a]} deriving (Show)
+
 data Distance a = Dist a | Infinity deriving (Eq)
 
 instance (Ord a) => Ord (Distance a) where
@@ -22,8 +24,6 @@ instance (Show a) => Show (Distance a) where
   show Infinity = "Infinity"
   show (Dist x) = show x
 
-newtype Graph a b = Graph {edges :: M.HashMap a [(a, Distance b)]} deriving (Show)
-
 addDistance :: (Num a) => Distance a -> Distance a -> Distance a
 addDistance (Dist x) (Dist y) = Dist (x + y)
 addDistance _ _ = Infinity
@@ -33,26 +33,23 @@ data DijkstraState a b = DijkstraState
     distances :: M.HashMap a (Distance b)
   }
 
-updateDistances :: (Hashable a, Num b) => M.HashMap a (Distance b) -> [(a, Distance b)] -> Distance b -> M.HashMap a (Distance b)
+updateDistances :: (Hashable a) => M.HashMap a (Distance b) -> [a] -> Distance b -> M.HashMap a (Distance b)
 updateDistances dists [] _ = dists
 updateDistances dists (n : nodes) startD =
-  let newD = addDistance startD (snd n)
+  updateDistances (M.adjust (const startD) n dists) nodes startD
-   in updateDistances (M.adjust (const newD) (fst n) dists) nodes startD
 
-visit :: (Ord a, Num b, Ord b) => PQ.PSQ a (Distance b) -> a -> [(a, Distance b)] -> Distance b -> PQ.PSQ a (Distance b)
+visit :: (Ord a, Ord b) => PQ.PSQ a (Distance b) -> a -> [a] -> Distance b -> PQ.PSQ a (Distance b)
 visit us node [] _ = PQ.delete node us
-visit us node (e : es) startD =
+visit us node (e : es) dist = visit (PQ.adjust (const dist) e us) node es dist
-  let newD = addDistance startD (snd e)
-   in visit (PQ.adjust (const newD) (fst e) us) node es startD
 
-visitNode :: (Hashable a, Ord a, Num b, Ord b) => DijkstraState a b -> Graph a b -> a -> Distance b -> DijkstraState a b
+visitNode :: (Hashable a, Ord a, Ord b) => DijkstraState a b -> Graph a -> a -> Distance b -> DijkstraState a b
 visitNode state graph node d =
   let es = edges graph M.! node
       ds = updateDistances (distances state) es d
       us = visit (unvisited state) node es d
    in state {unvisited = us, distances = ds}
 
-findShortestPath :: (Hashable a, Ord a, Ord b, Num b) => Graph a b -> a -> a -> Distance b
+findShortestPath :: (Hashable a, Ord a, Ord b, Num b) => Graph a -> a -> a -> Distance b
 findShortestPath graph start end =
   let nodesDist = (start PQ.:-> Dist 0) : [k PQ.:-> Infinity | k <- M.keys $ edges graph, k /= start]
       dists = (start, Dist 0) : [(k, Infinity) | k <- M.keys $ edges graph, k /= start]
@@ -68,4 +65,4 @@ findShortestPath graph start end =
             else
               if d == Infinity
                 then Infinity
-                else dijkstra $ visitNode s graph n d
+                else dijkstra $ visitNode s graph n (addDistance d (Dist 1))

src/Main.hs

@@ -15,14 +15,10 @@ import Day12 (day12_1)
 import Day13 (day13_1, day13_2)
 import Day14 (day14_1, day14_2)
 import Day15 (day15_1)
-import Day16 (day16_1)
 import Day17 (day17_1, day17_2)
 import Day18 (day18_1, day18_2)
 import Day19 (day19_1)
 import Day22 (day22_1)
-import Day23 (day23_1)
-import Day24 (day24_1)
-import Day25 (day25_1)
 import System.Environment (getArgs)
 
 main :: IO ()
@@ -96,7 +92,6 @@ main = do
       day14_1
       day14_2
     "15" : "1" : _ -> day15_1
-    "16" : "1" : _ -> day16_1
     "17" : "1" : _ -> day17_1
     "17" : "2" : _ -> day17_2
     "17" : _ -> do
@@ -109,46 +104,4 @@ main = do
       day18_2
     "19" : "1" : _ -> day19_1
     "22" : "1" : _ -> day22_1
-    "23" : "1" : _ -> day23_1
-    "24" : "1" : _ -> day24_1
-    "25" : "1" : _ -> day25_1
-    "all" : _ -> do
-      day01_1
-      day01_2
-      day02_1
-      day02_2
-      day03_1
-      day03_2
-      day04_1
-      day04_2
-      day05_1
-      day05_2
-      day06_1
-      day06_2
-      day07_1
-      day07_2
-      day08_1
-      day08_2
-      day09_1
-      day09_2
-      day10_1
-      day10_2
-      day11_1
-      day11_2
-      day12_1
-      day13_1
-      day13_2
-      day14_1
-      day14_2
-      day15_1
-      day16_1
-      day17_1
-      day17_2
-      day18_1
-      day18_2
-      day19_1
-      day22_1
-      day23_1
-      day24_1
-      day25_1
     _ -> error "Not implemented"