Garmelon/advent-of-code
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

[hs] Solve 2020_14 part 2

Browse source
This commit is contained in:
Joscha 2020-12-14 11:02:07 +00:00
parent adb548def2
commit dde1487510
1 changed files with 27 additions and 13 deletions
Download patch file Download diff file Expand all files Collapse all files

40
hs/src/Aoc/Y2020/D14.hs
View file

@ -32,15 +32,25 @@ parser = manyLines (pMask <|> pSet)
digits :: Int -> [Bool] digits :: Int -> [Bool]
digits = map odd . iterate (`div` 2) digits = map odd . iterate (`div` 2)
mask :: [Maybe Bool] -> Int -> [Bool] undigits :: [Bool] -> Int
mask m n = zipWith maskBit m $ digits n undigits = sum . map fst . filter snd . zip (iterate (*2) 1)
mask1 :: [Maybe Bool] -> Int -> Int
mask1 m = undigits . zipWith maskBit m . digits
where where
maskBit Nothing = id maskBit Nothing = id
maskBit (Just a) = const a maskBit (Just a) = const a
mask2 :: [Maybe Bool] -> Int -> [Int]
mask2 m = map undigits . sequenceA . zipWith maskBit m . digits
where
maskBit (Just False) b = [b]
maskBit (Just True) _ = [True]
maskBit Nothing _ = [False, True]
data Mem = Mem data Mem = Mem
{ mMask :: [Maybe Bool] { mMask :: [Maybe Bool]
, mMem :: Map.Map Int [Bool] , mMem :: Map.Map Int Int
} deriving (Show) } deriving (Show)
newMem :: Mem newMem :: Mem
@ -50,22 +60,26 @@ setMask :: [Maybe Bool] -> Mem -> Mem
setMask m mem = mem{mMask = m} setMask m mem = mem{mMask = m}
setMem :: Int -> Int -> Mem -> Mem setMem :: Int -> Int -> Mem -> Mem
setMem addr val mem = mem{mMem = Map.insert addr masked $ mMem mem} setMem addr val mem = mem{mMem = Map.insert addr val $ mMem mem}
where
masked = mask (mMask mem) val
doInstr :: Instr -> Mem -> Mem doInstr1 :: Instr -> Mem -> Mem
doInstr (Mask m) = setMask m doInstr1 (Mask m) mem = setMask m mem
doInstr (Set addr val) = setMem addr val doInstr1 (Set addr val) mem = setMem addr (mask1 (mMask mem) val) mem
value :: [Bool] -> Int doInstr2 :: Instr -> Mem -> Mem
value = sum . map fst . filter snd . zip (iterate (*2) 1) doInstr2 (Mask m) mem = setMask m mem
doInstr2 (Set addr val) mem = foldl' (\m a -> setMem a val m) mem $ mask2 (mMask mem) addr
solver :: [Instr] -> IO () solver :: [Instr] -> IO ()
solver instrs = do solver instrs = do
putStrLn ">> Part 1" putStrLn ">> Part 1"
let mem = foldl' (flip doInstr) newMem instrs let mem1 = foldl' (flip doInstr1) newMem instrs
print $ sum $ map value $ Map.elems $ mMem mem print $ sum $ mMem mem1
putStrLn ""
putStrLn ">> Part 2"
let mem2 = foldl' (flip doInstr2) newMem instrs
print $ sum $ mMem mem2
day :: Day day :: Day
day = dayParse parser solver day = dayParse parser solver