day14-16
This commit is contained in:
parent
0cfa172289
commit
04e00ebebf
|
|
@ -0,0 +1,43 @@
|
|||
{-# LANGUAGE TupleSections #-}
|
||||
module Day14 where
|
||||
|
||||
import qualified Data.Map as M
|
||||
import Data.List (sort, sortOn)
|
||||
|
||||
type Pair = (Char,Char)
|
||||
type PairInsertion = M.Map Pair Char
|
||||
|
||||
parseRule :: String -> (Pair,Char)
|
||||
parseRule (a:b:s) = ((a,b), last s)
|
||||
|
||||
convertPair :: PairInsertion -> Pair -> [Pair]
|
||||
convertPair m p@(a,b) = case M.lookup p m of
|
||||
Just c -> [(a,c), (c,b)]
|
||||
Nothing -> [(a,b)]
|
||||
|
||||
stepPairs :: PairInsertion -> [(Pair,Int)] -> [(Pair, Int)]
|
||||
stepPairs m = M.assocs . M.fromListWith (+) . concatMap (\(p,i) -> map (\np -> (np,i)) (convertPair m p))
|
||||
|
||||
pairsToCount :: [(Pair, Int)] -> [(Char, Int)]
|
||||
pairsToCount = map (\(c,i) -> (c, (i+1)`div`2)) . M.assocs . M.fromListWith (+) . concatMap (\((a,b), freq) -> [(a,freq), (b,freq)])
|
||||
|
||||
stringToPairs :: String -> [Pair]
|
||||
stringToPairs s = zip s (tail s)
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
template <- map (\p -> (p,1)) . stringToPairs <$> getLine
|
||||
getLine
|
||||
transforms <- M.fromList . map parseRule . lines <$> getContents
|
||||
print $ pairsToCount template
|
||||
|
||||
putStr "part 1: "
|
||||
let step10 = sortOn snd $ pairsToCount $ iterate (stepPairs transforms) template !! 10
|
||||
print $ snd (last step10) - snd (head step10)
|
||||
|
||||
putStr "part 2: "
|
||||
let step10 = sortOn snd $ pairsToCount $ iterate (stepPairs transforms) template !! 40
|
||||
print $ snd (last step10) - snd (head step10)
|
||||
|
||||
|
||||
print "Bye"
|
||||
|
|
@ -0,0 +1,65 @@
|
|||
module Day15 where
|
||||
import Data.Array
|
||||
import Data.Char (digitToInt)
|
||||
import Debug.Trace (trace, traceShow)
|
||||
import Data.Maybe (fromJust, mapMaybe)
|
||||
import Data.List (nub, sort)
|
||||
|
||||
type Cavern = [[Int]]
|
||||
|
||||
neighs :: Int -> Int -> Int -> Int -> [(Int,Int)]
|
||||
neighs max_x max_y x y = filter (\(x,y) -> x >= 0 && x <= max_x && y >= 0 && y <= max_y) [(x-1, y), (x+1, y), (x, y-1), (x, y+1)]
|
||||
|
||||
mapInd :: (Int -> a -> b) -> [a] -> [b]
|
||||
mapInd f = zipWith f [0..]
|
||||
|
||||
minMaybe :: [Maybe Int] -> Maybe Int
|
||||
minMaybe = foldr go Nothing where
|
||||
go Nothing state = state
|
||||
go (Just x) Nothing = Just x
|
||||
go (Just x) (Just y) = Just (min x y)
|
||||
|
||||
searchStep :: Array (Int,Int) Int -> Array (Int,Int) (Maybe Int) -> [(Int,Int)] -> (Array (Int,Int) (Maybe Int), [(Int,Int)])
|
||||
searchStep costs so_far active = (so_far // updates, map fst updates) where
|
||||
updates = mapMaybe (\(x,y) -> let cur = so_far ! (x,y); new = minMaybe (cur:neigh_costs x y); in if cur /= new then Just ((x,y), new) else Nothing) new_active
|
||||
new_active = nub $ sort $ concatMap (uncurry n) active
|
||||
n = uncurry neighs (snd $ bounds costs)
|
||||
neigh_costs x y = map (\(x',y') -> fmap (+ (costs ! (x,y))) (so_far !(x',y')) ) (n x y)
|
||||
|
||||
search :: [[Int]] -> Int
|
||||
search cavern = fromJust $ final_iter ! snd (bounds final_iter) where
|
||||
iters = iterate (\(i,(s,a)) -> trace ("step " ++ show i ++ show (s ! snd (bounds s))) (i+1, searchStep cavern_array s a)) (0,(init_array, [(0,0)]))
|
||||
final_iter = fst $ snd $ iters !! (10 + length cavern + length (head cavern))
|
||||
-- search' :: [[Int]] -> [[Maybe Int]] -> Int
|
||||
-- search' cavern step = iterate (searchStep cavern) init
|
||||
-- search' cavern step = case last $ last s of
|
||||
-- Nothing -> trace "Nothing yet.." $ search' cavern s
|
||||
-- Just x -> if Just x <= last (last $ searchStep cavern s) then x else trace ("test; " ++ show x ++ " > " ++ show (last(last $ searchStep cavern s))) $ search' cavern s
|
||||
-- where s = searchStep cavern step
|
||||
toArray = Data.Array.listArray ((0,0), (length cavern - 1, length (head cavern) - 1))
|
||||
cavern_array = toArray $ concat cavern
|
||||
firstLine = Just 0: replicate (length cavern - 1) Nothing
|
||||
init = firstLine : map (map (const Nothing)) (tail cavern)
|
||||
init_array = toArray $ concat init
|
||||
|
||||
fullMap :: [[Int]] -> [[Int]]
|
||||
fullMap cavern = full where
|
||||
increment 9 = 1
|
||||
increment x = x + 1
|
||||
first_row = map (concat . take 5 . iterate (map increment)) cavern
|
||||
full = concat $ take 5 $ iterate (map (map increment)) first_row
|
||||
|
||||
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
cavern <- map (map digitToInt) . lines <$> getContents
|
||||
putStr "part 1: "
|
||||
print $ search cavern
|
||||
|
||||
putStr "part 2: "
|
||||
-- print cavern
|
||||
-- mapM_ print $ fullMap cavern
|
||||
print $ search $ fullMap cavern
|
||||
|
||||
print "bye"
|
||||
|
|
@ -0,0 +1,85 @@
|
|||
module Main where
|
||||
import Data.List (foldl', unfoldr)
|
||||
import Debug.Trace (traceShow)
|
||||
|
||||
type Packet = [Bool]
|
||||
data Length = Bits Int | Count Int deriving Show
|
||||
data DecodedPacket = Lit Int Int Int | Op Int Int Length [DecodedPacket] deriving Show
|
||||
|
||||
binToDec :: [Bool] -> Int
|
||||
binToDec = foldl' (\acc x -> acc * 2 + fromEnum x) 0
|
||||
|
||||
decodeHex :: Char -> Packet
|
||||
decodeHex '0' = map toEnum [0, 0, 0, 0]
|
||||
decodeHex '1' = map toEnum [0, 0, 0, 1]
|
||||
decodeHex '2' = map toEnum [0, 0, 1, 0]
|
||||
decodeHex '3' = map toEnum [0, 0, 1, 1]
|
||||
decodeHex '4' = map toEnum [0, 1, 0, 0]
|
||||
decodeHex '5' = map toEnum [0, 1, 0, 1]
|
||||
decodeHex '6' = map toEnum [0, 1, 1, 0]
|
||||
decodeHex '7' = map toEnum [0, 1, 1, 1]
|
||||
decodeHex '8' = map toEnum [1, 0, 0, 0]
|
||||
decodeHex '9' = map toEnum [1, 0, 0, 1]
|
||||
decodeHex 'A' = map toEnum [1, 0, 1, 0]
|
||||
decodeHex 'B' = map toEnum [1, 0, 1, 1]
|
||||
decodeHex 'C' = map toEnum [1, 1, 0, 0]
|
||||
decodeHex 'D' = map toEnum [1, 1, 0, 1]
|
||||
decodeHex 'E' = map toEnum [1, 1, 1, 0]
|
||||
decodeHex 'F' = map toEnum [1, 1, 1, 1]
|
||||
decodeHex x = []
|
||||
|
||||
buildPacket :: [Bool] -> [(DecodedPacket, [Bool])]
|
||||
buildPacket p = unfoldr go p where
|
||||
go [] = Nothing
|
||||
go p = Just ((dec, next), next) where (dec,next) = decode p
|
||||
|
||||
decode :: Packet -> (DecodedPacket, [Bool])
|
||||
decode p = decode' typeID $ drop 6 p where
|
||||
version = binToDec $ take 3 p
|
||||
typeID = binToDec $ take 3 $ drop 3 p
|
||||
|
||||
decodeLit :: [Bool] -> ([Bool], [Bool])
|
||||
decodeLit [] = error "trying to decode an empty list"
|
||||
decodeLit (False:ps) = splitAt 4 ps
|
||||
decodeLit (True:ps) = let (next,rem) = decodeLit (drop 4 ps) in (take 4 ps ++ next, rem)
|
||||
decode' :: Int -> [Bool] -> (DecodedPacket, [Bool])
|
||||
decode' 4 p = let (num, rem) = decodeLit p in (Lit version typeID (binToDec num), rem)
|
||||
decode' x [] = error "unexpected end-of-packet"
|
||||
decode' x (False:ps) = (Op version typeID (Bits numBits) ourPackets, next) where
|
||||
numBits = binToDec $ take 15 ps
|
||||
(this,next) = splitAt numBits $ drop 15 ps
|
||||
ourPackets = map fst $ buildPacket this
|
||||
decode' x (True:ps) = (Op version typeID (Count numPackets) (map fst ourPackets), remainder) where
|
||||
numPackets = binToDec $ take 11 ps
|
||||
ourPackets = take numPackets $ buildPacket $ drop 11 ps
|
||||
remainder = snd $ last ourPackets
|
||||
|
||||
versionSum :: DecodedPacket -> Int
|
||||
versionSum (Lit v t x) = v
|
||||
versionSum (Op v t l ps) = v + sum (map versionSum ps)
|
||||
|
||||
evalPacket :: DecodedPacket -> Int
|
||||
evalPacket (Lit v t x) = x
|
||||
evalPacket (Op v 0 l ps) = sum $ map evalPacket ps
|
||||
evalPacket (Op v 1 l ps) = product $ map evalPacket ps
|
||||
evalPacket (Op v 2 l ps) = minimum $ map evalPacket ps
|
||||
evalPacket (Op v 3 l ps) = maximum $ map evalPacket ps
|
||||
evalPacket (Op v 5 l (x:y:xs)) = fromEnum $ evalPacket x > evalPacket y
|
||||
evalPacket (Op v 6 l (x:y:xs)) = fromEnum $ evalPacket x < evalPacket y
|
||||
evalPacket (Op v 7 l (x:y:xs)) = fromEnum $ evalPacket x == evalPacket y
|
||||
evalPacket x = error $ "invalid packet: " ++ show x
|
||||
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
input <- concatMap decodeHex <$> getContents
|
||||
let packet = fst $ decode input
|
||||
print packet
|
||||
|
||||
putStr "part 1: "
|
||||
print $ versionSum packet
|
||||
|
||||
putStr "part 2: "
|
||||
print $ evalPacket packet
|
||||
|
||||
print "bye"
|
||||
Loading…
Reference in New Issue