dunham/newt
1
0
Fork 0
Code Issues Pull Requests Actions 1 Packages Projects Releases Wiki Activity

Day14, move stuff to libraries, aoc2024 -> samples, fix FC on an error

Browse Source
This commit is contained in:
Steve Dunham
2024-12-14 08:14:43 -08:00
parent 29abacfa6c
commit c5368edbbf
64 changed files with 241 additions and 1121 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
playground/samples/aoc2024/Aoc.newt
View File

@@ -1 +1 @@
../../../aoc2023/Aoc.newt
../../../aoc2024/Aoc.newt

60
playground/samples/aoc2024/Day1.newt
View File

@@ -1,60 +0,0 @@
module Day1
import Prelude
import Node
import Aoc
pairUp : List Int -> List (Int × Int)
pairUp (a :: b :: rest) = (a,b) :: pairUp rest
pairUp (a :: rest) = trace "fail" Nil
pairUp Nil = Nil
dist : (Int × Int) → Int
dist (a,b) = if a < b then b - a else a - b
part1 : String -> Int
part1 text =
let pairs = pairUp $ join $ map nums $ split text "\n"
left = qsort _<_ $ map fst pairs
right = qsort _<_ $ map snd pairs
dists = map dist $ zip left right
in foldl _+_ 0 dists
lookup : ∀ a b. {{Eq a}} → a → List (a × b) → Maybe b
lookup key Nil = Nothing
lookup key ((k,v) :: rest) = if k == key then Just v else lookup key rest
coalesce : List Int → Int -> List (Int × Int)
coalesce (a :: b :: rest) cnt =
if a == b then coalesce (b :: rest) (cnt + 1) else (a,cnt) :: coalesce (b :: rest) 1
coalesce (a :: Nil) cnt = (a,cnt) :: Nil
coalesce Nil cnt = Nil
cross : List (Int × Int) → List (Int × Int) → Int → Int
cross xs ys acc =
let ((a,cnt) :: xs') = xs | Nil => acc in
let ((b,cnt') :: ys') = ys | Nil => acc in
if a == b then cross xs' ys' (acc + a * cnt * cnt')
else if a < b then cross xs' ys acc
else cross xs ys' acc
part2 : String → Int
part2 text =
let pairs = pairUp $ join $ map nums $ split text "\n"
left = coalesce (qsort _<_ $ map fst pairs) 1
right = coalesce (qsort _<_ $ map snd pairs) 1
in cross left right 0
run : String -> IO Unit
run fn = do
putStrLn fn
text <- readFile fn
putStrLn $ "part1 " ++ show (part1 text)
putStrLn $ "part2 " ++ show (part2 text)
main : IO Unit
main = do
run "aoc2024/day1/eg.txt"
run "aoc2024/day1/input.txt"

1
playground/samples/aoc2024/Day1.newt Symbolic link
View File

@@ -0,0 +1 @@
../../../aoc2024/Day1.newt

1
playground/samples/aoc2024/Day10.newt Symbolic link
View File

@@ -0,0 +1 @@
../../../aoc2024/Day10.newt

1
playground/samples/aoc2024/Day11.newt Symbolic link
View File

@@ -0,0 +1 @@
../../../aoc2024/Day11.newt

1
playground/samples/aoc2024/Day11b.newt Symbolic link
View File

@@ -0,0 +1 @@
../../../aoc2024/Day11b.newt

1
playground/samples/aoc2024/Day12.newt Symbolic link
View File

@@ -0,0 +1 @@
../../../aoc2024/Day12.newt

1
playground/samples/aoc2024/Day13.newt Symbolic link
View File

@@ -0,0 +1 @@
../../../aoc2024/Day13.newt

1
playground/samples/aoc2024/Day14.newt Symbolic link
View File

@@ -0,0 +1 @@
../../../aoc2024/Day14.newt

51
playground/samples/aoc2024/Day2.newt
View File

@@ -1,51 +0,0 @@
module Day2
import Prelude
import Node
import Aoc
decr : List Int → Bool
decr (x :: y :: _) = y < x
decr _ = False
diff : Int → Int → Int
diff x y = if x < y then y - x else x - y
isSafe : Bool → List Int → Bool
isSafe decr (x :: y :: rest) =
let d = diff x y
good = 0 < d && d < 4
safe = if x < y then not decr && good else decr && good in
if safe then isSafe decr (y :: rest) else False
isSafe _ _ = True
check : List Int → Bool
check x = isSafe (decr x) x
any : ∀ a. (a → Bool) → List a → Bool
any f xs = foldl (_||_) False $ map f xs
alts : List Int → List (List Int)
alts Nil = Nil
alts (x :: xs) = xs :: map (_::_ x) (alts xs)
-- I want lean's #eval here
parse : String → List (List Int)
parse text = map nums $ split (trim text) "\n"
run : String -> IO Unit
run fn = do
putStrLn fn
text <- readFile fn
let stuff = parse text
let good = filter check stuff
putStrLn $ "part1 " ++ show (length good)
let good = filter (any check ∘ alts) stuff
putStrLn $ "part2 " ++ show (length good)
main : IO Unit
main = do
run "aoc2024/day2/eg.txt"
run "aoc2024/day2/input.txt"

1
playground/samples/aoc2024/Day2.newt Symbolic link
View File

@@ -0,0 +1 @@
../../../aoc2024/Day2.newt

121
playground/samples/aoc2024/Day3.newt
View File

@@ -1,121 +0,0 @@
module Day3
import Prelude
import Node
import Aoc
Parser : U → U
Parser a = List Char → Maybe (a × List Char)
instance Monad Parser where
pure a = \ cs => Just (a, cs)
bind ma mab = \ cs => ma cs >>= uncurry mab
instance Alternative Parser where
pa <|> pb = \ cs => case pa cs of
Nothing => pb cs
res => res
fail : ∀ a. Parser a
fail = \ cs => Nothing
satisfy : (Char → Bool) → Parser Char
satisfy pred = λ cs => case cs of
Nil => Nothing
(c :: cs) => if pred c then Just (c, cs) else Nothing
match : Char → Parser Char
match d = satisfy (_==_ d)
any : Parser Char
any = satisfy (λ _ => True)
some many : ∀ a. Parser a → Parser (List a)
many p = some p <|> pure Nil
some p = do
v <- p
vs <- many p
pure (v :: vs)
pnum : Parser Int
pnum = do
chars <- many (satisfy isDigit)
if S (S (S Z)) < length chars then fail
else pure $ stringToInt $ pack chars
data Inst : U where
Mult : Int → Int → Inst
Do : Inst
Dont : Inst
mul : Parser Inst
mul = do
match 'm'
match 'u'
match 'l'
match '('
x <- pnum
match ','
y <- pnum
match ')'
pure $ Mult x y
pdo : Parser Inst
pdo = do
match 'd'
match 'o'
match '('
match ')'
pure Do
pdont : Parser Inst
pdont = do
match 'd'
match 'o'
match 'n'
match '\''
match 't'
match '('
match ')'
pure Dont
some' many' : ∀ a. Parser a → Parser (List a)
many' p = do
pure MkUnit
some' p <|> (any >> many' p) <|> pure Nil
some' p = do
v <- p
vs <- many' p
pure (v :: vs)
inst : Parser Inst
inst = mul <|> pdo <|> pdont
pfile : Parser (List Inst)
pfile = many' inst
value : Inst → Int
value (Mult x y) = x * y
value _ = 0
part2 : List Inst → Bool → Int → Int
part2 Nil _ acc = acc
part2 (Do :: insts) _ acc = part2 insts True acc
part2 (Dont :: insts) _ acc = part2 insts False acc
part2 (_ :: insts) False acc = part2 insts False acc
part2 (Mult x y :: insts) True acc = part2 insts True (acc + x * y)
run : String → IO Unit
run fn = do
putStrLn fn
text <- trim <$> readFile fn
let (Just (insts, Nil)) = pfile (unpack text) | _ => putStrLn "parse failed"
let part1 = foldl _+_ 0 $ map value insts
putStrLn $ "part1 " ++ show part1
putStrLn $ "part2 " ++ show (part2 insts True 0)
main : IO Unit
main = do
run "aoc2024/day3/eg.txt"
run "aoc2024/day3/input.txt"

1
playground/samples/aoc2024/Day3.newt Symbolic link
View File

@@ -0,0 +1 @@
../../../aoc2024/Day3.newt

76
playground/samples/aoc2024/Day4.newt
View File

@@ -1,76 +0,0 @@
module Day4
import Prelude
import Node
import Aoc
data Problem : U where
P : Int → String → Problem
get : Problem → Int → Int → Char
get (P size text) r c =
if r < 0 || size <= r then '.'
else if c < 0 || size <= c then '.'
else sindex text (r * (size + 1) + c)
check : Problem → Int → Int → Int × Int → Int
check prob r c (dr,dc) =
if (get prob r c) /= 'X' then 0
else if (get prob (r + dr) (c + dc)) /= 'M' then 0
else if (get prob (r + 2 * dr) (c + 2 * dc)) /= 'A' then 0
else if (get prob (r + 3 * dr) (c + 3 * dc)) /= 'S' then 0
else 1
dirs : List (Int × Int)
dirs = tail $ _,_ <$> 0 :: 0 - 1 :: 1 :: Nil <*> 0 :: 0 - 1 :: 1 :: Nil
part1 : Problem → Int
part1 (P size text) = go 0 0 0
where
go : Int → Int → Int → Int
go acc r c =
if r == size then acc else
if c == size then go acc (r + 1) 0 else
let acc = foldl _+_ acc $ map (check (P size text) r c) dirs in
go acc r (c + 1)
pats : List (Char × Char × Char × Char)
pats = ('M', 'M', 'S', 'S') ::
('S', 'M', 'M', 'S') ::
('S', 'S', 'M', 'M') ::
('M', 'S', 'S', 'M') ::
Nil
check2 : Problem → Int → Int → (Char × Char × Char × Char) → Int
check2 prob r c (w,x,y,z) =
if (get prob r c) /= 'A' then 0
else if (get prob (r - 1) (c - 1)) /= w then 0
else if (get prob (r - 1) (c + 1)) /= x then 0
else if (get prob (r + 1) (c + 1)) /= y then 0
else if (get prob (r + 1) (c - 1)) /= z then 0
else 1
part2 : Problem → Int
part2 (P size text) = go 0 0 0
where
go : Int → Int → Int → Int
go acc r c =
if r == size then acc else
if c == size then go acc (r + 1) 0 else
let acc = foldl _+_ acc $ map (check2 (P size text) r c) pats in
go acc r (c + 1)
run : String -> IO Unit
run fn = do
putStrLn fn
text <- readFile fn
let lines = split (trim text) "\n"
-- I'm going to assume it's square for convenience
let size = length lines
printLn $ "part1 " ++ show (part1 $ P (cast size) text)
printLn $ "part2 " ++ show (part2 $ P (cast size) text)
main : IO Unit
main = do
run "aoc2024/day4/eg.txt"
run "aoc2024/day4/input.txt"

1
playground/samples/aoc2024/Day4.newt Symbolic link
View File

@@ -0,0 +1 @@
../../../aoc2024/Day4.newt

77
playground/samples/aoc2024/Day5.newt
View File

@@ -1,77 +0,0 @@
module Day5
import Prelude
import Node
import Aoc
import SortedMap
data Prob : U where
MkProb : List (Int × Int) -> List (List Int) → Prob
parseRule : String → Maybe (Int × Int)
parseRule txt =
let (a :: b :: Nil) = nums' "|" txt | _ => Nothing
in Just (a,b)
parse : String → Maybe Prob
parse text = do
let (a :: b :: Nil) = split (trim text) "\n\n" | pts => Nothing
rules <- traverse parseRule $ split a "\n"
let updates = map (nums' ",") $ split b "\n"
Just $ MkProb rules updates
RuleMap : U
RuleMap = SortedMap Int (List Int)
getDisallowed : Int → RuleMap → List Int
getDisallowed key rmap = fromMaybe Nil (map snd $ lookupMap key rmap)
mkRuleMap : List (Int × Int) -> RuleMap
mkRuleMap rules = foldl go EmptyMap rules
where
go : RuleMap → Int × Int → RuleMap
go rmap (b,a) = updateMap a (b :: getDisallowed a rmap) rmap
scan : RuleMap → List Int -> List Int -> Bool
scan rmap interdit Nil = True
scan rmap interdit (x :: xs) =
if elem x interdit then False
else scan rmap (getDisallowed x rmap ++ interdit) xs
fix : RuleMap → List Int → List Int
fix rmap Nil = Nil
fix rmap (x :: xs) =
let interdit = getDisallowed x rmap in
let (prefix,rest) = partition (flip elem interdit) xs
in case prefix of
Nil => x :: fix rmap rest
ys => fix rmap (ys ++ x :: rest)
middle : List Int -> Int
middle xs = go xs xs
where
go : List Int → List Int → Int
go (x :: xs) (_ :: _ :: ys) = go xs ys
go (x :: xs) (_ :: ys) = x
go _ _ = 0
run : String -> IO Unit
run fn = do
putStrLn fn
text <- readFile fn
let (Just prob) = parse text | _ => putStrLn "Parse Error"
let (MkProb rules things) = prob
let rmap = mkRuleMap rules
let good = filter (scan rmap Nil) things
let part1 = foldl _+_ 0 $ map middle good
let bad = filter (not ∘ scan rmap Nil) things
putStrLn $ "part1 " ++ show part1
let fixed = map (fix rmap) bad
printLn $ length bad
let part2 = foldl _+_ 0 $ map middle fixed
putStrLn $ "part2 " ++ show part2
main : IO Unit
main = do
run "aoc2024/day5/eg.txt"
run "aoc2024/day5/input.txt"

1
playground/samples/aoc2024/Day5.newt Symbolic link
View File

@@ -0,0 +1 @@
../../../aoc2024/Day5.newt

132
playground/samples/aoc2024/Day6.newt
View File

@@ -1,132 +0,0 @@
module Day6
import Prelude
import Node
import Aoc
import SortedMap
Point : U
Point = Int × Int
instance Eq Point where
(a,b) == (c,d) = a == c && b == d
instance Ord Point where
(a,b) < (c,d) = a < c || a == c && b < d
Grid : U
Grid = SortedMap Point Char
loadData : String → Grid
loadData text = go (unpack text) 0 0 EmptyMap
where
go : List Char → Int → Int → SortedMap Point Char → SortedMap Point Char
go Nil r c map = map
go ('\n' :: cs) r c map = go cs (r + 1) 0 map
go (x :: xs) r c map = go xs r (c + 1) $ updateMap (r,c) x map
data Dir : U where North East South West : Dir
instance Show Dir where
show North = "N"
show East = "E"
show South = "S"
show West = "W"
instance Ord Dir where
a < b = show a < show b
instance Eq (Point × Dir) where
(a,b) == (c,d) = a == c && show b == show d
instance Ord (Point × Dir) where
(a,b) < (c,d) =
if a < c then True
else if a /= c then False
else b < d
Done : U
Done = SortedMap (Point × Dir) Unit
turn : Dir → Dir
turn North = East
turn East = South
turn South = West
turn West = North
instance Cast Dir Char where
cast North = '^'
cast East = '>'
cast South = 'v'
cast West = '<'
step : Dir → Point → Point
step North (r, c) = (r - 1, c)
step East (r, c) = (r, c + 1)
step South (r, c) = (r + 1, c)
step West (r, c) = (r, c - 1)
bad : Point → Bool
bad (x,y) = x < 0 || y < 0
-- third is
walk : Dir → Point → Grid → Grid
walk dir pos grid =
let grid = updateMap pos 'X' grid in
let pos' = step dir pos in
case lookupMap pos' grid of
Just (_, '#') => walk (turn dir) pos grid
Nothing => grid
_ => walk dir pos' grid
checkLoop : Grid → Done → Dir → Point → Bool
checkLoop grid done dir pos =
let (Nothing) = lookupMap (pos,dir) done | _ => True in
let done = updateMap (pos, dir) MkUnit done
pos' = step dir pos
in case lookupMap pos' grid of
Nothing => False
Just (_, '#') => checkLoop grid done (turn dir) pos
Just _ => checkLoop grid done dir pos'
part2 : Dir → Point → Grid → Done → List Point → List Point
part2 dir pos grid done sol =
let done = updateMap (pos, dir) MkUnit done
grid = updateMap pos 'X' grid
turnDir = turn dir
turnPos = step turnDir pos
pos' = step dir pos in
case lookupMap pos' grid of
Nothing => sol
Just (_, '#') => part2 (turn dir) pos grid done sol
Just (_, 'X') => part2 dir pos' grid done sol
Just (_, '.') => if checkLoop (updateMap pos' '#' grid) done turnDir pos
then part2 dir pos' grid done (pos' :: sol)
else part2 dir pos' grid done sol
Just x => part2 (trace ("WAT " ++ debugStr x) dir) pos' grid done sol
lookupV : ∀ a. Char → List (a × Char) → Maybe a
lookupV _ Nil = Nothing
lookupV needle ((k,v) :: rest) =
if v == needle then Just k else lookupV needle rest
run : String -> IO Unit
run fn = do
putStrLn fn
text <- readFile fn
let grid = loadData text
let (Just pos) = lookupV '^' (toList grid) | _ => putStrLn "no guard"
let grid' = walk North pos grid
let xs = filter (\ x => 'X' == snd x) $ toList grid'
let part1 = length xs
putStrLn $ "part1 " ++ show part1
let cands = part2 North pos grid EmptyMap Nil
-- debugLog $ length cands -- turns out nub isn't needed for these cases, but we'll leave it in
putStrLn $ "part2 " ++ show (length $ ordNub cands)
printLn $ length $ toList grid
main : IO Unit
main = do
run "aoc2024/day6/eg.txt"
run "aoc2024/day6/input.txt"

1
playground/samples/aoc2024/Day6.newt Symbolic link
View File

@@ -0,0 +1 @@
../../../aoc2024/Day6.newt

58
playground/samples/aoc2024/Day7.newt
View File

@@ -1,58 +0,0 @@
module Day7
import Prelude
import Node
import Aoc
Prob : U
Prob = Int × List Int
cases : Int → Int → List Int → Bool
cases goal acc Nil = goal == acc
cases goal acc (x :: xs) =
if goal < acc then False
else if cases goal (x + acc) xs then True
else cases goal (x * acc) xs
part1 : Prob → Bool
part1 (goal, x :: xs) = cases goal x xs
part1 _ = False
cat : Int → Int → Int
cat x y = stringToInt $ show x ++ show y
cases2 : Int → Int → List Int → Bool
cases2 goal acc Nil = goal == acc
cases2 goal acc (x :: xs) =
if goal < acc then False
else if cases2 goal (x + acc) xs then True
else if cases2 goal (x * acc) xs then True
else cases2 goal (cat acc x) xs
part2 : Prob → Bool
part2 (goal, x :: xs) = cases2 goal x xs
part2 _ = False
parse : String -> Maybe (List Prob)
parse text = do
traverse parseLine $ split (trim text) "\n"
where
parseLine : String → Maybe Prob
parseLine line = do
let (a :: b :: Nil) = split line ": " | _ => Nothing
Just (stringToInt a , nums b)
run : String -> IO Unit
run fn = do
putStrLn fn
text <- readFile fn
let (Just probs) = parse text | _ => putStrLn "parse error"
let p1 = foldl _+_ 0 $ map fst $ filter part1 probs
putStrLn $ "part1 " ++ show p1
let p2 = foldl _+_ 0 $ map fst $ filter part2 probs
putStrLn $ "part2 " ++ show p2
main : IO Unit
main = do
run "aoc2024/day7/eg.txt"
run "aoc2024/day7/input.txt"

1
playground/samples/aoc2024/Day7.newt Symbolic link
View File

@@ -0,0 +1 @@
../../../aoc2024/Day7.newt

95
playground/samples/aoc2024/Day8.newt
View File

@@ -1,95 +0,0 @@
module Day8
import Prelude
import Node
import Aoc
import SortedMap
Point : U
Point = Int × Int
instance Add Point where
(a,b) + (c,d) = (a + c, b + d)
instance Sub Point where
(a,b) - (c,d) = (a - c, b - d)
Ant : U
Ant = Char × Int × Int
-- This should be a utility...
parse : String → List Ant
parse text = go 0 0 (unpack text) Nil
where
-- might as well be tail recursive
go : Int → Int → List Char → List Ant → List Ant
go row col Nil ants = ants
go row col ('\n' :: cs) ants = go (row + 1) 0 cs ants
go row col (c :: cs) ants = go row (col + 1) cs ((c,row,col) :: ants)
doPair : Point → Point → List Point
doPair x y = let d = y - x in y + d :: x - d :: Nil
doGroup : List Ant -> List Point
doGroup (x :: xs) = join $ doGroup xs :: map (doPair (snd x) ∘ snd) xs
doGroup Nil = Nil
group : List Ant → (List Ant) → List (List Ant)
group (a :: as) Nil = group as (a :: Nil)
group (a :: as) (b :: bs) =
if fst a == fst b
then group as (a :: b :: bs)
else (b :: bs) :: group as (a :: Nil)
group Nil bs = bs :: Nil
max : Int → Int → Int
max a b = if a < b then b else a
check : Int → Point → Bool
check mr (r,c) = 0 <= r && 0 <= c && r <= mr && c <= mr
doPair2 : Int -> Point → Point → List Point
doPair2 m x y = go x (y - x) ++ go y (x - y)
where
go : Point -> Point -> List Point
go pt d = if check m pt then pt :: go (pt + d) d else Nil
doGroup2 : Int -> List Ant -> List Point
doGroup2 m (x :: xs) = join $ doGroup2 m xs :: map (doPair2 m (snd x) ∘ snd) xs
doGroup2 m Nil = Nil
instance Ord Point where
(a,b) < (c,d) = a < c || a == c && b < d
instance Eq Point where
(a,b) == (c,d) = a == c && b == d
run : String -> IO Unit
run fn = do
putStrLn fn
text <- readFile fn
let points = parse text
let maxrow = trace "maxrow" $ foldl max 0 $ map (fst ∘ snd) points
let maxcol = trace "maxcol" $ foldl max 0 $ map (snd ∘ snd) points
let ants = filter (\ pt => fst pt /= '.') points
let ants = qsort (\ x y => fst x < fst y) ants
let groups = group ants Nil
let stuff = join $ map doGroup groups
let nodes = filter (check maxrow) stuff
let part1 = length $ ordNub nodes
putStrLn $ "part1 " ++ show part1
let stuff2 = join $ map (doGroup2 maxrow) groups
let part2 = length $ ordNub stuff2
putStrLn $ "part2 " ++ show part2
main : IO Unit
main = do
run "aoc2024/day8/eg.txt"
run "aoc2024/day8/input.txt"

1
playground/samples/aoc2024/Day8.newt Symbolic link
View File

@@ -0,0 +1 @@
../../../aoc2024/Day8.newt

127
playground/samples/aoc2024/Day9.newt
View File

@@ -1,127 +0,0 @@
module Day9
import Prelude
import Node
import Aoc
import SortedMap
File : U
File = Int × Int × Int
parse : String -> List File
parse cs = go 0 (unpack $ trim cs) Nil
where
go : Int -> List Char -> List File -> List File
go id (a :: b :: cs) acc =
go (id + 1) cs ((id, (ord a - 48), (ord b - 48)) :: acc)
go id (a :: cs) acc = go (id + 1) cs ((id, (ord a - 48), 0) :: acc)
go _ _ acc = reverse acc
part1 : List File -> Int
part1 fs = go 0 0 fs $ reverse fs
where
go : Int -> Int -> List File -> List File -> Int
go pos csum Nil bwd = ?
go pos csum fwd Nil = csum
go pos csum ((id, 0, 0) :: fwd) bwd = go pos csum fwd bwd
go pos csum fwd ((id, 0, _) :: bwd) = go pos csum fwd bwd
go pos csum ((id, 0, k) :: fs) ((id', l, g) :: bwd) =
if id == id' then csum
else go (pos + 1) (csum + pos * id') ((id, 0, k - 1) :: fs) ((id', l - 1, g) :: bwd)
go pos csum ((id, k, gap) :: fs) ((id', l, g) :: rest) =
if id == id'
then go (pos + 1) (csum + pos * id) ((id, k, gap) :: fs) ((id', l - 1, g) :: Nil)
else go (pos + 1) (csum + pos * id) ((id, k - 1, gap) :: fs) ((id', l, g) :: rest)
min : Int → Int → Int
min a b = if a < b then a else b
-- I really do want records...
Node : U
Node = Int × Int × File
FileSystem : U
FileSystem = SortedMap Int Node
mkfs : List File → FileSystem
mkfs = foldl go EmptyMap
where
go : FileSystem → File → FileSystem
go fs (id,l,g) = updateMap id (id - 1, id + 1, id, l, g) fs
removeNode : Int → FileSystem → FileSystem
removeNode ix fs =
-- yeah, I want records..
let (Just (_ ,p1,n1, i1, l1, g1)) = lookupMap ix fs | _ => fs in
let (Just (_, p2, _, i2, l2, g2)) = lookupMap p1 fs | _ => fs in
let fs = updateMap p1 (p2, n1, i2, l2, g2 + l1 + g1) fs in
let (Just (_, _, n2, i2, l2, g2)) = lookupMap n1 fs | _ => fs in
updateMap n1 (p1, n2, i2, l2, g2) fs
insertNode : Int → File → FileSystem → FileSystem
insertNode ix (i,l,g) fs =
-- previous
let (Just (_, p1, n1, i1, l1, g1)) = lookupMap ix fs | _ => fs in
let fs = updateMap ix (p1,i,i1,l1,0) fs in
let fs = updateMap i (ix, n1, i,l,g1 - l) fs in
let (Just (_, p2, n2, i2, l2, g2)) = lookupMap n1 fs | _ => fs in
updateMap n1 (i, n2, i2, l2, g2) fs
defrag : FileSystem → Int -> Int → Int → FileSystem
defrag fs start end limit =
case lookupMap end fs of
Nothing => fs
Just (k,(p,n,id,l,g)) =>
-- our only optimization...
if limit <= l then defrag fs start p limit else
case search l start end of
Nothing => defrag fs start p (min l limit)
Just (id',l',g') =>
defrag (insertNode id' (id,l,g) $ removeNode end fs) start p limit
where
search : Int → Int → Int -> Maybe File
search size pos end =
if pos == end then Nothing else
case lookupMap pos fs of
Nothing => Nothing
Just (_,(p,n,id,l,g)) =>
if size <= g then Just (id,l,g)
else search size n end
check : FileSystem → Int
check fs = go 0 0 $ files 0 Lin
where
files : Int → SnocList File → List File
files start acc = case lookupMap start fs of
Nothing => acc <>> Nil
Just (_, _, n, f) => files n (acc :< f)
go : Int → Int → List File → Int
go pos csum Nil = csum
go pos csum ((id,l,g) :: rest) =
if l == 0 then go (pos + g) csum rest
else go (pos + 1) (csum + pos * id) ((id, l - 1, g) :: rest)
part2 : List File → Int
part2 files =
let fs = mkfs files
end = cast (length files) - 1
fs' = defrag fs 0 end end
in check fs'
run : String -> IO Unit
run fn = do
putStrLn fn
text <- readFile fn
let files = parse $ trim text
putStrLn $ show (length files) ++ " files"
let p1 = part1 files
putStrLn $ "part1 " ++ show p1
let p2 = part2 files
putStrLn $ "part2 " ++ show p2
pure MkUnit
main : IO Unit
main = do
run "aoc2024/day9/eg.txt"
run "aoc2024/day9/input.txt"

1
playground/samples/aoc2024/Day9.newt Symbolic link
View File

@@ -0,0 +1 @@
../../../aoc2024/Day9.newt

1
playground/samples/aoc2024/DayXX.newt Symbolic link
View File

@@ -0,0 +1 @@
../../../aoc2024/DayXX.newt

2
playground/samples/aoc2024/Node.newt
View File

@@ -1 +1 @@
../../../aoc2023/Node.newt
../../../aoc2024/Node.newt

1
playground/samples/aoc2024/Parser.newt Symbolic link
View File

@@ -0,0 +1 @@
../../../aoc2024/Parser.newt

2
playground/samples/aoc2024/Prelude.newt
View File

@@ -1 +1 @@
../../../newt/Prelude.newt
../../../aoc2024/Prelude.newt

67
playground/samples/aoc2024/SortedMap.newt
View File

@@ -1,67 +0,0 @@
module SortedMap
import Prelude
data T23 : Nat -> U -> U -> U where
Leaf : ∀ k v. k -> v -> T23 Z k v
Node2 : ∀ h k v. T23 h k v -> k -> T23 h k v -> T23 (S h) k v
Node3 : ∀ h k v. T23 h k v -> k -> T23 h k v -> k -> T23 h k v -> T23 (S h) k v
lookupT23 : ∀ h k v. {{Ord k}} {{Eq k}} -> k -> T23 h k v -> Maybe (k × v)
lookupT23 key (Leaf k v)= if k == key then Just (k,v) else Nothing
lookupT23 key (Node2 t1 k1 t2) =
if key <= k1 then lookupT23 key t1 else lookupT23 key t2
lookupT23 key (Node3 t1 k1 t2 k2 t3) =
if key <= k1 then lookupT23 key t1
else if key <= k2 then lookupT23 key t2
else lookupT23 key t3
insertT23 : ∀ h k v. {{Ord k}} {{Eq k}} -> k -> v -> T23 h k v -> Either (T23 h k v) (T23 h k v × k × T23 h k v)
insertT23 key value (Leaf k v) =
if key == k then Left (Leaf key value)
else if key <= k then Right (Leaf key value, key, Leaf k v)
else Right (Leaf k v, k, Leaf key value)
insertT23 key value (Node2 t1 k1 t2) =
if key <= k1 then
case insertT23 key value t1 of
Left t1' => Left (Node2 t1' k1 t2)
Right (a,b,c) => Left (Node3 a b c k1 t2)
else case insertT23 key value t2 of
Left t2' => Left (Node2 t1 k1 t2')
Right (a,b,c) => Left (Node3 t1 k1 a b c)
insertT23 key value (Node3 t1 k1 t2 k2 t3) =
if key <= k1 then
case insertT23 key value t1 of
Left t1' => Left (Node3 t1' k1 t2 k2 t3)
Right (a,b,c) => Right (Node2 a b c, k1, Node2 t2 k2 t3)
else if key <= k2 then
case insertT23 key value t2 of
Left t2' => Left (Node3 t1 k1 t2' k2 t3)
Right (a,b,c) => Right (Node2 t1 k1 a, b, Node2 c k2 t3)
else
case insertT23 key value t3 of
Left t3' => Left (Node3 t1 k1 t2 k2 t3')
Right (a,b,c) => Right (Node2 t1 k1 t2, k2, Node2 a b c)
data SortedMap : U -> U -> U where
EmptyMap : ∀ k v. SortedMap k v
MapOf : ∀ k v h. T23 h k v -> SortedMap k v
lookupMap : ∀ k v. {{Ord k}} {{Eq k}} -> k -> SortedMap k v -> Maybe (k × v)
lookupMap k EmptyMap = Nothing
lookupMap k (MapOf map) = lookupT23 k map
updateMap : ∀ k v. {{Ord k}} {{Eq k}} -> k -> v -> SortedMap k v -> SortedMap k v
updateMap k v EmptyMap = MapOf $ Leaf k v
updateMap k v (MapOf map) = case insertT23 k v map of
Left map' => MapOf map'
Right (a, b, c) => MapOf (Node2 a b c)
toList : ∀ k v. SortedMap k v → List (k × v)
toList {k} {v} (MapOf smap) = reverse $ go smap Nil
where
go : ∀ h. T23 h k v → List (k × v) → List (k × v)
go (Leaf k v) acc = (k, v) :: acc
go (Node2 t1 k1 t2) acc = go t2 (go t1 acc)
go (Node3 t1 k1 t2 k2 t3) acc = go t3 $ go t2 $ go t1 acc
toList _ = Nil

1
playground/samples/aoc2024/SortedMap.newt Symbolic link
View File

@@ -0,0 +1 @@
../../../aoc2024/SortedMap.newt

1
playground/samples/aoc2024/day1 Symbolic link
View File

@@ -0,0 +1 @@
../../../aoc2024/day1

6
playground/samples/aoc2024/day1/eg.txt
View File

@@ -1,6 +0,0 @@
3 4
4 3
2 5
1 3
3 9
3 3

1
playground/samples/aoc2024/day10 Symbolic link
View File

@@ -0,0 +1 @@
../../../aoc2024/day10

1
playground/samples/aoc2024/day11 Symbolic link
View File

@@ -0,0 +1 @@
../../../aoc2024/day11

1
playground/samples/aoc2024/day12 Symbolic link
View File

@@ -0,0 +1 @@
../../../aoc2024/day12

1
playground/samples/aoc2024/day13 Symbolic link
View File

@@ -0,0 +1 @@
../../../aoc2024/day13

1
playground/samples/aoc2024/day14 Symbolic link
View File

@@ -0,0 +1 @@
../../../aoc2024/day14

1
playground/samples/aoc2024/day2 Symbolic link
View File

@@ -0,0 +1 @@
../../../aoc2024/day2

6
playground/samples/aoc2024/day2/eg.txt
View File

@@ -1,6 +0,0 @@
7 6 4 2 1
1 2 7 8 9
9 7 6 2 1
1 3 2 4 5
8 6 4 4 1
1 3 6 7 9

1
playground/samples/aoc2024/day3 Symbolic link
View File

@@ -0,0 +1 @@
../../../aoc2024/day3

1
playground/samples/aoc2024/day3/eg.txt
View File

@@ -1 +0,0 @@
xmul(2,4)%&mul[3,7]!@^do_not_mul(5,5)+mul(32,64]then(mul(11,8)mul(8,5))

1
playground/samples/aoc2024/day4 Symbolic link
View File

@@ -0,0 +1 @@
../../../aoc2024/day4

11
playground/samples/aoc2024/day4/eg.txt
View File

@@ -1,11 +0,0 @@
MMMSXXMASM
MSAMXMSMSA
AMXSXMAAMM
MSAMASMSMX
XMASAMXAMM
XXAMMXXAMA
SMSMSASXSS
SAXAMASAAA
MAMMMXMMMM
MXMXAXMASX

1
playground/samples/aoc2024/day5 Symbolic link
View File

@@ -0,0 +1 @@
../../../aoc2024/day5

28
playground/samples/aoc2024/day5/eg.txt
View File

@@ -1,28 +0,0 @@
47|53
97|13
97|61
97|47
75|29
61|13
75|53
29|13
97|29
53|29
61|53
97|53
61|29
47|13
75|47
97|75
47|61
75|61
47|29
75|13
53|13
75,47,61,53,29
97,61,53,29,13
75,29,13
75,97,47,61,53
61,13,29
97,13,75,29,47

1
playground/samples/aoc2024/day6 Symbolic link
View File

@@ -0,0 +1 @@
../../../aoc2024/day6

11
playground/samples/aoc2024/day6/eg.txt
View File

@@ -1,11 +0,0 @@
....#.....
.........#
..........
..#.......
.......#..
..........
.#..^.....
........#.
#.........
......#...

1
playground/samples/aoc2024/day7 Symbolic link
View File

@@ -0,0 +1 @@
../../../aoc2024/day7

9
playground/samples/aoc2024/day7/eg.txt
View File

@@ -1,9 +0,0 @@
190: 10 19
3267: 81 40 27
83: 17 5
156: 15 6
7290: 6 8 6 15
161011: 16 10 13
192: 17 8 14
21037: 9 7 18 13
292: 11 6 16 20

1
playground/samples/aoc2024/day8 Symbolic link
View File

@@ -0,0 +1 @@
../../../aoc2024/day8

6
playground/samples/aoc2024/day8/day1/eg.txt
View File

@@ -1,6 +0,0 @@
3 4
4 3
2 5
1 3
3 9
3 3

6
playground/samples/aoc2024/day8/day2/eg.txt
View File

@@ -1,6 +0,0 @@
7 6 4 2 1
1 2 7 8 9
9 7 6 2 1
1 3 2 4 5
8 6 4 4 1
1 3 6 7 9

1
playground/samples/aoc2024/day8/day3/eg.txt
View File

@@ -1 +0,0 @@
xmul(2,4)%&mul[3,7]!@^do_not_mul(5,5)+mul(32,64]then(mul(11,8)mul(8,5))

11
playground/samples/aoc2024/day8/day4/eg.txt
View File

@@ -1,11 +0,0 @@
MMMSXXMASM
MSAMXMSMSA
AMXSXMAAMM
MSAMASMSMX
XMASAMXAMM
XXAMMXXAMA
SMSMSASXSS
SAXAMASAAA
MAMMMXMMMM
MXMXAXMASX

28
playground/samples/aoc2024/day8/day5/eg.txt
View File

@@ -1,28 +0,0 @@
47|53
97|13
97|61
97|47
75|29
61|13
75|53
29|13
97|29
53|29
61|53
97|53
61|29
47|13
75|47
97|75
47|61
75|61
47|29
75|13
53|13
75,47,61,53,29
97,61,53,29,13
75,29,13
75,97,47,61,53
61,13,29
97,13,75,29,47

11
playground/samples/aoc2024/day8/day6/eg.txt
View File

@@ -1,11 +0,0 @@
....#.....
.........#
..........
..#.......
.......#..
..........
.#..^.....
........#.
#.........
......#...

9
playground/samples/aoc2024/day8/day7/eg.txt
View File

@@ -1,9 +0,0 @@
190: 10 19
3267: 81 40 27
83: 17 5
156: 15 6
7290: 6 8 6 15
161011: 16 10 13
192: 17 8 14
21037: 9 7 18 13
292: 11 6 16 20

12
playground/samples/aoc2024/day8/eg.txt
View File

@@ -1,12 +0,0 @@
............
........0...
.....0......
.......0....
....0.......
......A.....
............
............
........A...
.........A..
............
............