415055dcc2
For now this applies to Haskell only, and it may turn out to be tricky for the Rust implementation. In practice, the limitation hasn't turned out to be important, and we could even go the other way and use `Integer` everywhere. This does however at least help with debugging, as well as just being conceptually right. The `nil` and `(/\)` functions are intended to be overloaded to work for other list-like things in a later commit, and from there we will investigate using `OverloadedLists` and `RebindableSyntax` to recover standard list syntax, although there are probably limitations due to `(:)` being special.
71 lines
2.6 KiB
Haskell
71 lines
2.6 KiB
Haskell
module Puzzles.Day9 (puzzle) where
|
|
|
|
import Pre
|
|
|
|
puzzle :: Puzzle
|
|
puzzle =
|
|
Puzzle
|
|
{ number = 9
|
|
, parser = const $ (V2 <$> decimal <* single ',' <*> decimal) `sepEndBy1` newline
|
|
, parts =
|
|
( maximum
|
|
. fmap (squareSize . uncurry Rectangle)
|
|
. fromMaybe (error "input too small")
|
|
. nonEmpty
|
|
. allUnorderedPairs False
|
|
)
|
|
/\ ( \points ->
|
|
let path =
|
|
fromMaybe (error "malformed line")
|
|
. traverse mkLine
|
|
$ (last points', head points') :| adjacentPairs points
|
|
where
|
|
points' = fromMaybe (error "empty input") $ nonEmpty points
|
|
in snd
|
|
. fromMaybe (error "no solutions")
|
|
. find (not . flip any path . lineIntersectsSquare . fst)
|
|
. sortOn (Down . snd)
|
|
. fmap ((id &&& squareSize) . uncurry Rectangle)
|
|
$ allUnorderedPairs False points
|
|
)
|
|
/\ nil
|
|
, extraTests = mempty
|
|
}
|
|
|
|
data Rectangle = Rectangle
|
|
{ corner1 :: V2 Int
|
|
, corner2 :: V2 Int
|
|
}
|
|
deriving (Show)
|
|
squareSize :: Rectangle -> Int
|
|
squareSize Rectangle{corner1, corner2} = (\(V2 x y) -> x * y) . (+ 1) . fmap abs $ corner1 - corner2
|
|
|
|
data Line
|
|
= LineHorizontal {y :: Int, x1 :: Int, x2 :: Int}
|
|
| LineVertical {x :: Int, y1 :: Int, y2 :: Int}
|
|
deriving (Show)
|
|
mkLine :: (V2 Int, V2 Int) -> Maybe Line
|
|
mkLine (V2 x1 y1, V2 x2 y2)
|
|
| y1 == y2 = Just $ LineHorizontal{y = y1, x1, x2}
|
|
| x1 == x2 = Just $ LineVertical{x = x1, y1, y2}
|
|
| otherwise = Nothing
|
|
|
|
data Interval = Interval Int Int deriving (Show)
|
|
compareToInterval :: Int -> Interval -> Ordering
|
|
compareToInterval n (Interval l u)
|
|
| n <= l = LT
|
|
| n >= u = GT
|
|
| otherwise = EQ
|
|
|
|
squareIntervals :: Rectangle -> V2 Interval
|
|
squareIntervals Rectangle{corner1, corner2} = uncurry Interval . sortPair <$> liftA2 (,) corner1 corner2
|
|
|
|
lineIntersectsSquare :: Rectangle -> Line -> Bool
|
|
lineIntersectsSquare (squareIntervals -> V2 intervalX intervalY) = \case
|
|
LineHorizontal{y, x1, x2} ->
|
|
compareToInterval y intervalY == EQ
|
|
&& compareToInterval x1 intervalX /= compareToInterval x2 intervalX
|
|
LineVertical{x, y1, y2} ->
|
|
compareToInterval x intervalX == EQ
|
|
&& compareToInterval y1 intervalY /= compareToInterval y2 intervalY
|