aboutsummaryrefslogtreecommitdiff
path: root/execs/Day14.hs
blob: e1e0e37966c1b08c0fc71e2e398f76f26d6c106c (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
module Main where

import           Data.Bifunctor                (bimap)
import           Data.Char
import           Data.Either
import           Data.Map                      (Map)
import qualified Data.Map                      as Map
import           Data.Strings
import           Numeric                       (readInt, showIntAtBase)
import           Text.Parsec.Char
import           Text.ParserCombinators.Parsec
import           Utils

data Stmt = Mask String | Mem Int Int deriving Show

parseMask :: Parser Stmt
parseMask = string "mask = " >> Mask <$> many anyChar

parseNumber :: Parser Int
parseNumber = read <$> many1 digit

parseMem :: Parser Stmt
parseMem = Mem <$ string "mem[" <*> parseNumber <* string "] = " <*> parseNumber

parseLine :: Parser Stmt
parseLine = try parseMask <|> parseMem

applyMask :: Int -> String -> Int
applyMask v m = fst $ head $ readInt 2 (`elem` "01") digitToInt wm
    where bv = strPadLeft '0' 36 $ showIntAtBase 2 intToDigit v ""
          wm = zipWith fn bv m
          fn o 'X' = o
          fn _ '1' = '1'
          fn _ '0' = '0'

runProgram :: [Stmt] -> Int
runProgram ls = sum regs
    where (mask, regs) = foldl fn ("", Map.empty) ls
          fn (_, regs) (Mask s) = (s, regs)
          fn (m, regs) (Mem idx val) = (m, Map.insert idx nval regs)
              where nval = applyMask val m

floatings :: String -> [String]
floatings []       = [[]]
floatings ('X':xs) = floatings xs >>= (\b -> ['0':b, '1':b])
floatings (x:xs)   = map (x:) $ floatings xs

genIdxs :: Int -> String -> [Int]
genIdxs v m = map (fst . head . readInt 2 (`elem` "01") digitToInt) (floatings wm)
    where bv = strPadLeft '0' 36 $ showIntAtBase 2 intToDigit v ""
          wm = zipWith fn bv m
          fn o '0' = o
          fn _ '1' = '1'
          fn _ 'X' = 'X'

v2chip :: [Stmt] -> Int
v2chip ls = sum regs
    where (mask, regs) = foldl fn ("", Map.empty) ls
          fn (_, regs) (Mask s) = (s, regs)
          fn (m, regs) (Mem idx val) = (m, nmap)
              where idxs = genIdxs idx m
                    nmap = flip Map.union regs $ Map.fromList $ zip idxs $ repeat val


main :: IO ()
main = do
    n <- rights . map (parse parseLine "main") . lines <$> readFile "input/14"
    print $ runProgram n
    print $ v2chip n