Last active
December 4, 2023 00:17
-
-
Save Kaisia-Estrel/e96c5aeb31b1b0840439a7b3218229b5 to your computer and use it in GitHub Desktop.
AOC 2023 - Day 3
This file contains hidden or 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
| {-# LANGUAGE BlockArguments #-} | |
| {-# LANGUAGE DeriveFunctor #-} | |
| {-# LANGUAGE DerivingStrategies #-} | |
| {-# LANGUAGE FlexibleInstances #-} | |
| {-# LANGUAGE LambdaCase #-} | |
| {-# LANGUAGE MultiParamTypeClasses #-} | |
| {-# LANGUAGE RecordWildCards #-} | |
| {-# LANGUAGE TypeApplications #-} | |
| module Main (main) where | |
| import Control.Applicative (Applicative (..)) | |
| import Control.Monad (forM) | |
| import Control.Monad.ST (runST) | |
| import Data.Bifunctor (Bifunctor (bimap)) | |
| import Data.Char (isDigit) | |
| import Data.List (groupBy, nub) | |
| import Data.Maybe (mapMaybe, listToMaybe) | |
| import Data.STRef (newSTRef, readSTRef, writeSTRef) | |
| import GHC.Exts (groupWith) | |
| import Data.Aeson (withArray) | |
| newtype Matrix a = Matrix {getLists :: [[a]]} | |
| deriving stock (Functor) | |
| instance (Show a) => Show (Matrix a) where | |
| show (Matrix (x : xs)) = | |
| unlines | |
| $ ('┌' : ('─' <$ show x) ++ "┐") | |
| : map ((\l -> '│' : l ++ "│") . show) (x : xs) | |
| ++ ['└' : ('─' <$ show x) ++ "┘"] | |
| show _ = "" | |
| instance Applicative Matrix where | |
| pure x = Matrix [[x]] | |
| Matrix f <*> Matrix xs = Matrix $ zipWith (zipWith ($)) f xs | |
| data Shifts a = Shifts | |
| { up :: a | |
| , upLeft :: a | |
| , left :: a | |
| , downLeft :: a | |
| , down :: a | |
| , downRight :: a | |
| , right :: a | |
| , upRight :: a | |
| } | |
| deriving stock (Show) | |
| instance Foldable Matrix where | |
| foldr f acc (Matrix xs) = foldr f acc (concat xs) | |
| instance Traversable Matrix where | |
| traverse f (Matrix xs) = Matrix <$> traverse (traverse f) xs | |
| data GridCell | |
| = Space | |
| | Digit Char | |
| | Symbol | |
| | Gear Int | |
| deriving stock (Eq) | |
| instance Show GridCell where | |
| show Space = "." | |
| show (Digit c) = [c] | |
| show (Gear _) = "*" | |
| show Symbol = "#" | |
| shiftUp :: Matrix GridCell -> Matrix GridCell | |
| shiftUp (Matrix (x : xs)) = Matrix $ xs ++ [Space <$ x] | |
| shiftUp x = x | |
| shiftDown :: Matrix GridCell -> Matrix GridCell | |
| shiftDown (Matrix (x : xs)) = Matrix $ (Space <$ x) : init (x : xs) | |
| shiftDown x = x | |
| shiftL :: Matrix GridCell -> Matrix GridCell | |
| shiftL (Matrix list) = | |
| Matrix | |
| $ map | |
| ( \case | |
| (_ : xs) -> xs ++ [Space] | |
| [] -> [] | |
| ) | |
| list | |
| shiftR :: Matrix GridCell -> Matrix GridCell | |
| shiftR (Matrix list) = | |
| Matrix | |
| $ map | |
| ( \case | |
| (x : xs) -> Space : init (x : xs) | |
| [] -> [] | |
| ) | |
| list | |
| shifts :: Matrix GridCell -> Matrix (Shifts GridCell) | |
| shifts m = | |
| Shifts | |
| <$> shiftUp m | |
| <*> shiftUp (shiftL m) | |
| <*> shiftL m | |
| <*> shiftDown (shiftL m) | |
| <*> shiftDown m | |
| <*> shiftDown (shiftR m) | |
| <*> shiftR m | |
| <*> shiftUp (shiftR m) | |
| shiftsToList :: Shifts a -> [a] | |
| shiftsToList (Shifts {..}) = [up, upLeft, left, downLeft, down, downRight, right, upRight] | |
| shiftRs :: Matrix GridCell -> Matrix (String, [GridCell]) | |
| shiftRs m = | |
| let neighbors = shifts m | |
| in if any (\case Shifts {right = (Digit _)} -> True; _ -> False) neighbors | |
| then | |
| liftA2 | |
| ( \case | |
| (Digit c, shiftsX) -> bimap (++ [c]) (shiftsToList shiftsX ++) | |
| _ -> const ([], []) | |
| ) | |
| (liftA2 (,) m neighbors) | |
| (shiftRs (fmap right neighbors)) | |
| else fmap (\case (Digit c) -> ([c], []); _ -> ([], [])) m | |
| makeGridCells :: Matrix Char -> Matrix GridCell | |
| makeGridCells m = runST do | |
| idx <- newSTRef 0 | |
| forM m \case | |
| '.' -> pure Space | |
| '*' -> do | |
| i <- readSTRef idx | |
| writeSTRef idx (i + 1) | |
| pure (Gear i) | |
| x | isDigit x -> pure (Digit x) | |
| _ -> pure Symbol | |
| main :: IO () | |
| main = do | |
| let | |
| f ([], []) _ = False | |
| f _ ([], []) = False | |
| f _ _ = True | |
| matrix <- makeGridCells . Matrix . lines <$> readFile "input.txt" | |
| putStr "part1: " | |
| . sum | |
| . map (read @Int . fst) | |
| . filter (any (\case Symbol -> True; (Gear _) -> True; _ -> False) . snd) | |
| . map last | |
| . groupBy f | |
| . concat | |
| . getLists | |
| $ shiftRs matrix | |
| putStr "part2: " | |
| . sum | |
| . map (product . map fst) | |
| . filter (\x -> length x == 2) | |
| . groupWith snd | |
| -- you can also do it with | |
| -- . mapMaybe | |
| -- ( (\(n, xs) -> listToMaybe $ mapMaybe (\case (Gear gearId) -> Just (read @Int n, gearId); _ -> Nothing) xs) | |
| -- . last | |
| -- ) | |
| . concatMap | |
| ( (\(n, xs) -> nub $ mapMaybe (\case (Gear gearId) -> Just (read @Int n, gearId); _ -> Nothing) xs) | |
| . last | |
| ) | |
| . groupBy f | |
| . concat | |
| . getLists | |
| $ shiftRs matrix |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment