Jump to:
D1 | D2 | D3 | D4 | D5 | D6 | D7 | D8 | D9 | D10 | D11 | D12 | D13 | D14 | D15 | D16 | D17 | D18 | D19 | D20 | D21 | D22 | D23 | D24 | D25
Part 1
Day 14 asks us to execute another type of program, but each step will require bit manipulations.
First, a BitMask data type and a few supporting functions:
fromBinary :: String -> Int
fromBinary s =
let ds = map (\c -> if c == '1' then 1 else 0) s
in foldl (\b a -> 2 * b + a) 0 ds
type AndMask = Int
type OrMask = Int
data BitMask = BitMask AndMask OrMask deriving Show
fromString :: String -> BitMask
fromString s =
let a = map (\c -> if c == 'X' then '1' else c) s
o = map (\c -> if c == 'X' then '0' else c) s
in BitMask (fromBinary a) (fromBinary o)
maskWith :: BitMask -> Int -> Int
maskWith (BitMask a o) x = x .&. a .|. o
I presented a somewhat inflexible way of converting a string of 0's and 1s to an integer back in Day 5, but I first wanted to write a better version that doesn't require computing the length of the string beforehand. Back then, I was struggling to express the conversion as a fold operation because my mind was stuck on a right-fold. The conversion cannot be written as a foldr (unless we first reverse the string) because the contribution from a single digit to the overall value is not known when we visit it - it instead depends on the total length of the string (i.e., a 1 in the most significant bit contributes 128 to the value of an 8-digit binary number, but it only contributes 16 to the value of a 5-bit binary number). However, foldl is perfect for handling this pattern, and allows us to very concisely write the conversion.
Turning to the bit masking required of us in our problem, we notice that we need to do two operations. The first operation is to set a bit to 1, which can be done by OR'ing the bit with 1. The second operation is to set a bit to 0, which can be done by AND'ing the bit with 0. This would be enough for us to solve part 1, as we could write a function that takes an input string and mask, and then considers each individual bit, constructing the new string by either AND'ing or OR'ing, or leaving the bit unchanged for the X's.
However, we can be slightly more efficient by further noticing that OR'ing a value with 0 leaves it unchanged, and AND'ing a value with 1 leaves it unchanged as well. We therefore create a BitMask class that consists of two masks, both represented as Ints. One mask, the AndMask, will be AND'ed with the value in order to set all 0's and leave everything else unchanged. The other mask, the OrMask, will be OR'd with the value in order to set all 1's and leave everything else unchanged. We can construct these by replacing the X's with 1's in the AndMask and with 0's in the OrMask.
Applying the BitMask to a value is then as simple as first applying the AndMask, and then applying the OrMask (the order does not matter here), accomplished with the (.&.) and (.|.) operators in Data.Bits. This handles the modification of all the bits in one shot.
execute :: [(String, String, String)] -> BitMask -> Map.Map String Int -> Map.Map String Int
execute [] _ mem = mem
execute ((command, address, value):cs) mask mem
| command == "mask" = execute cs (fromString value) mem
| command == "mem" = execute cs mask (Map.insert address newValue mem)
where newValue = maskWith mask (read value :: Int)
solve :: Int
solve = let mem = execute input (fromString "") Map.empty
in Map.foldr (+) 0 mem
main :: IO ()
main = print $ solve
Finally, we can go about executing our program. The program state is the current BitMask, as well as a map that tracks the values stored. For part 1, we don't bother interpreting the address as an integer, and just key based on the string representation of the address instead, but we change that in Part 2.
All of the work we did setting up our BitMask type makes this part very easy. If we see a mask "command", set the current BitMask. If we see a mem "command", apply the mask and then store it in the map. Once the entire program has executed, sum up all the values written (easily done with Data.Map's version of foldr), and that's our answer!
Part 2
In Part 2, the meanings of the BitMask change, so all of our hard work defining the BitMask data type is unfortunately no longer useful. Masks are now applied to addresses. 1's in the mask still set the corresponding bit, but 0's now leave them unchanged, and X cause an expansion, so that many addresses can be written by a single mem "command".
toReversedBinaryString :: Int -> String
toReversedBinaryString x
| x == 0 = ""
| otherwise = let d = if x `mod` 2 == 0 then '0' else '1'
in d:(toReversedBinaryString (x `div` 2))
applyMask :: String -> Int -> String
applyMask mask address =
let s = (toReversedBinaryString address) ++ (repeat '0')
m = reverse mask
reversedResult = zipWith combineDigits s m
in reverse reversedResult
where combineDigits d1 d2
| d2 == '1' || d2 == 'X' = d2
| d2 == '0' = d1
First, we need to revise our mask application logic. We want to be able to apply a mask to an address and get a string of 0's, 1's and X's that represents some set of addresses. Here, we cannot get by with pure bit manipulations, because we need to copy over the X's. In order to accomplish this, we fall back to the bit-by-bit approach.
We write an auxiliary toReversedBinaryString function, which takes a value (the address) and returns the binary representation of the value in string form reversed. We return the reversed string for two reasons. First, it is an easier implementation of toReversedBinaryString itself, as we can peel off least significant bits via modulo 2 and tack them onto the head of our result. Second, we can easily pad the value with "leading" zeros by taking the reversed string and concatenating it with (repeat '0'). Note that, if the string were not reversed, we would need to do something more like (replicate n '0') ++ s, which is awkward to deal with because we would need to specify how many zeros to add. By instead adding an infinite list to the end, we can use Haskell's lazy evaluation to later only take as many zeros as we need (e.g., with zip or zipWith).
applyMask uses toReversedBinaryString to get the reversed string and align it with the mask, which we also reverse. Then, zipWith is used to apply the bitmask bit-by-bit, with the rules being implemented by a combineDigits function: 1's and X's in the mask overwrite the original bit, while 0's leave it unchanged.
expand :: String -> [String]
expand [] = [""]
expand (d:ds)
| d == 'X' = map ('0':) (expand ds) ++ map ('1':) (expand ds)
| otherwise = map (d:) (expand ds)
getAddresses :: String -> [Int]
getAddresses = map fromBinary . expand
expand is a surprisingly succinct function, but it is responsible for handling the main challenge of this part of the problem: expanding an address with X's into a list of all the actual addresses that it represents (e.g., "00X1X" expands to ["00010", "00011", "00110", "00111"]). Of course, we achieve this succinctness via recursion, building up the overall list from all the lists generated by the subproblem (i.e., from the tail of the input string). If the leading character is an X, we take two copies of the list of strings generated by the tail; we prepend a 0 to the head of each element in one copy, and a 1 to the head of each element in the other, and then combine them. If the leading character is an X, it is already determined as a 0 or a 1, so we don't need to take two copies - we simply prepend the character as-is.
getAddresses is a simple helper that uses expand, with help of fromBinary, in order to generate an integer list of all addresses.
insertMultiple :: [Int] -> Int -> Map.Map Int Int -> Map.Map Int Int
insertMultiple [] _ m = m
insertMultiple (k:ks) value m = Map.insert k value (insertMultiple ks value m)
execute :: [(String, String, String)] -> String -> Map.Map Int Int -> Map.Map Int Int
execute [] _ mem = mem
execute ((command, address, value):cs) mask mem
| command == "mask" = execute cs value mem
| command == "mem" = execute cs mask (insertMultiple addresses newValue mem)
where addresses = getAddresses (applyMask mask (read address :: Int))
newValue = read value :: Int
solve :: Int
solve = let mem = execute input "" Map.empty
in Map.foldr (+) 0 mem
main :: IO ()
main = print $ solve
With the ability to expand addresses, we can modify our execute function from part 1 to solve the problem. A helper insertMultiple function helps us to insert a given value into a map at multiple keys. The modifications to execute are fairly straightforward: the mask is applied to the address instead, and all addresses resulting from the expansion are written.
Jump to:
D1 | D2 | D3 | D4 | D5 | D6 | D7 | D8 | D9 | D10 | D11 | D12 | D13 | D14 | D15 | D16 | D17 | D18 | D19 | D20 | D21 | D22 | D23 | D24 | D25