Day3.hs

{-# LANGUAGE OverloadedStrings #-}
module Day3 where
import Data.List
import Data.Function (on)
import qualified Data.Set as S

import qualified Data.Text as T
import qualified Data.Text.IO as T

import Util
import Linear


data Direction
  = L
  | R
  | U
  | D
  deriving (Show, Read, Eq)

data Offset
  = Offset
  { direction ::  Direction
  , offset    ::  Int
  } deriving (Show, Read, Eq)

type Position = V2 Int

offsetToVec :: Offset -> Position
offsetToVec (Offset dir o) = dirToVec dir ^* o

dirToVec :: Num a => Direction -> V2 a
dirToVec L = V2 (-1) 0
dirToVec R = V2 1 0
dirToVec U = V2 0 1
dirToVec D = V2 0 (-1)

type Directions = [Offset]
type Path = [Position]

parseDirections :: [Text] -> [Directions]
parseDirections = map (toDirection . T.split (== ','))
  where
   toDirection :: [Text] -> Directions
   toDirection = map parseOffset

   parseOffset :: Text -> Offset
   parseOffset str  = Offset (read $ return (T.head str)) (readText $ T.tail str)

directionsToPath :: [Offset] -> [(Position, Position)]
directionsToPath dirs =
   zipOffsets . generateCorners $ dirs
 where
  zipOffsets = zip (map (dirToVec . direction) dirs)
  generateCorners = scanl (^+^) zero . map offsetToVec

expandPath :: [(Position, Position)] -> [Position]
expandPath path = concat $ zipWith expand path (tail path)
  where
   expand (o1, start) (_, end) = takeWhile (/= end) $ iterate (^+^ o1) start

manhattan :: Num a => V2 a -> V2 a -> a
manhattan (V2 x1 y1) (V2 x2 y2) = abs (x1 - x2) + abs (y1 - y2)

run :: IO ()
run = do
  inp <- readInput "day3" T.lines
  let directions    = parseDirections inp
      expandedPaths = map (expandPath . directionsToPath) directions
      visitedPoints = map (S.filter (/= zero) . S.fromList) expandedPaths
      intersections = foldl1' S.intersection visitedPoints
      distances     = S.map (manhattan zero) intersections

  putStrLn "Part 1"
  print $ S.findMin distances
  putStrLn "Part 2"
  print $
    minimum
    . map (sum .map fst)
    . groupBy ((==) `on` snd)
    . sortOn snd
    . filter ((`S.member` intersections) . snd)
    $ concatMap (zip [0..]) expandedPaths