60 lines
1.9 KiB
Haskell
60 lines
1.9 KiB
Haskell
|
{-# LANGUAGE TupleSections #-}
|
||
|
module Day5_1 where
|
||
|
import System.IO (openFile, IOMode (ReadMode), hClose, hGetContents)
|
||
|
import Data.Text (splitOn, unpack, pack)
|
||
|
import Prelude hiding (splitAt)
|
||
|
import Data.List (sort, intersect)
|
||
|
import Data.Bifunctor (bimap)
|
||
|
|
||
|
type Coordinate = (Int, Int)
|
||
|
type Range = ([Int], [Int])
|
||
|
|
||
|
toCoord :: String -> Coordinate
|
||
|
toCoord str = (x, y)
|
||
|
where
|
||
|
xy = splitAt "," str
|
||
|
x = read $ head xy
|
||
|
y = read $ xy !! 1
|
||
|
|
||
|
isStraight :: Coordinate -> Coordinate -> Bool
|
||
|
isStraight c1 c2 = fst c1 == fst c2 || snd c1 == snd c2
|
||
|
|
||
|
splitAt :: String -> String -> [String]
|
||
|
splitAt delimiter str = map unpack $ splitOn (pack delimiter) $ pack str
|
||
|
|
||
|
range :: (Num a, Enum a, Eq a) => a -> a -> [a]
|
||
|
range a b
|
||
|
| a == b = [a]
|
||
|
| otherwise = [a, a + signum (b - a) .. b]
|
||
|
|
||
|
coordsToRange :: (Coordinate, Coordinate) -> Range
|
||
|
coordsToRange (a, b) = bimap (range (fst a)) (range (snd a)) b
|
||
|
|
||
|
points :: (Range, Bool) -> [Coordinate]
|
||
|
points (range, diag)
|
||
|
| diag = uncurry zip range
|
||
|
| otherwise = [ (i,j) | i <- fst range, j <- snd range ]
|
||
|
|
||
|
intersections :: [(Range, Bool)] -> [[Coordinate]]
|
||
|
intersections [] = []
|
||
|
intersections (x:xs) = map (\y -> points x `intersect` points y) xs ++ intersections xs
|
||
|
|
||
|
dedup :: Eq a => [(a, a)] -> [(a, a)]
|
||
|
dedup [] = []
|
||
|
dedup (x:xs) = x : dedup (filter (x /=) xs)
|
||
|
|
||
|
main :: IO ()
|
||
|
main = do
|
||
|
input <- openFile "inputs/5.txt" ReadMode
|
||
|
contents <- hGetContents input
|
||
|
|
||
|
let coords = map toCoord . splitAt " -> " <$> lines contents
|
||
|
-- remove lines that aren't horizontal/vertical and sort them
|
||
|
let straight' = map sort $ filter (\(x:y:_) -> isStraight x y) coords
|
||
|
let gay' = filter (\(x:y:_) -> not $ isStraight x y) coords
|
||
|
let straight = map ((, False) . coordsToRange . (\x -> (head x, x !! 1))) straight'
|
||
|
let gay = map ((, True) . coordsToRange . (\x -> (head x, x !! 1))) gay'
|
||
|
|
||
|
print . length . dedup . concat $ intersections $ straight ++ gay
|
||
|
|
||
|
hClose input
|