aoc2023 day2, codegen fixes, parsing fix
This commit is contained in:
104
aoc2023/Day2.newt
Normal file
104
aoc2023/Day2.newt
Normal file
@@ -0,0 +1,104 @@
|
||||
module Day2
|
||||
|
||||
import Lib
|
||||
|
||||
Draw : U
|
||||
Draw = Pair Int (Pair Int Int)
|
||||
|
||||
data Game : U where
|
||||
MkGame : Int -> List Draw -> Game
|
||||
|
||||
-- Original had class and instance...
|
||||
-- Add, Sub, Mul, Neg
|
||||
|
||||
-- NB this is not lazy!
|
||||
infixl 2 _&&_
|
||||
|
||||
_&&_ : Bool -> Bool -> Bool
|
||||
a && b = case a of
|
||||
False => False
|
||||
True => b
|
||||
|
||||
max : Int -> Int -> Int
|
||||
max x y = case x < y of
|
||||
True => y
|
||||
False => x
|
||||
|
||||
pfunc repr : {a : U} -> a -> String := "(a,o) => ''+o"
|
||||
pfunc jrepr : {a : U} -> a -> String := "(a,o) => JSON.stringify(o, null, ' ')"
|
||||
pfunc toInt : String -> Int := "s => Number(s)"
|
||||
|
||||
mapM : {a b c : U} -> (a -> Either b c) -> List a -> Either b (List c)
|
||||
mapM f Nil = Right Nil
|
||||
mapM f (x :: xs) = case f x of
|
||||
Left msg => Left msg
|
||||
Right v => case mapM f xs of
|
||||
Left msg => Left msg
|
||||
Right vs => Right $ v :: vs
|
||||
|
||||
maxd : Draw -> Draw -> Draw
|
||||
maxd (a,b,c) (d,e,f) = (max a d, max b e, max c f)
|
||||
|
||||
lte : Draw -> Draw -> Bool
|
||||
lte (a,b,c) (d,e,f) = a <= d && b <= e && c <= f
|
||||
|
||||
parseColor : String -> Either String Draw
|
||||
parseColor line = case split line " " of
|
||||
(n :: "red" :: Nil) => Right (toInt n,0,0)
|
||||
(n :: "green" :: Nil) => Right (0,toInt n,0)
|
||||
(n :: "blue" :: Nil) => Right (0,0,toInt n)
|
||||
x => Left $ "Bad draw" ++ repr x
|
||||
|
||||
parseDraw : String -> Either String Draw
|
||||
parseDraw line = case mapM parseColor $ split line ", " of
|
||||
Right parts => Right $ foldl maxd (0,0,0) parts
|
||||
Left err => Left err
|
||||
|
||||
parseGame : String -> Either String Game
|
||||
parseGame line =
|
||||
-- Need the Idris | sugar...
|
||||
case split line ": " of
|
||||
-- this is splitting on the Nil instead of the a
|
||||
(a :: b :: Nil) => case split a " " of
|
||||
("Game" :: ns :: Nil) =>
|
||||
let num = toInt ns in
|
||||
case mapM parseDraw $ split b "; " of
|
||||
Right parts => Right $ MkGame num parts
|
||||
Left err => Left err
|
||||
_ => Left "No Game"
|
||||
_ => Left $ "No colon in " ++ line
|
||||
|
||||
infixl 3 _>>_
|
||||
|
||||
_>>_ : {A B : U} -> A -> B -> B
|
||||
a >> b = b
|
||||
|
||||
part1 : List Game -> Int
|
||||
part1 Nil = 0
|
||||
part1 (MkGame n parts :: rest) =
|
||||
let total = foldl maxd (0,0,0) parts in
|
||||
case lte total (12,13,14) of
|
||||
True => n + part1 rest
|
||||
False => part1 rest
|
||||
|
||||
part2 : List Game -> Int
|
||||
part2 Nil = 0
|
||||
part2 (MkGame n parts :: rest) =
|
||||
case foldl maxd (0,0,0) parts of
|
||||
(a,b,c) => a*b*c + part2 rest
|
||||
|
||||
run : String -> Dummy
|
||||
run fn =
|
||||
let text = readFile fn in
|
||||
case mapM parseGame (split (trim text) "\n") of
|
||||
Left err => log $ "fail " ++ err
|
||||
Right games =>
|
||||
log "part1" >>
|
||||
log (part1 games) >>
|
||||
log "part2" >>
|
||||
log (part2 games)
|
||||
|
||||
main : Dummy -> Dummy
|
||||
main _ =
|
||||
run "aoc2023/day2/eg.txt" >>
|
||||
run "aoc2023/day2/input.txt"
|
||||
@@ -1,6 +1,8 @@
|
||||
module Lib
|
||||
|
||||
-- Prelude
|
||||
data Unit : U where
|
||||
MkUnit : Unit
|
||||
|
||||
data Bool : U where
|
||||
True : Bool
|
||||
@@ -35,6 +37,9 @@ reverse' (x :: xs) acc = reverse' xs (x :: acc)
|
||||
reverse : {A : U} -> List A -> List A
|
||||
reverse xs = reverse' xs Nil
|
||||
|
||||
length : {a : U} -> List a -> Nat
|
||||
length Nil = Z
|
||||
length (x :: xs) = S (length xs)
|
||||
|
||||
infixr 2 _,_
|
||||
|
||||
@@ -73,6 +78,20 @@ pfunc arrayToList : {a : U} -> Array a -> List a := "
|
||||
}
|
||||
"
|
||||
|
||||
pfunc listToArray : {a : U} -> List a -> Array a := "
|
||||
(a, l) => {
|
||||
let rval = []
|
||||
while (l.tag !== 'Nil') {
|
||||
rval.push(l.h1)
|
||||
l = l.h2
|
||||
}
|
||||
return rval
|
||||
}
|
||||
"
|
||||
pfunc alen : {a : U} -> Array a -> Int := "(a,arr) => arr.length"
|
||||
pfunc aget : {a : U} -> Array a -> Int -> a := "(a, arr, ix) => arr[ix]"
|
||||
pfunc aempty : {a : U} -> Unit -> Array a := "() => []"
|
||||
|
||||
pfunc getArgs : List String := "arrayToList(String, process.argv)"
|
||||
-- Maybe integrate promises?
|
||||
|
||||
@@ -80,11 +99,13 @@ pfunc getArgs : List String := "arrayToList(String, process.argv)"
|
||||
pfunc ord : Char -> Int := "(c) => c.charCodeAt(0)"
|
||||
|
||||
pfunc _<_ : Int -> Int -> Bool := "(x,y) => (x < y) ? True : False"
|
||||
pfunc _<=_ : Int -> Int -> Bool := "(x,y) => (x <= y) ? True : False"
|
||||
pfunc _+_ : Int -> Int -> Int := "(x,y) => x + y"
|
||||
pfunc _-_ : Int -> Int -> Int := "(x,y) => x - y"
|
||||
pfunc _*_ : Int -> Int -> Int := "(x,y) => x * y"
|
||||
pfunc _/_ : Int -> Int -> Int := "(x,y) => x / y"
|
||||
infixl 3 _<_
|
||||
infix 3 _<_
|
||||
infix 3 _<=_
|
||||
infixl 4 _-_
|
||||
infixl 4 _+_
|
||||
infixl 5 _*_
|
||||
@@ -109,6 +130,11 @@ pfunc split : String -> String -> List String := "(s, by) => {
|
||||
return rval
|
||||
}"
|
||||
|
||||
pfunc slen : String -> Int := "s => s.length"
|
||||
pfunc sindex : String -> Int -> Char := "(s,i) => s[i]"
|
||||
|
||||
|
||||
infixl 4 _++_
|
||||
pfunc _++_ : String -> String -> String := "(a,b) => a + b"
|
||||
|
||||
|
||||
|
||||
5
aoc2023/day2/eg.txt
Normal file
5
aoc2023/day2/eg.txt
Normal file
@@ -0,0 +1,5 @@
|
||||
Game 1: 3 blue, 4 red; 1 red, 2 green, 6 blue; 2 green
|
||||
Game 2: 1 blue, 2 green; 3 green, 4 blue, 1 red; 1 green, 1 blue
|
||||
Game 3: 8 green, 6 blue, 20 red; 5 blue, 4 red, 13 green; 5 green, 1 red
|
||||
Game 4: 1 green, 3 red, 6 blue; 3 green, 6 red; 3 green, 15 blue, 14 red
|
||||
Game 5: 6 red, 1 blue, 3 green; 2 blue, 1 red, 2 green
|
||||
Reference in New Issue
Block a user