From 3957afe03b6ddcc0cd6ee7c982a7063766047b02 Mon Sep 17 00:00:00 2001 From: Xavier Morel Date: Tue, 15 Dec 2020 11:06:03 +0100 Subject: [PATCH] Add 2020 day 14 p2 --- haskellAoC/inputs/2020/14_test | 4 -- haskellAoC/src/Y2020/Day14.hs | 97 +++++++++++++++++++++++++++------- 2 files changed, 77 insertions(+), 24 deletions(-) delete mode 100644 haskellAoC/inputs/2020/14_test diff --git a/haskellAoC/inputs/2020/14_test b/haskellAoC/inputs/2020/14_test deleted file mode 100644 index fa0dd0a..0000000 --- a/haskellAoC/inputs/2020/14_test +++ /dev/null @@ -1,4 +0,0 @@ -mask = XXXXXXXXXXXXXXXXXXXXXXXXXXXXX1XXXX0X -mem[8] = 11 -mem[7] = 101 -mem[8] = 0 \ No newline at end of file diff --git a/haskellAoC/src/Y2020/Day14.hs b/haskellAoC/src/Y2020/Day14.hs index 3e98c0a..67f4198 100644 --- a/haskellAoC/src/Y2020/Day14.hs +++ b/haskellAoC/src/Y2020/Day14.hs @@ -3,48 +3,105 @@ module Y2020.Day14 (y20day14) where import Data.Bits import qualified Data.Map as M -type Bitmask = M.Map Int Bool +-- map offset -> 1 (just true), 0 (just false), X (nothing) +-- list of combinations values for the Xs +type Bitmask = (M.Map Int (Maybe Bool), [Int]) -data Instruction = UpdateBitMask [(Int, Bool)] | SetMemory Int Int deriving (Show) +data Instruction = UpdateBitMask [(Int, Maybe Bool)] | SetMemory Int Int deriving (Show) data State = State { bitmask :: Bitmask - , memory :: M.Map Int Int -- [(Int, Int)] + , memory :: M.Map Int Int } deriving (Show) +parseBitMask :: Int -> String -> [(Int, Maybe Bool)] +parseBitMask _ [] = [] +parseBitMask offset (x:xs) = + let next = (parseBitMask (offset + 1) xs) in + case x of + '1' -> (offset, Just True):next + '0' -> (offset, Just False):next + _ -> (offset, Nothing):next + parseInput :: [String] -> Instruction parseInput ["mask", "=", mask] = UpdateBitMask $ parseBitMask 0 $ reverse mask where - parseBitMask :: Int -> String -> [(Int, Bool)] - parseBitMask _ [] = [] - parseBitMask offset (x:xs) = - let next = (parseBitMask (offset + 1) xs) in - case x of - '1' -> (offset, True):next - '0' -> (offset, False):next - _ -> next parseInput ["mem", offset, "=", value] = SetMemory (read offset) (read value) parseInput s = error $ "Invalid line: " ++ (unwords s) applyInstructionP1 :: State -> Instruction -> State applyInstructionP1 (State _ mem) (UpdateBitMask updates) = State newMask mem - where newMask = M.fromList updates -applyInstructionP1 (State bm mem) (SetMemory offset value) = State bm newMemory + where newMask = (M.fromList updates, []) +applyInstructionP1 (State (bm, _) mem) (SetMemory offset value) = State (bm, []) newMemory where newMemory = M.insert offset (maskValue value) mem maskValue val = checkBit val $ finiteBitSize val where checkBit v (-1) = v checkBit v offset' = checkBit newVal (offset' - 1) where newVal = case offset `M.lookup` bm of - Just True -> v `setBit` offset' - Just False -> v `clearBit` offset' - Nothing -> v + Just (Just True) -> v `setBit` offset' + Just (Just False) -> v `clearBit` offset' + _ -> v + +-- arg1: available combinations +-- arg2: variable offsets +-- arg3: final combinations +computeBitCombinations :: [Int] -> [Int] -> [Int] +computeBitCombinations [] (b:bs) = computeBitCombinations [0, 0 `setBit` b] bs +computeBitCombinations done [] = done +computeBitCombinations done (b:bs) = computeBitCombinations (concatMap (\x -> [x, x `setBit` b]) done) bs + +-- p2 : +-- compute value (of address) with mask considering Xs => &0, other offsets: | +-- compute all possible values of Xs (X00X -> 0000, 0001, 1000, 1001) +-- for each possible values of Xs, add initial masked value + +-- mask: X1001X +-- with address 42: 101010 + +-- masked address : 011010 (26) +-- 4 possibilities: 000000 (0) + 26 = 26 +-- 000001 (1) + 27 = 27 +-- 100000 (32) + 32 = 58 +-- 100001 (33) + 33 = 59 + +-- mask: 00X0XX +-- with address 26: 011010 +-- masked address: 010000 (16) + +-- 8 possibilities: 000000 (0) + 16 = 16 +-- 000001 (1) + 16 = 17 +-- 000010 (2) + 16 = 18 +-- 000011 (3) + 16 = 19 +-- 001000 (8) + 16 = 24 +-- 001001 (9) + 16 = 25 +-- 001010 (10) + 16 = 26 +-- 001011 (11) + 16 = 27 + +applyInstructionP2 :: State -> Instruction -> State +applyInstructionP2 (State _ mem) (UpdateBitMask updates) = State newMask mem + where newMask = (bitMask, variableCombinations) + variableCombinations = computeBitCombinations [] $ map fst $ filter ((== Nothing) . snd) $ updates + bitMask = M.fromList $ filter ((/= Just False) . snd) $ updates +applyInstructionP2 (State (bm, var) mem) (SetMemory offset value) = newState + where newState = State (bm, var) newMemory + newMemory = foldr (\k -> M.insert k value) mem addresses + addresses = map (\v -> v + offset') var + offset' = checkBit offset $ finiteBitSize offset + where checkBit v (-1) = v + checkBit v o = checkBit newVal (o - 1) + where newVal = case o `M.lookup` bm of + Just (Just True) -> v `setBit` o + Just (Nothing) -> v `clearBit` o + _ -> v + y20day14 :: [String] -> (String, String) y20day14 input = (part1, part2) - where part1 = show $ M.foldr (+) 0 $ memory endState - part2 = show $ "WIP" - initialState = State M.empty M.empty - endState = foldl applyInstructionP1 initialState instructions + where part1 = show $ M.foldr (+) 0 $ memory endStateP1 + part2 = show $ M.foldr (+) 0 $ memory endStateP2 + initialState = State (M.empty, []) M.empty + endStateP1 = foldl applyInstructionP1 initialState instructions + endStateP2 = foldl applyInstructionP2 initialState instructions instructions = map (parseInput . words . replaceBrackets) input where replaceBrackets ('[':xs) = ' ':(replaceBrackets xs) replaceBrackets (']':xs) = ' ':(replaceBrackets xs)