123 lines
3.3 KiB
Agda
123 lines
3.3 KiB
Agda
module Day5
|
||
|
||
import Prelude
|
||
import Node
|
||
|
||
-- AoC lib?
|
||
nums : String → List Int
|
||
nums s = map stringToInt $ filter (_/=_ "") $ split (trim s) " "
|
||
|
||
data MapEntry : U where
|
||
-- dest / src / len
|
||
MkEntry : Int → Int → Int → MapEntry
|
||
|
||
src : MapEntry -> Int
|
||
src (MkEntry d s l) = s
|
||
|
||
Map : U
|
||
Map = List MapEntry
|
||
|
||
data Problem : U where
|
||
MkProb : List Int → List Map → Problem
|
||
|
||
parseEntry : String → Either String MapEntry
|
||
parseEntry part = case nums part of
|
||
(dest :: src :: len :: Nil) => Right $ MkEntry dest src len
|
||
_ => Left $ "Bad part " ++ part
|
||
|
||
parseMap : List String → Either String Map
|
||
parseMap (_ :: parts) = mapM parseEntry parts
|
||
parseMap x = Left $ "bad map " ++ debugStr x
|
||
|
||
parseFile : String → Either String Problem
|
||
parseFile content = do
|
||
let parts = split (trim content) "\n\n"
|
||
-- TODO deconstructing let
|
||
let (first :: rest) = parts
|
||
| _ => Left "expected some parts"
|
||
let (_ :: x :: Nil) = split first ": "
|
||
| _ => Left $ "expected ': ' in " ++ first
|
||
|
||
let seeds = nums x
|
||
maps <- mapA (λ part => parseMap (split part "\n")) rest
|
||
Right $ MkProb seeds maps
|
||
|
||
applyEntry : Int → MapEntry → Int
|
||
applyEntry n (MkEntry dest src len) =
|
||
if src <= n && n < src + len then n + dest - src else n
|
||
|
||
applyMap : Int → Map → Int
|
||
applyMap n Nil = n
|
||
applyMap n (MkEntry dest src len :: es) =
|
||
if src <= n && n < src + len then n + dest - src else applyMap n es
|
||
|
||
min : Int → Int → Int
|
||
min x y = if x < y then x else y
|
||
|
||
part1 : Problem → IO Unit
|
||
part1 (MkProb seeds maps) = do
|
||
let loc = map (λ s => foldl applyMap s maps) seeds
|
||
let part1 = foldl min 999999999 loc
|
||
putStrLn $ "part1 " ++ show part1
|
||
|
||
Range : U
|
||
Range = Int × Int
|
||
|
||
apply' : Range → List MapEntry → List Range
|
||
apply' (r1, r2) x = case x of
|
||
Nil => (r1, r2) :: Nil
|
||
(MkEntry d s l) :: es =>
|
||
if r2 + r1 <= s then (r1,r2) :: Nil -- map after range
|
||
else if s + l <= r1 then apply' (r1, r2) es -- map before range
|
||
-- take off any bare range on front
|
||
else if r1 < s then
|
||
(r1, s - r1) :: apply' (s, r2 + r1 - s) x
|
||
else if s + l < r1 + r2 then
|
||
let slack = r1 - s in
|
||
(r1 + d - s, l - slack) :: apply' (r1 + l - slack, r2 + slack - l) x
|
||
else
|
||
(r1 + d - s, r2) :: Nil
|
||
|
||
-- probably not super efficient, but it works
|
||
qsort : ∀ a. (a → a → Bool) → List a → List a
|
||
qsort lt Nil = Nil
|
||
qsort lt (x :: xs) = qsort lt (filter (λ y => not $ lt x y) xs) ++ x :: qsort lt (filter (lt x) xs)
|
||
|
||
apply : List Range → List MapEntry → List Range
|
||
apply ranges entries =
|
||
let entries = qsort (\ a b => src a < src b) entries in
|
||
join $ map (\ r => apply' r entries) ranges
|
||
|
||
mkRanges : List Int → Maybe (List Range)
|
||
mkRanges (a :: b :: rs) = do
|
||
rs <- mkRanges rs
|
||
Just $ (a,b) :: rs
|
||
mkRanges Nil = Just Nil
|
||
mkRanges _ = Nothing
|
||
|
||
part2 : Problem → IO Unit
|
||
part2 (MkProb seeds maps) = do
|
||
let (Just ranges) = mkRanges seeds
|
||
| Nothing => printLn "odd seeds!"
|
||
let results = foldl apply ranges maps
|
||
-- putStrLn $ debugStr results
|
||
let answer = foldl min 99999999 $ map fst results
|
||
putStrLn $ "part2 " ++ show answer
|
||
|
||
run : String -> IO Unit
|
||
run fn = do
|
||
putStrLn fn
|
||
text <- readFile fn
|
||
let (Right prob) = parseFile text
|
||
| Left err => putStrLn err
|
||
putStrLn $ debugStr prob
|
||
part1 prob
|
||
part2 prob
|
||
|
||
-- 35 / 46
|
||
-- 282277027 / 11554135
|
||
main : IO Unit
|
||
main = do
|
||
run "aoc2023/day5/eg.txt"
|
||
run "aoc2023/day5/input.txt"
|