35 lines
1.1 KiB
Haskell
35 lines
1.1 KiB
Haskell
module Main where
|
|
|
|
import System.Environment (getArgs)
|
|
|
|
import Data.List (sort)
|
|
import Data.Function (on)
|
|
|
|
import Text.Parsec (parse, many, char, endBy)
|
|
import Text.ParserCombinators.Parsec (GenParser)
|
|
import Text.ParserCombinators.Parsec.Number (decimal)
|
|
|
|
line :: GenParser Char st (Int, Int)
|
|
line = decimal >>= \l -> many (char ' ') >> decimal >>= \r -> return (l, r)
|
|
|
|
locationIDs :: GenParser Char st [(Int, Int)]
|
|
locationIDs = endBy line (char '\n')
|
|
|
|
part1 :: [Int] -> [Int] -> Int
|
|
part1 l r = sum (zipWith (curry (abs . uncurry (-))) l r)
|
|
|
|
part2 :: [Int] -> [Int] -> Int
|
|
part2 l r = (sum . map (\x -> sum ((map (const x) . filter (==x)) r))) l
|
|
|
|
main :: IO ()
|
|
main = do
|
|
args <- getArgs
|
|
(fp:_) <- return args
|
|
content <- readFile fp
|
|
case parse locationIDs fp content of
|
|
Left e -> putStrLn ("Input file is incorrectly formatted : " ++ show e)
|
|
Right ids -> do
|
|
let (ls, rs) = uncurry ((,) `on` sort) (unzip ids)
|
|
putStrLn ("Solution (Part 1) : " ++ show (part1 ls rs))
|
|
putStrLn ("Solution (Part 2) : " ++ show (part2 ls rs))
|