From 0a5ed079ac26632b8cfabedd3c83d56c988867ab Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Tristan=20Dani=C3=ABl=20Maat?= Date: Wed, 8 Dec 2021 00:37:26 +0000 Subject: [PATCH] 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. --- 5/ventnavigator.hs | 157 +++++++++++++++++++++++++++++++++------------ 1 file changed, 115 insertions(+), 42 deletions(-) diff --git a/5/ventnavigator.hs b/5/ventnavigator.hs index 251a29e..bda3a32 100644 --- a/5/ventnavigator.hs +++ b/5/ventnavigator.hs @@ -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 [] = [] - intersectOne (vent:others) = flatten (map (intersect vent) others) + intersectOne :: [Line] -> [Vector] + intersectOne [] = [] + -- "other" is a vector of size 1, so (head other) is fine + intersectOne (vent:other) = intersect vent (head other) + +intersect :: Line -> Line -> [Vector] +intersect l1@(p, _) l2@(q, _) + -- Colinear + | rsAngle == 0 && qprAngle == 0 = + intersect1D l1 l2 + + -- Parallel, non-intersecting + | rsAngle == 0 && qprAngle /= 0 = + [] + + -- Intersecting + | rsAngle /= 0 + && qpsAngle `dividesUnit` rsAngle + && qprAngle `dividesUnit` rsAngle = + [intersection] + + -- Non-parllel, non-intersecting + | otherwise = + [] -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 - [] - | (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 - [] - -- 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) - 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] + 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) + + -- 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 ]