WIP: day5: Complete second puzzle
This currently reports correct numbers for the non-diagonal case, but incorrect ones for the diagonal case. The true number lies somewhere between 17880 (probably far too low) and 23062, but all tests I can come up with intersect correctly so I don't understand how the second number is wrong.
This commit is contained in:
parent
b51cfbffc0
commit
0a5ed079ac
GPG key ID:
49670FD774E43268
|
|
@ -1,7 +1,27 @@
|
|||
import Data.List (nub, tails)
|
||||
import Debug.Trace (traceShow, traceShowId)
|
||||
import Parsing (splitByString)
|
||||
|
||||
type Line = ((Int, Int), (Int, Int))
|
||||
type Vector = (Int, Int)
|
||||
|
||||
fromLine :: Line -> Vector
|
||||
fromLine ((x1, y1), (x2, y2)) = (x2 - x1, y2 - y1)
|
||||
|
||||
vCross2D :: Vector -> Vector -> Int
|
||||
vCross2D (x1, y1) (x2, y2) = x1 * y2 - y1 * x2
|
||||
|
||||
vSubtract :: Vector -> Vector -> Vector
|
||||
vSubtract (x1, y1) (x2, y2) = (x2 - x1, y2 - y1)
|
||||
|
||||
vAdd :: Vector -> Vector -> Vector
|
||||
vAdd (x1, y1) (x2, y2) = (x1 + x2, y1 + y2)
|
||||
|
||||
sMult :: Int -> Vector -> Vector
|
||||
sMult s (x, y) = (s * x, s * y)
|
||||
|
||||
sDiv :: Int -> Vector -> Vector
|
||||
sDiv s (x, y) = (x `quot` s, y `quot` s)
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
|
|
@ -9,56 +29,92 @@ main = do
|
|||
let
|
||||
vents = parseVents input
|
||||
putStrLn (show (solution1 vents))
|
||||
putStrLn (show (solution2 vents))
|
||||
|
||||
solution1 :: [Line] -> Int
|
||||
solution1 = length . nub . intersectAll . filterDiagonal
|
||||
|
||||
intersectAll :: [Line] -> [(Int, Int)]
|
||||
solution2 :: [Line] -> Int
|
||||
solution2 = length . nub . traceShowId . intersectAll
|
||||
|
||||
intersectAll :: [Line] -> [Vector]
|
||||
intersectAll =
|
||||
flatten . (map intersectOne) . (combinations 2)
|
||||
where
|
||||
intersectOne :: [Line] -> [(Int, Int)]
|
||||
intersectOne :: [Line] -> [Vector]
|
||||
intersectOne [] = []
|
||||
intersectOne (vent:others) = flatten (map (intersect vent) others)
|
||||
-- "other" is a vector of size 1, so (head other) is fine
|
||||
intersectOne (vent:other) = intersect vent (head other)
|
||||
|
||||
intersect :: Line -> Line -> [(Int, Int)]
|
||||
intersect ((x1, y1), (x1', y1')) ((x2, y2), (x2', y2'))
|
||||
-- Colinear - In these cases, we may have multiple intersections
|
||||
| all (== x1) [x1', x2, x2'] =
|
||||
(map (\y -> (x1,y)) (intersect1D (sortedTuple (y1, y1')) (sortedTuple (y2, y2'))))
|
||||
| all (== y1) [y1', y2, y2'] =
|
||||
(map (\x -> (x,y1)) (intersect1D (sortedTuple (x1, x1')) (sortedTuple (x2, x2'))))
|
||||
-- Not colinear - We can find out if these intersect by simply
|
||||
-- checking whether the second line goes through the
|
||||
-- horizontal/vertical range of the first (whichever line the first
|
||||
-- segment lives on)
|
||||
| (x1 == x1' && y2 == y2') =
|
||||
if (min x2 x2') <= x1 && (max x2 x2') >= x1 && (min y1 y1') <= y2 && (max y1 y1') >= y2
|
||||
then
|
||||
[(x1,y2)]
|
||||
else
|
||||
intersect :: Line -> Line -> [Vector]
|
||||
intersect l1@(p, _) l2@(q, _)
|
||||
-- Colinear
|
||||
| rsAngle == 0 && qprAngle == 0 =
|
||||
intersect1D l1 l2
|
||||
|
||||
-- Parallel, non-intersecting
|
||||
| rsAngle == 0 && qprAngle /= 0 =
|
||||
[]
|
||||
| (y1 == y1' && x2 == x2') =
|
||||
if (min y2 y2') <= y1 && (max y2 y2') >= y1 && (min x1 x1') <= x2 && (max x1 x1') >= x2
|
||||
then
|
||||
[(x2,y1)]
|
||||
else
|
||||
|
||||
-- Intersecting
|
||||
| rsAngle /= 0
|
||||
&& qpsAngle `dividesUnit` rsAngle
|
||||
&& qprAngle `dividesUnit` rsAngle =
|
||||
[intersection]
|
||||
|
||||
-- Non-parllel, non-intersecting
|
||||
| otherwise =
|
||||
[]
|
||||
-- In all other cases, we consider the lines not to intersect, since
|
||||
-- diagonal lines are out of scope
|
||||
| otherwise = []
|
||||
|
||||
where
|
||||
sortedTuple :: (Int, Int) -> (Int, Int)
|
||||
r = fromLine l1
|
||||
s = fromLine l2
|
||||
rsAngle = r `vCross2D` s
|
||||
qprAngle = (p `vSubtract` q) `vCross2D` r
|
||||
qpsAngle = (p `vSubtract` q) `vCross2D` s
|
||||
intersection = q `vAdd` (rsAngle `sDiv` (qprAngle `sMult` s))
|
||||
|
||||
intersect1D :: Line -> Line -> [Vector]
|
||||
intersect1D l1@((x1, y1), (x1', y1')) l2@((x2, y2), (x2', y2'))
|
||||
-- Note that when we're here all cases are colinear (and perhaps
|
||||
-- overlapping). This means that the lines must occupy the same
|
||||
-- axes, and we only need to check the orientation of one.
|
||||
|
||||
-- Diagonal lines; if these overlap, they overlap in a range
|
||||
-- given by the overlap in their projections on the x and y axis
|
||||
| isDiagonal l1 = zip (overlap (x1, x1') (x2, x2')) (overlap (y1, y1') (y2, y2'))
|
||||
-- Others overlap in the range where their respective x/y axis
|
||||
-- projection overlaps, and the other doesn't change
|
||||
| isHorizontal l1 = zip (repeat x1) (overlap (y1, y1') (y2, y2'))
|
||||
| isVertical l1 = zip (overlap (x1, x1') (x2, x2')) (repeat y1)
|
||||
where
|
||||
isDiagonal :: Line -> Bool
|
||||
isDiagonal ((x, y), (x', y')) = x /= x' && y /= y'
|
||||
isHorizontal :: Line -> Bool
|
||||
isHorizontal ((x, y), (x', y')) = x == x'
|
||||
isVertical :: Line -> Bool
|
||||
isVertical ((x, y), (x', y')) = y == y'
|
||||
overlap :: Vector -> Vector -> [Int]
|
||||
overlap (a, b) (c, d) =
|
||||
let
|
||||
(a', b') = sortedTuple (a, b)
|
||||
(c', d') = sortedTuple (c, d)
|
||||
start = max a' c'
|
||||
end = min b' d'
|
||||
in
|
||||
[start..end]
|
||||
where
|
||||
sortedTuple :: Vector -> Vector
|
||||
sortedTuple (a, b)
|
||||
| a > b = (b, a)
|
||||
| otherwise = (a, b)
|
||||
intersect1D :: (Int, Int) -> (Int, Int) -> [Int]
|
||||
intersect1D (a, b) (c, d) =
|
||||
let
|
||||
start = max a c
|
||||
end = min b d
|
||||
in
|
||||
[start..end]
|
||||
|
||||
-- Whether a division will give a number 0 <= x <= 1
|
||||
dividesUnit :: Int -> Int -> Bool
|
||||
dividesUnit a b
|
||||
| a == 0 = True
|
||||
| a > 0 = a <= b
|
||||
| a < 0 = a >= b && b < 0
|
||||
|
||||
filterDiagonal :: [Line] -> [Line]
|
||||
filterDiagonal = filter (not . isDiagonal)
|
||||
|
|
@ -107,6 +163,7 @@ testInput1 = unlines [
|
|||
]
|
||||
|
||||
test1 = solution1 (parseVents testInput1)
|
||||
test2 = solution2 (parseVents testInput1)
|
||||
|
||||
testIntersect1 = intersect ((0, 0), (0, 5)) ((0, 2), (0, 4)) == [(0, 2), (0, 3), (0, 4)]
|
||||
testIntersect2 = intersect ((0, 0), (0, 5)) ((0, 5), (0, 6)) == [(0, 5)]
|
||||
|
|
@ -120,6 +177,13 @@ testIntersect9 = intersect ((1, 0), (1, 5)) ((2, 2), (4, 2)) == []
|
|||
testIntersect10 = intersect ((9, 4), (3, 4)) ((7, 0), (7, 4)) == [(7, 4)]
|
||||
testIntersect11 = intersect ((2, 2), (2, 1)) ((3, 4), (1, 4)) == []
|
||||
testIntersect12 = intersect ((0, 9), (5, 9)) ((7, 0), (7, 4)) == []
|
||||
testIntersect13 = intersect ((9, 4), (3, 4)) ((3, 4), (1, 4)) == [(3, 4)]
|
||||
testIntersect14 = intersect ((0, 0), (1, 1)) ((1, 1), (2, 2)) == [(1, 1)]
|
||||
testIntersect15 = intersect ((0, 0), (3, 3)) ((1, 1), (3, 3)) == [(1, 1), (2, 2), (3, 3)]
|
||||
testIntersect16 = intersect ((0, 0), (3, 3)) ((4, 4), (8, 8)) == []
|
||||
testIntersect17 = intersect ((0, 1), (1, 2)) ((1, 2), (3, 4)) == [(1, 2)]
|
||||
testIntersect18 = intersect ((0, 1), (3, 4)) ((1, 2), (3, 4)) == [(1, 2), (2, 3), (3, 4)]
|
||||
testIntersect19 = intersect ((0, 1), (3, 4)) ((0, 0), (3, 3)) == []
|
||||
|
||||
testIntersect =
|
||||
all (== True) [
|
||||
|
|
@ -131,5 +195,14 @@ testIntersect =
|
|||
testIntersect6,
|
||||
testIntersect7,
|
||||
testIntersect8,
|
||||
testIntersect9
|
||||
testIntersect9,
|
||||
testIntersect10,
|
||||
testIntersect11,
|
||||
testIntersect12,
|
||||
testIntersect13,
|
||||
testIntersect14,
|
||||
testIntersect15,
|
||||
testIntersect16,
|
||||
testIntersect17,
|
||||
testIntersect18
|
||||
]
|
||||
|
|
|
|||
Loading…
Reference in a new issue