day17 and day18
This commit is contained in:
parent
ba470a933d
commit
43476314d7
|
|
@ -0,0 +1,36 @@
|
|||
module Day17 where
|
||||
|
||||
import Debug.Trace (trace)
|
||||
|
||||
xmin = 111
|
||||
xmax = 161
|
||||
ymin = -154
|
||||
ymax = -101
|
||||
|
||||
x_vel_to_pos :: Int -> Int
|
||||
x_vel_to_pos 0 = 0
|
||||
x_vel_to_pos x = x + (x_vel_to_pos (x-1))
|
||||
|
||||
x_vel :: Int
|
||||
x_vel = head $ filter (\x -> let pos = x_vel_to_pos x in pos >= xmin && pos <= xmax) $ [0..]
|
||||
|
||||
max_y :: Int -> Int
|
||||
max_y yv = go yv 0 where
|
||||
go vel pos = if vel <= 0 then pos else go (vel-1) (pos+vel)
|
||||
|
||||
|
||||
x_y_reaches :: Int -> Int -> Int -> Int -> Bool
|
||||
x_y_reaches xv yv x y
|
||||
| x >= xmin && x <= xmax && y >= ymin && y <= ymax = True
|
||||
| y < ymin || x > xmax = False
|
||||
| otherwise = x_y_reaches (max (xv-1) 0) (yv-1) (x+xv) (y+yv)
|
||||
|
||||
try_y :: [Int]
|
||||
try_y = filter (\yv -> x_y_reaches x_vel yv 0 0) [0..250]
|
||||
|
||||
try_x_y :: Int -> [Int]
|
||||
try_x_y xv = filter (\yv -> x_y_reaches xv yv 0 0) [-250..250]
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
print "bye"
|
||||
|
|
@ -0,0 +1,86 @@
|
|||
module Day18 where
|
||||
import Data.Char (isDigit, digitToInt)
|
||||
import Data.List (foldl')
|
||||
|
||||
data Number = Single Int | Pair Number Number deriving (Eq)
|
||||
|
||||
instance Show Number where
|
||||
show (Single x) = show x
|
||||
show (Pair x y) = '[':show x ++ ',':show y ++ "]"
|
||||
|
||||
replaceRight :: Int -> Number -> Number
|
||||
replaceRight y (Single x) = Single (x+y)
|
||||
replaceRight y (Pair l r) = Pair l (replaceRight y r)
|
||||
|
||||
replaceLeft :: Int -> Number -> Number
|
||||
replaceLeft y (Single x) = Single (x+y)
|
||||
replaceLeft y (Pair l r) = Pair (replaceLeft y l) r
|
||||
|
||||
explode :: Int -> Number -> (Maybe Int, Maybe Int, Number)
|
||||
explode _ (Single x) = (Nothing, Nothing, Single x)
|
||||
explode 4 (Pair (Single x) (Single y)) = (Just x, Just y, Single 0)
|
||||
explode 4 _ = error "pairs that are deeper than 4"
|
||||
explode lvl (Pair x y)
|
||||
| ln /= x = case lr of
|
||||
Nothing -> (ll, Nothing, Pair ln y)
|
||||
(Just r) -> (ll, Nothing, Pair ln (replaceLeft r y))
|
||||
| otherwise = case rl of
|
||||
Nothing -> (Nothing, rr, Pair x rn)
|
||||
(Just l) -> (Nothing, rr, Pair (replaceRight l x) rn)
|
||||
where
|
||||
(ll, lr, ln) = explode (lvl+1) x
|
||||
(rl, rr, rn) = explode (lvl+1) y
|
||||
|
||||
explodeFull :: Number -> Number
|
||||
explodeFull n = let (_,_,new) = explode 0 n in new
|
||||
|
||||
split :: Number -> Number
|
||||
split (Single x)
|
||||
| x > 9 = Pair (Single $ x `div` 2) (Single $ (x+1) `div` 2)
|
||||
| otherwise = Single x
|
||||
split (Pair x y) = if split x /= x then Pair (split x) y else Pair x (split y)
|
||||
|
||||
reduce :: Number -> (Number, Bool)
|
||||
reduce n
|
||||
| n /= exploded = (exploded, True)
|
||||
| n /= splitN = (splitN, True)
|
||||
| otherwise = (n, False)
|
||||
where
|
||||
exploded = explodeFull n
|
||||
splitN = split n
|
||||
|
||||
reduceFull :: Number -> Number
|
||||
reduceFull n = fst $ until (not . snd) (reduce . fst) (n, True)
|
||||
|
||||
parse :: String -> (Number, String)
|
||||
parse [] = error "parsing empty string"
|
||||
parse ('[': xs) = (Pair l r, xs'') where
|
||||
(l, ',':xs') = parse xs
|
||||
(r, ']':xs'') = parse xs'
|
||||
parse (x:xs)
|
||||
| isDigit x = (Single $ digitToInt x, xs) -- yes i know this only works for single-digit numbers
|
||||
| otherwise = error "parse error"
|
||||
|
||||
add :: Number -> Number -> Number
|
||||
add = Pair
|
||||
|
||||
addAll :: [Number] -> Number
|
||||
addAll [] = error "sum of empty list"
|
||||
addAll (x:xs) = foldl' (\s i -> reduceFull (s `add` i)) x xs
|
||||
|
||||
magnitude :: Number -> Int
|
||||
magnitude (Single x) = x
|
||||
magnitude (Pair l r) = (magnitude l * 3) + (magnitude r * 2)
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
nums <- map (fst . parse) . lines <$> getContents
|
||||
print $ addAll nums
|
||||
|
||||
putStr "part 1: "
|
||||
print $ magnitude $ addAll nums
|
||||
|
||||
putStr "part 2: " -- please use compiled code!
|
||||
let m = maximum $ map (\n1 -> maximum $ map (\n2 ->
|
||||
magnitude $ reduceFull (n1 `add` n2)) nums) nums
|
||||
print m
|
||||
|
|
@ -0,0 +1,100 @@
|
|||
[[7,[8,[3,5]]],[[[3,6],9],1]]
|
||||
[[[[1,7],8],[0,4]],[[[0,9],2],[2,[5,6]]]]
|
||||
[[[4,[4,4]],[8,[4,4]]],[[5,4],6]]
|
||||
[[[1,[1,3]],[[9,6],1]],[[4,[5,4]],[[4,4],[0,8]]]]
|
||||
[[[[6,2],[2,5]],[2,1]],[[1,5],7]]
|
||||
[[[[5,0],[2,7]],[[2,5],2]],[2,[3,2]]]
|
||||
[[[6,[6,6]],[0,[2,8]]],[[8,[5,6]],[4,5]]]
|
||||
[[[6,[3,5]],8],[[2,[7,0]],5]]
|
||||
[[[[7,8],[3,6]],[1,6]],[[[4,2],1],[[0,7],[5,6]]]]
|
||||
[8,2]
|
||||
[[5,5],[[2,[9,1]],8]]
|
||||
[[[4,8],[[1,8],2]],[9,2]]
|
||||
[2,[[8,[8,3]],[0,6]]]
|
||||
[[[6,6],[[6,0],6]],[0,[[3,4],3]]]
|
||||
[[[[2,9],[5,9]],[2,[4,3]]],[6,0]]
|
||||
[[[6,2],0],[7,7]]
|
||||
[[[9,6],5],[2,[[0,1],[5,5]]]]
|
||||
[[6,[[0,1],[5,1]]],5]
|
||||
[4,[[[4,2],3],[2,[5,0]]]]
|
||||
[[[7,9],2],2]
|
||||
[[[5,[2,1]],1],[[1,1],[8,5]]]
|
||||
[[[[5,9],0],[[1,9],0]],4]
|
||||
[[7,[0,5]],[[0,3],[8,2]]]
|
||||
[[6,[9,[7,7]]],6]
|
||||
[2,[[1,[1,0]],[4,[6,1]]]]
|
||||
[[0,6],[[[5,1],6],[[4,7],[8,0]]]]
|
||||
[[[1,[4,7]],[0,[1,2]]],[[1,1],[[1,2],[1,3]]]]
|
||||
[[8,[3,0]],[3,[1,[8,1]]]]
|
||||
[[[7,[4,0]],[[8,7],2]],[[7,[7,3]],7]]
|
||||
[3,[[1,7],2]]
|
||||
[8,[[[1,5],0],1]]
|
||||
[[6,[1,4]],7]
|
||||
[[[[2,6],2],8],1]
|
||||
[9,7]
|
||||
[9,[[[1,1],1],[[3,0],[7,3]]]]
|
||||
[[[[8,5],7],[[5,1],[6,4]]],[4,[[7,6],[2,7]]]]
|
||||
[[[[8,7],1],0],[[9,9],[[1,0],8]]]
|
||||
[[9,[[1,1],7]],[[3,0],4]]
|
||||
[[[[8,2],4],[9,[7,9]]],[[0,2],[[3,0],5]]]
|
||||
[[[[3,6],3],[[9,7],[0,6]]],[[[4,9],[1,3]],[2,[7,3]]]]
|
||||
[[[[3,8],0],[[3,6],5]],[[3,[4,2]],[[6,1],[8,5]]]]
|
||||
[[2,7],[[0,0],8]]
|
||||
[[[[0,3],7],[2,0]],3]
|
||||
[[0,2],[[[3,1],0],[0,0]]]
|
||||
[[[[6,1],7],[[8,4],[2,4]]],[[1,6],[2,3]]]
|
||||
[[2,[2,[9,1]]],[4,[[0,4],9]]]
|
||||
[[[3,[5,6]],7],1]
|
||||
[[[3,0],[8,[9,3]]],[[[1,1],1],[6,7]]]
|
||||
[[[6,[4,4]],[[1,9],1]],[[[8,1],[9,8]],[[6,3],1]]]
|
||||
[[[5,8],[[0,3],[1,7]]],[[[3,2],[4,7]],1]]
|
||||
[[5,5],[[[8,3],[6,6]],2]]
|
||||
[[[[1,9],[8,5]],[[7,7],8]],[0,[8,[7,4]]]]
|
||||
[[6,[4,[4,3]]],[5,[6,[7,2]]]]
|
||||
[[0,[[9,0],0]],5]
|
||||
[[[[5,6],[1,3]],[[0,5],[7,5]]],[[[0,4],[3,6]],[8,[3,6]]]]
|
||||
[[3,[[4,7],[7,0]]],[[[4,1],5],[[6,6],[7,4]]]]
|
||||
[[[[4,3],[0,1]],[[7,3],[2,3]]],[[[3,7],[2,2]],[6,5]]]
|
||||
[[1,1],[[[1,4],6],[6,[3,9]]]]
|
||||
[[[[0,8],[2,0]],5],[4,[[6,1],[2,1]]]]
|
||||
[[7,[3,[7,2]]],[[7,9],8]]
|
||||
[[[4,[9,8]],[8,[3,2]]],[7,9]]
|
||||
[[[4,[4,2]],[5,[0,3]]],[[[4,9],[2,9]],[[1,5],[0,8]]]]
|
||||
[[1,[[9,8],0]],[5,[[4,3],5]]]
|
||||
[[[[5,1],3],[[2,9],[9,0]]],[1,[6,3]]]
|
||||
[[[6,4],[6,1]],7]
|
||||
[[4,8],[[7,2],6]]
|
||||
[[[5,[4,8]],[[1,7],[2,8]]],[6,[[8,4],[3,5]]]]
|
||||
[[5,8],[[[4,0],[6,0]],[5,[6,0]]]]
|
||||
[[3,[[5,3],8]],[8,5]]
|
||||
[[[2,6],[1,[2,3]]],[[[1,7],[5,7]],[[0,0],[0,5]]]]
|
||||
[[0,[[4,3],[3,6]]],[[2,[6,6]],[0,[2,9]]]]
|
||||
[[[5,9],[6,2]],[[7,6],8]]
|
||||
[[9,2],[1,[[0,5],[5,0]]]]
|
||||
[[[3,1],[9,3]],3]
|
||||
[[[[2,0],[4,2]],6],[[[5,2],[7,8]],[[0,7],3]]]
|
||||
[[7,[[3,9],[6,3]]],[2,[[6,4],3]]]
|
||||
[[5,[3,[7,4]]],[[2,5],[0,9]]]
|
||||
[3,7]
|
||||
[[3,9],[[[4,4],9],[[3,1],7]]]
|
||||
[[[[4,0],1],[8,[3,6]]],[[9,[4,4]],[[9,9],9]]]
|
||||
[[8,[[8,1],5]],[[[9,1],4],[[8,5],3]]]
|
||||
[[6,[[6,3],[3,7]]],4]
|
||||
[[[1,[0,8]],9],[[8,5],[3,[0,5]]]]
|
||||
[[[[3,1],0],[[8,5],[1,0]]],[0,2]]
|
||||
[[2,[4,7]],2]
|
||||
[[[2,0],[2,2]],4]
|
||||
[4,[[5,8],5]]
|
||||
[[[2,[0,5]],[[3,3],[6,6]]],1]
|
||||
[[[2,[2,4]],[5,[7,1]]],[3,5]]
|
||||
[[2,[9,[3,9]]],9]
|
||||
[[[7,[7,1]],[[5,2],1]],[[2,1],[9,[7,3]]]]
|
||||
[[4,[4,6]],4]
|
||||
[[[4,2],[9,[3,8]]],[[2,4],0]]
|
||||
[[[7,[0,3]],4],[[[1,8],4],[[5,1],1]]]
|
||||
[[[1,3],3],[[4,9],[[0,0],6]]]
|
||||
[[[4,1],0],[[[5,6],[0,8]],[[2,1],1]]]
|
||||
[[3,[3,[7,9]]],[[[6,8],8],[[7,9],3]]]
|
||||
[[4,[[1,6],[4,6]]],[[1,8],[3,8]]]
|
||||
[[[[5,9],2],[[6,7],4]],3]
|
||||
[[[[2,1],[1,9]],7],[[[0,9],[0,5]],[[2,5],[5,0]]]]
|
||||
Loading…
Reference in New Issue