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

@@ -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 []           = []
-    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 -> [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)
+    r = fromLine l1
-    sortedTuple (a, b)
+    s = fromLine l2
-      | a > b = (b, a)
+    rsAngle = r `vCross2D` s
-      | otherwise = (a, b)
+    qprAngle = (p `vSubtract` q) `vCross2D` r
-    intersect1D :: (Int, Int) -> (Int, Int) -> [Int]
+    qpsAngle = (p `vSubtract` q) `vCross2D` s
-    intersect1D (a, b) (c, d) =
+    intersection = q `vAdd` (rsAngle `sDiv` (qprAngle `sMult` s))
-      let
+
-        start = max a c
+    intersect1D :: Line -> Line -> [Vector]
-        end = min b d
+    intersect1D l1@((x1, y1), (x1', y1')) l2@((x2, y2), (x2', y2'))
-      in
+      -- Note that when we're here all cases are colinear (and perhaps
-        [start..end]
+      -- 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
   ]