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 input <- getContents let vents = parseVents input putStrLn (show (solution1 vents)) putStrLn (show (solution2 vents)) solution1 :: [Line] -> Int solution1 = length . nub . intersectAll . filterDiagonal solution2 :: [Line] -> Int solution2 = length . nub . traceShowId . intersectAll intersectAll :: [Line] -> [Vector] intersectAll = flatten . (map intersectOne) . (combinations 2) where 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 = [] where 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) where isDiagonal :: Line -> Bool isDiagonal ((x, y), (x', y')) = x /= x' && y /= y' parseVents :: String -> [Line] parseVents = tupelize . splitUp where tupelize :: [[[Int]]] -> [Line] tupelize = map subTupelize where subTupelize :: [[Int]] -> Line subTupelize [[a, b], [c, d]] = ((a, b), (c, d)) -- For our parsing purposes, we don't need to cover error -- cases subTupelize _ = undefined splitUp :: String -> [[[Int]]] splitUp = (map (map (map read))) . (map (map (splitByString ","))) . (map (splitByString " -> ")) . lines -- Missing stdlib functions combinations :: Int -> [a] -> [[a]] combinations 0 _ = [[]] combinations n xs = [y:ys | y:xs' <- tails xs , ys <- combinations (n-1) xs'] flatten :: [[a]] -> [a] flatten = foldr1 (++) -- Tests testInput1 :: String testInput1 = unlines [ "0,9 -> 5,9", "8,0 -> 0,8", "9,4 -> 3,4", "2,2 -> 2,1", "7,0 -> 7,4", "6,4 -> 2,0", "0,9 -> 2,9", "3,4 -> 1,4", "0,0 -> 8,8", "5,5 -> 8,2" ] 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)] testIntersect3 = intersect ((0, 0), (0, 5)) ((0, 6), (0, 7)) == [] testIntersect4 = intersect ((0, 0), (5, 0)) ((2, 0), (4, 0)) == [(2, 0), (3, 0), (4, 0)] testIntersect5 = intersect ((0, 0), (0, 5)) ((0, 2), (4, 2)) == [(0, 2)] testIntersect6 = intersect ((0, 0), (0, 5)) ((0, 3), (4, 3)) == [(0, 3)] testIntersect7 = intersect ((1, 0), (1, 5)) ((0, 2), (4, 2)) == [(1, 2)] testIntersect8 = intersect ((4, 0), (4, 5)) ((0, 2), (4, 2)) == [(4, 2)] 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) [ testIntersect1, testIntersect2, testIntersect3, testIntersect4, testIntersect5, testIntersect6, testIntersect7, testIntersect8, testIntersect9, testIntersect10, testIntersect11, testIntersect12, testIntersect13, testIntersect14, testIntersect15, testIntersect16, testIntersect17, testIntersect18 ]