adventofcode-2021/5/ventnavigator.hs

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
  ]