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 :: 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
  52 manhattan :: Position -> Position -> Int
  53 manhattan p1 p2 = max dx dy
  54   where V2 dx dy = abs $ p1 ^-^ p2
  55
  56 touching :: Position -> Position -> Bool
  57 touching p1 p2 =  (manhattan p1 p2) <= 1
  58
  59 towards :: Position -> Position -> Position
  60 towards p1 p2 = signum $ p2 ^-^ p1
  61
  62 newRope :: Int -> Rope
  63 newRope n = Rope { _headK = V2 0 0, _knots = replicate n (V2 0 0), _trace = S.singleton (V2 0 0) }
  64
  65 ropeSteps :: Rope -> Path -> Rope
  66 ropeSteps rope steps = foldl' ropeStep rope steps
  67
  68 ropeStep :: Rope -> Position -> Rope
  69 ropeStep rope step = rope & headK .~ h
  70                           & knots .~ (reverse kts')
  71                           & trace %~ S.insert (head kts')
  72   where h = (rope ^. headK) ^+^ step
  73         kts = rope ^. knots
  74         (_, kts') = foldl' knotStep (h, []) kts
  75
  76
  77 -- foldl' (f) (hr, []) knots
  78
  79 knotStep (h, ks) kt = (kt', (kt':ks))
  80   where kt' = if kt `touching` h
  81               then kt
  82               else kt ^+^ (kt `towards` h)
  83
  84
  85 -- Parse the input file
  86
  87 pathP :: Parser [Direction]
  88 directionP, upP, leftP, downP, rightP :: Parser Direction
  89
  90 pathP = directionP `sepBy` endOfLine
  91 directionP = upP <|> leftP <|> downP <|> rightP
  92 upP    = U <$> ("U " *> decimal)
  93 leftP  = L <$> ("L " *> decimal)
  94 downP  = D <$> ("D " *> decimal)
  95 rightP = R <$> ("R " *> decimal)
  96
  97
  98 successfulParse :: Text -> [Direction]
  99 successfulParse input =
 100   case parseOnly pathP input of
 101     Left  _err -> [] -- TIO.putStr $ T.pack $ parseErrorPretty err
 102     Right path -> path