advent09/Main.hs

   1 -- Writeup at https://work.njae.me.uk/2022/12/04/advent-of-code-2022-day-4/
   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   { _headR :: Position
  19   , _tailR :: 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
  35 part1 :: Path -> Int
  36 part1 steps = S.size $ rope' ^. trace
  37   where rope' = ropeSteps newRope steps
  38
  39 expandPath :: [Direction] -> Path
  40 expandPath = concatMap expandStep
  41   where expandStep (U n) = replicate n (V2  0  1)
  42         expandStep (L n) = replicate n (V2 -1  0)
  43         expandStep (D n) = replicate n (V2  0 -1)
  44         expandStep (R n) = replicate n (V2  1  0)
  45
  46
  47 manhattan :: Position -> Position -> Int
  48 manhattan p1 p2 = max dx dy
  49   where V2 dx dy = abs $ p1 ^-^ p2
  50
  51 touching :: Position -> Position -> Bool
  52 touching p1 p2 =  (manhattan p1 p2) <= 1
  53
  54 towards :: Position -> Position -> Position
  55 towards p1 p2 = signum $ p2 ^-^ p1
  56
  57 newRope :: Rope
  58 newRope = Rope { _headR = V2 0 0, _tailR = V2 0 0, _trace = S.singleton (V2 0 0) }
  59
  60 ropeSteps :: Rope -> Path -> Rope
  61 ropeSteps rope steps = foldl' ropeStep rope steps
  62
  63 ropeStep :: Rope -> Position -> Rope
  64 ropeStep rope step = rope & headR .~ hr
  65                           & tailR .~ tailR'
  66                           & trace %~ S.insert tailR'
  67   where hr = (rope ^. headR) ^+^ step
  68         tr = rope ^. tailR
  69         tailR' = if tr `touching` hr
  70                  then rope ^. tailR
  71                  else tr ^+^ (tr `towards` hr)
  72
  73 -- Parse the input file
  74
  75 pathP :: Parser [Direction]
  76 directionP, upP, leftP, downP, rightP :: Parser Direction
  77
  78 pathP = directionP `sepBy` endOfLine
  79 directionP = upP <|> leftP <|> downP <|> rightP
  80 upP    = U <$> ("U " *> decimal)
  81 leftP  = L <$> ("L " *> decimal)
  82 downP  = D <$> ("D " *> decimal)
  83 rightP = R <$> ("R " *> decimal)
  84
  85
  86 successfulParse :: Text -> [Direction]
  87 successfulParse input =
  88   case parseOnly pathP input of
  89     Left  _err -> [] -- TIO.putStr $ T.pack $ parseErrorPretty err
  90     Right path -> path