this post was submitted on 18 Dec 2023
13 points (93.3% liked)

Advent Of Code

770 readers
1 users here now

An unofficial home for the advent of code community on programming.dev!

Advent of Code is an annual Advent calendar of small programming puzzles for a variety of skill sets and skill levels that can be solved in any programming language you like.

AoC 2023

Solution Threads

M T W T F S S
1 2 3
4 5 6 7 8 9 10
11 12 13 14 15 16 17
18 19 20 21 22 23 24
25

Rules/Guidelines

Relevant Communities

Relevant Links

Credits

Icon base by Lorc under CC BY 3.0 with modifications to add a gradient

console.log('Hello World')

founded 1 year ago
MODERATORS
13
submitted 11 months ago* (last edited 11 months ago) by CameronDev to c/advent_of_code
 

Day 18: Lavaduct Lagoon

Megathread guidelines

  • Keep top level comments as only solutions, if you want to say something other than a solution put it in a new post. (replies to comments can be whatever)
  • You can send code in code blocks by using three backticks, the code, and then three backticks or use something such as https://topaz.github.io/paste/ if you prefer sending it through a URL

FAQ

you are viewing a single comment's thread
view the rest of the comments
[โ€“] [email protected] 2 points 11 months ago

Haskell

import Data.ByteString.Char8 (unpack)
import Data.Char (isDigit, isHexDigit)
import Relude
import qualified Relude.Unsafe as Unsafe
import Text.ParserCombinators.ReadP

data Dir = R | D | L | U deriving (Show, Eq)

type Pos = (Int, Int)

data Action = Action Dir Int deriving (Show, Eq)

parse :: ByteString -> Maybe [(Action, Action)]
parse = fmap fst . viaNonEmpty last . readP_to_S (sepBy1 parseAction (char '\n') <* char '\n' <* eof) . unpack
  where
    parseAction = do
      dir <- choice [U <$ char 'U', D <$ char 'D', L <$ char 'L', R <$ char 'R'] <* char ' '
      x <- Unsafe.read <$> munch1 isDigit <* char ' '
      y <- char '(' *> char '#' *> (Unsafe.read . ("0x" ++) <$> count 5 (satisfy isHexDigit))
      dir' <- choice [R <$ char '0', D <$ char '1', L <$ char '2', U <$ char '3'] <* char ')'
      return (Action dir x, Action dir' y)

vertices :: [Action] -> [Pos]
vertices = scanl' (flip step) origin
  where
    step (Action U n) = first $ subtract n
    step (Action D n) = first (+ n)
    step (Action L n) = second $ subtract n
    step (Action R n) = second (+ n)

origin :: Pos
origin = (0, 0)

area, perimeter, solve :: [Action] -> Int
area a = (`div` 2) . abs . sum $ zipWith (-) x y
  where
    (p, rp) = (origin :) &&& (++ [origin]) $ vertices a
    x = zipWith (*) (fst <$> p) (snd <$> rp)
    y = zipWith (*) (snd <$> p) (fst <$> rp)
perimeter = sum . fmap (\(Action _ n) -> n)
solve = area &&& (`div` 2) . perimeter >>> uncurry (+) >>> succ

part1, part2 :: [(Action, Action)] -> Int
part1 = solve . fmap fst
part2 = solve . fmap snd