advent09/Main.hs

   1 -- Writeup at https://work.njae.me.uk/2022/12/10/advent-of-code-2022-day-9/
   2
   3 import AoC
   4 import Data.Text (Text)
   5 import qualified Data.Text.IO as TIO
   6 import Data.Attoparsec.Text hiding (take, D)
   7 import Control.Applicative
   8 import Data.List
   9 import qualified Data.Set as S
  10 import Linear hiding (Trace, trace, distance)
  11 import Control.Lens
  12
  13 type Position = V2 Int
  14 type Trace = S.Set Position
  15 type Path = [Position]
  16
  17 data Rope = Rope
  18   { _headK :: Position
  19   , _knots :: [Position]
  20   , _trace :: Trace
  21   } deriving (Show, Eq)
  22 makeLenses ''Rope
  23
  24 data Direction = U Int | R Int | D Int | L Int
  25   deriving (Show, Eq, Ord)
  26
  27 main :: IO ()
  28 main =
  29   do  dataFileName <- getDataFileName
  30       text <- TIO.readFile dataFileName
  31       let path = successfulParse text
  32       let steps = expandPath path
  33       print $ part1 steps
  34       print $ part2 steps
  35
  36 part1, part2 :: Path -> Int
  37 part1 steps = S.size $ rope ^. trace
  38   where rope = ropeSteps (newRope 1) steps
  39
  40 part2 steps = S.size $ rope ^. trace
  41   where rope = ropeSteps (newRope 9) steps
  42
  43
  44 expandPath :: [Direction] -> Path
  45 expandPath = concatMap expandStep
  46   where expandStep (U n) = replicate n (V2  0  1)
  47         expandStep (L n) = replicate n (V2 -1  0)
  48         expandStep (D n) = replicate n (V2  0 -1)
  49         expandStep (R n) = replicate n (V2  1  0)
  50
  51 lInfNorm :: Position -> Position -> Int
  52 lInfNorm p1 p2 = max dx dy
  53   where V2 dx dy = abs $ p1 ^-^ p2
  54
  55 touching :: Position -> Position -> Bool
  56 touching p1 p2 = (lInfNorm p1 p2) <= 1
  57
  58 towards :: Position -> Position -> Position
  59 towards p1 p2 = signum $ p2 ^-^ p1
  60
  61 newRope :: Int -> Rope
  62 newRope n = Rope { _headK = V2 0 0, _knots = replicate n (V2 0 0), _trace = S.singleton (V2 0 0) }
  63
  64 ropeSteps :: Rope -> Path -> Rope
  65 ropeSteps rope steps = foldl' ropeStep rope steps
  66
  67 ropeStep :: Rope -> Position -> Rope
  68 ropeStep rope step = rope & headK .~ h
  69                           & knots .~ (reverse kts)
  70                           & trace %~ S.insert kt
  71   where h = (rope ^. headK) ^+^ step
  72         (kt, kts) = foldl' knotStep (h, []) $ rope ^. knots -- kts
  73
  74 knotStep :: (Position, [Position]) -> Position -> (Position, [Position])
  75 knotStep (h, ks) kt = (kt', (kt':ks))
  76   where kt' = if kt `touching` h
  77               then kt
  78               else kt ^+^ (kt `towards` h)
  79
  80 -- Parse the input file
  81
  82 pathP :: Parser [Direction]
  83 directionP, upP, leftP, downP, rightP :: Parser Direction
  84
  85 pathP = directionP `sepBy` endOfLine
  86 directionP = upP <|> leftP <|> downP <|> rightP
  87 upP    = U <$> ("U " *> decimal)
  88 leftP  = L <$> ("L " *> decimal)
  89 downP  = D <$> ("D " *> decimal)
  90 rightP = R <$> ("R " *> decimal)
  91
  92
  93 successfulParse :: Text -> [Direction]
  94 successfulParse input =
  95   case parseOnly pathP input of
  96     Left  _err -> [] -- TIO.putStr $ T.pack $ parseErrorPretty err
  97     Right path -> path