diff --git a/y2019/package.yaml b/y2019/package.yaml index 7bc4e11..7ebc73f 100644 --- a/y2019/package.yaml +++ b/y2019/package.yaml @@ -22,6 +22,7 @@ description: Please see the README on GitHub at = 4.7 && < 5 - split +- containers library: source-dirs: src diff --git a/y2019/src/Day2.hs b/y2019/src/Day2.hs index 16f9e2c..dd5a53e 100644 --- a/y2019/src/Day2.hs +++ b/y2019/src/Day2.hs @@ -1,6 +1,5 @@ module Day2 - ( day2, - processInput + ( day2 ) where import Data.List.Split diff --git a/y2019/src/Day3.hs b/y2019/src/Day3.hs new file mode 100644 index 0000000..edbb4c4 --- /dev/null +++ b/y2019/src/Day3.hs @@ -0,0 +1,84 @@ +module Day3 (day3) where + +import Data.List.Split +import Data.List + +import qualified Data.Map as Map + +import Geo.Point +import Geo.Segment +import Geo.Vector + +type Coords = Map.Map Int [(Int, Int)] + +parseElem :: [Char] -> Vector +parseElem ('U':count) = let n = read count in Vector n 0 +parseElem ('D':count) = let n = read count in Vector (-n) 0 +parseElem ('L':count) = let n = read count in Vector 0 (-n) +parseElem ('R':count) = let n = read count in Vector 0 n +parseElem _ = nilVector + +seg2coords :: (Coords, Coords) -> Segment -> (Coords, Coords) +seg2coords (accH, accV) (Segment (Point x1 y1) (Point x2 y2)) + | x1' == x2' = (accH, Map.insertWith (++) x1' [(y1', y2')] accV) + | y1' == y2' = ((Map.insertWith (++) y1' [(x1', x2')] accH), accV) + | otherwise = (accH, accV) + where x1' = round x1 + x2' = round x2 + y1' = round y1 + y2' = round y2 + +computeIntersections' :: Coords -> [Point] -> Int -> [(Int, Int)] -> [Point] +computeIntersections' hcoords ps vx vys = points ++ ps + where hinRange = Map.filterWithKey (\hy hxs -> (any (inRange hy) vys) && (any (inRange vx) hxs)) hcoords + inRange p (p1, p2) = if p1 < p2 then p1 <= p && p <= p2 else p2 <= p && p <= p1 + points = map (\hy -> Point (fromIntegral vx) (fromIntegral hy)) (Map.keys hinRange) + +computeIntersections :: (Coords, Coords) -> (Coords, Coords) -> [Point] +computeIntersections (vertShape1, horizShape1) (vertShape2, horizShape2) = intersections1 ++ intersections2 + where compute vs hs = Map.foldlWithKey (computeIntersections' hs) [] vs + intersections1 = compute vertShape1 horizShape2 + intersections2 = compute horizShape1 vertShape2 + +parseSegments :: String -> [Segment] +parseSegments input = reverse (linkVectors (map parseElem (splitOn "," input))) + +getCoordsFromSegs :: [Segment] -> (Coords, Coords) +getCoordsFromSegs segments = foldl seg2coords (Map.empty, Map.empty) segments + +getDistanceOnShape :: [Segment] -> Point -> Int +getDistanceOnShape (seg@(Segment s d):xs) p + |p `onSegment` seg = round (manhattanDist s p) + |otherwise = round (manhattanDist s d) + (getDistanceOnShape xs p) +getDistanceOnShape [] _ = 0 + +getIntersectionDist :: [Segment] -> [Segment] -> Point -> Int +getIntersectionDist s1 s2 p = getDistanceOnShape s1 p + getDistanceOnShape s2 p + +day3 :: IO () +day3 = do + putStrLn "AoC 2019 day 3" + putStr "Enter input >" + + firstInput <- getLine + secondInput <- getLine + putStrLn "" + + let firstShape = parseSegments firstInput + let firstCoords = getCoordsFromSegs firstShape + let secondShape = parseSegments secondInput + let secondCoords = getCoordsFromSegs secondShape + + let intersections = computeIntersections firstCoords secondCoords + + let part1 = manhattanDist origin (head (sortOn (manhattanDist origin) intersections)) + putStr "Part1: " + print part1 + putStrLn "" + + let intersectionDists = map (getIntersectionDist firstShape secondShape) intersections + let part2 = minimum intersectionDists + + putStr "Part2: " + print part2 + putStrLn "" diff --git a/y2019/src/DayPicker.hs b/y2019/src/DayPicker.hs index b313c5c..2cc0839 100644 --- a/y2019/src/DayPicker.hs +++ b/y2019/src/DayPicker.hs @@ -7,11 +7,14 @@ import System.Environment import Day1 import Day2 +import Day3 +-- TODO Better way? load :: [String] -> IO () load [] = putStrLn "Usage: script [day]" load ("1":_) = day1 load ("2":_) = day2 +load ("3":_) = day3 load _ = putStrLn "Unavailable date" dayPicker :: IO () diff --git a/y2019/src/Geo/Point.hs b/y2019/src/Geo/Point.hs new file mode 100644 index 0000000..ba45614 --- /dev/null +++ b/y2019/src/Geo/Point.hs @@ -0,0 +1,24 @@ +module Geo.Point + ( Point(..), + origin, + manhattanDist, + add, + sub + ) where + +data Point = Point { x :: Float, y :: Float } deriving (Show) + +instance Eq Point where + (==) (Point x1 y1) (Point x2 y2) = x1 == x2 && y1 == y2 + +origin :: Point +origin = Point 0 0 + +manhattanDist :: Point -> Point -> Float +manhattanDist a b = abs(x(b) - x(a)) + abs(y(b) - y(a)) + +add :: Point -> Point -> Point +add (Point xa ya) (Point xb yb) = Point (xa + xb) (ya + yb) + +sub :: Point -> Point -> Point +sub (Point xa ya) (Point xb yb) = Point (xa - xb) (ya - yb) diff --git a/y2019/src/Geo/Segment.hs b/y2019/src/Geo/Segment.hs new file mode 100644 index 0000000..d5bc35d --- /dev/null +++ b/y2019/src/Geo/Segment.hs @@ -0,0 +1,52 @@ +module Geo.Segment + ( Segment(..), + directionalVect, + segmentIntersection, + linkVectors, + linkPoints, + onSegment + ) where + +import Geo.Point +import Geo.Vector + +data Segment = Segment { src :: Point, dst :: Point } deriving (Show) + +directionalVect :: Segment -> Vector +directionalVect (Segment s d) = directionalVectorFromPoint (d `sub` s) + +onSegment :: Point -> Segment -> Bool +onSegment p@(Point px py) (Segment s@(Point sx sy) d@(Point dx dy)) + | p == d = True + | p == s = True + | sx == dx && sx == px && (between py sy dy) = True + | sy == dy && sy == py && (between px sx dx) = True + | otherwise = False + where between p' s' d' = if s' < d' then p' >= s' && p' <= d' else p' >= d' && p' <= s' + +segmentIntersection :: Segment -> Segment -> Maybe Point +segmentIntersection s1 s2 = + if t1 < 0 || t1 > 1 || t2 < 0 || t2 > 1 + then Nothing + else Just (directionalVectorToPoint (Vector t1 t2) (src(s1))) + where dirS1 = directionalVect s1 + dirS2 = directionalVect s2 + determinant = determinantVector dirS1 dirS2 + dirX = directionalVectorFromPoint (src(s2) `sub` src(s1)) + t1 = (determinantVector dirX dirS2) / determinant + t2 = (determinantVector dirX dirS1) / determinant + +linkPoints :: [Point] -> [Segment] +linkPoints pts = foldl addPointToSegments [] pts + +linkVectors :: [Vector] -> [Segment] +linkVectors vectors = linkPoints (reverse points) + where points = foldl linkVectors' [] vectors + +linkVectors' :: [Point] -> Vector -> [Point] +linkVectors' [] v = [addV2P origin v] +linkVectors' xs@(p:_) v = (addV2P p v):xs + +addPointToSegments :: [Segment] -> Point -> [Segment] +addPointToSegments [] pt = [Segment origin pt] +addPointToSegments xs@(h:_) pt = (Segment (dst(h)) pt):xs diff --git a/y2019/src/Geo/Vector.hs b/y2019/src/Geo/Vector.hs new file mode 100644 index 0000000..ac6235e --- /dev/null +++ b/y2019/src/Geo/Vector.hs @@ -0,0 +1,28 @@ +module Geo.Vector + ( Vector(..), + determinantVector, + directionalVectorFromPoint, + directionalVectorToPoint, + nilVector, + addV2P + ) where + +import Geo.Point + +data Vector = Vector { x :: Float, y :: Float } deriving (Show) + +addV2P :: Point -> Vector -> Point +addV2P (Point xp yp) (Vector xv yv) = Point (xp + xv) (yp + yv) + +nilVector :: Vector +nilVector = Vector 0 0 + +directionalVectorFromPoint :: Point -> Vector +directionalVectorFromPoint (Point px py) = Vector (px / len) (py / len) + where len = sqrt(px * px + py * py) + +determinantVector :: Vector -> Vector -> Float +determinantVector (Vector x1 y1) (Vector x2 y2) = (x1 * y2) - (y1 * x2) + +directionalVectorToPoint :: Vector -> Point -> Point +directionalVectorToPoint (Vector vx vy) (Point px py) = Point (vx * px) (vy * py)