src/advent25/advent25.hs

   1 {-# LANGUAGE NegativeLiterals #-}
   2 {-# LANGUAGE FlexibleContexts #-}
   3 {-# LANGUAGE OverloadedStrings #-}
   4 {-# LANGUAGE TypeFamilies #-}
   5
   6 import Debug.Trace
   7
   8 -- import Prelude hiding ((++))
   9 import Data.Text (Text)
  10 import qualified Data.Text as T
  11 import qualified Data.Text.IO as TIO
  12
  13 import Data.Void (Void)
  14 import Text.Megaparsec hiding (State)
  15 import Text.Megaparsec.Char
  16 import qualified Text.Megaparsec.Char.Lexer as L
  17 import qualified Control.Applicative as CA
  18
  19 import Data.List hiding (group)
  20 -- import Data.Function (on)
  21 import qualified Data.Map.Strict as M
  22 import Data.Map.Strict ((!))
  23
  24 import Linear (V4(..), (^-^))
  25
  26
  27 type Coord = V4 Integer
  28 type Constellations = M.Map Coord Coord
  29
  30
  31 main :: IO ()
  32 main = do
  33         text <- TIO.readFile "data/advent25.txt"
  34         let stars = successfulParse text
  35         print $ part1 stars
  36
  37
  38 part1 :: [Coord] -> Int
  39 part1 stars = countConstellations constellations
  40     where initialConstellations = foldl' (\c s -> M.insert s s c) M.empty stars
  41           pairs = adjacencies stars
  42           constellations = findConstellations initialConstellations pairs
  43
  44
  45 manhattan :: Coord -> Integer
  46 manhattan (V4 x y z t) = (abs x) + (abs y) + (abs z) + (abs t)
  47
  48 distance :: Coord -> Coord -> Integer
  49 distance a b = manhattan (a ^-^ b)
  50
  51 close :: Coord -> Coord -> Bool
  52 close a b = (distance a b) <= 3
  53
  54 adjacencies :: [Coord] -> [(Coord, Coord)]
  55 adjacencies stars = filter (\(a, b) -> a /= b && (close a b))
  56                     [ (a, b) | a <- stars, b <- stars ]
  57
  58
  59 findConstellations :: Constellations -> [(Coord, Coord)] -> Constellations
  60 findConstellations constellations0 pairs = foldl' mergeConstellation constellations0 pairs
  61
  62 mergeConstellation :: Constellations -> (Coord, Coord) -> Constellations
  63 mergeConstellation constellations (a, b) =
  64     if ae == be
  65     then constellations
  66     else M.insert ae be constellations
  67     where ae = exemplar constellations a
  68           be = exemplar constellations b
  69
  70 exemplar :: Constellations -> Coord -> Coord
  71 exemplar constellations star =
  72     if constellations!star == star
  73     then star
  74     else exemplar constellations (constellations!star)
  75
  76
  77 countConstellations :: Constellations -> Int
  78 countConstellations constellations = M.size $ M.filterWithKey (==) constellations
  79
  80
  81 type Parser = Parsec Void Text
  82
  83 sc :: Parser ()
  84 sc = L.space (skipSome spaceChar) CA.empty CA.empty
  85
  86 lexeme  = L.lexeme sc
  87 integer = lexeme L.decimal
  88 signedInteger = L.signed sc integer
  89 symb = L.symbol sc
  90 comma = symb ","
  91
  92 coordP = V4 <$> signedInteger <* comma
  93             <*> signedInteger <* comma
  94             <*> signedInteger <* comma
  95             <*> signedInteger
  96
  97 starsP = many coordP
  98
  99 successfulParse :: Text -> [Coord]
 100 -- successfulParse _ = []
 101 successfulParse input =
 102         case parse starsP "input" input of
 103                 Left  _error -> [] -- TIO.putStr $ T.pack $ parseErrorPretty err
 104                 Right stars -> stars