aboutsummaryrefslogtreecommitdiff
path: root/execs/Day14.hs
blob: d82424ae89a88e03329fb580084db0ad5d4d3e4a (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
module Main where

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

data Stmt = Mask String | Mem Int Int deriving Show

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

parseMem :: Parser Stmt
parseMem = do 
    one <- string "mem[" >> many1 digit
    two <- string "] = " >> many1 digit
    return $ Mem (read one) (read two)

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