advent14/src/advent14.hs

   1 -- import Debug.Trace
   2
   3 import Data.Text (Text)
   4 -- import qualified Data.Text as T
   5 import qualified Data.Text.IO as TIO
   6
   7 import Data.Attoparsec.Text hiding (take)
   8 -- import Data.Attoparsec.Combinator
   9 import Control.Applicative
  10
  11 import Data.Int
  12 import Data.Bits
  13 import Data.Char
  14 import Data.List
  15
  16 import qualified Data.Map.Strict as M
  17 import Data.Map.Strict ((!))
  18
  19
  20 type MaskMap = M.Map Int Int
  21 data Instruction = Mask MaskMap | Assignment Int64 Int64
  22   deriving (Show, Eq)
  23
  24 type Memory = M.Map Int64 Int64
  25 data Machine = Machine { mMemory :: Memory
  26                        , mMask0 :: Int64
  27                        , mMask1 :: Int64
  28                        } deriving (Show, Eq)
  29
  30 emtpyMachine = Machine M.empty (complement 0) 0
  31
  32
  33 main :: IO ()
  34 main =
  35   do  text <- TIO.readFile "data/advent14.txt"
  36       let program = successfulParse text
  37       print $ take 6 program
  38       print $ part1 program
  39
  40
  41 part1 program = sum $ M.elems $ mMemory finalMachine
  42   where finalMachine = executeInstructions program
  43
  44 executeInstructions instructions =
  45   foldl' executeInstruction emtpyMachine instructions
  46
  47 executeInstruction machine (Mask mask) = makeMask machine mask
  48 executeInstruction machine (Assignment loc value) = assignValue machine loc value
  49
  50
  51 makeMask machine mask =
  52   machine {mMask0 = maskZeroes mask, mMask1 = maskOnes mask}
  53
  54 maskValue machine value =
  55   (value .|. (mMask1 machine)) .&. (mMask0 machine)
  56
  57 assignValue machine loc value =
  58   machine {mMemory = M.insert loc value' mem}
  59   where value' = maskValue machine value
  60         mem = mMemory machine
  61
  62
  63 maskOnes :: MaskMap -> Int64
  64 maskOnes mask = foldl' setBit zeroBits ones
  65   where ones = M.keys $ M.filter (== 1) mask
  66
  67 maskZeroes :: MaskMap -> Int64
  68 maskZeroes mask = complement $ foldl' setBit zeroBits ones
  69   where ones = M.keys $ M.filter (== 0) mask
  70
  71
  72 -- Parse the input file
  73
  74 programP = (maskP <|> assignmentP) `sepBy` endOfLine
  75
  76 maskP = maskify <$> ("mask = " *> (many (digit <|> letter)))
  77 assignmentP = Assignment <$> ("mem[" *> decimal) <* "] = " <*> decimal
  78
  79 maskify :: String -> Instruction
  80 maskify chars = Mask (M.fromList locNums)
  81   where locChars = zip [0..] $ reverse chars
  82         locDigits = filter (isDigit . snd) locChars
  83         locNums = map (\(i, n) -> (i, read @Int [n])) locDigits
  84
  85
  86 -- successfulParse :: Text -> (Integer, [Maybe Integer])
  87 successfulParse input =
  88   case parseOnly programP input of
  89     Left  _err -> [] -- TIO.putStr $ T.pack $ parseErrorPretty err
  90     Right program -> program