ionchy
/
adventofcode
1
0
Fork 0
Code

Day 16.

This commit is contained in:
Jonathan Chan 2018-12-17 12:49:46 -08:00
parent e4ba4a6a86
commit cc6bf1f7dc
5 changed files with 4223 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
README.md
View File

@ -26,7 +26,7 @@ Now located in this repository's wiki.
| 12 | ~ 1.5 |
| 13 | ~ 0.5 |
| 14 | 22.3 |
| 15 | |
| 15 | < 1 |
| 16 | |
| 17 | |
| 18 | |

2
app/Main.hs
View File

@ -30,4 +30,4 @@ import qualified Day24
import qualified Day25
main :: IO ()
main = Day14.main
main = Day16.main

32
input/15.txt Normal file
View File

@ -0,0 +1,32 @@
################################
################.G#...##...#####
#######..#######..#.G..##..#####
#######....#####........##.#####
######.....#####.....GG.##.#####
######..GG.##.###G.........#####
#####........G####.......#######
######.#..G...####........######
##########....#####...G...######
########.......###..........####
#########...GG####............##
#########....................###
######........#####...E......###
####....G....#######........####
###.........#########.......####
#...#.G..G..#########..........#
#..###..#...#########E.E....E###
#..##...#...#########.E...E...##
#.....G.....#########.........##
#......G.G...#######........####
###..G...#....#####........#####
###########....G........EE..####
##########...................###
##########...................###
#######.............E....##E####
#######................#########
########.#.............#########
#######..#####.#......##########
######...#######...##.##########
################..###.##########
###############.......##########
################################

4092
input/16.txt Normal file
View File

File diff suppressed because it is too large Load Diff

99
src/Day16.hs
View File

@ -1,6 +1,101 @@
module Day16 (main) where
import Prelude hiding (null, (!!))
import Data.Bits ((.&.), (.|.))
import Data.Foldable (all, toList, foldl')
import Data.Sequence (Seq, fromList, update, index)
import qualified Data.Map as M' (fromList, (!))
import Data.IntMap (IntMap, null, insertWith, partition, (!))
import qualified Data.IntMap as M (empty, union)
import Data.Set (Set, singleton, size, (\\))
import qualified Data.Set as S (empty, union)
-- Instr OpCode RegisterA/ImmediateA RegisterB/ImmediateB RegisterC
data Instruction = Instr Int Int Int Int deriving Show
type Registers = Seq Int
type Sample = (Instruction, Registers, Registers)
type OpsMap = IntMap (Set String)
type OpMap = IntMap Op
type Op = Instruction -> Registers -> Registers
infixl 9 !!
(!!) = index
(!!!) = (M'.!)
initialRegisters = fromList [0, 0, 0, 0]
applyInstruction :: OpMap -> Op
applyInstruction opMap instr@(Instr op _ _ _) = opMap ! op $ instr
addr, addi, mulr, muli, banr, bani, borr, bori, setr, seti, gtir, gtri, gtrr, eqir, eqri, eqrr :: Op
addr (Instr _ rA rB rC) rs = update rC (rs !! rA + rs !! rB) rs
mulr (Instr _ rA rB rC) rs = update rC (rs !! rA * rs !! rB) rs
banr (Instr _ rA rB rC) rs = update rC (rs !! rA .&. rs !! rB) rs
borr (Instr _ rA rB rC) rs = update rC (rs !! rA .|. rs !! rB) rs
addi (Instr _ rA vB rC) rs = update rC (rs !! rA + vB) rs
muli (Instr _ rA vB rC) rs = update rC (rs !! rA * vB) rs
bani (Instr _ rA vB rC) rs = update rC (rs !! rA .&. vB) rs
bori (Instr _ rA vB rC) rs = update rC (rs !! rA .|. vB) rs
setr (Instr _ rA _ rC) rs = update rC (rs !! rA) rs
seti (Instr _ vA _ rC) rs = update rC vA rs
gtir (Instr _ vA rB rC) rs = update rC (fromEnum $ vA > rs !! rB) rs
eqir (Instr _ vA rB rC) rs = update rC (fromEnum $ vA == rs !! rB) rs
gtri (Instr _ rA vB rC) rs = update rC (fromEnum $ rs !! rA > vB) rs
eqri (Instr _ rA vB rC) rs = update rC (fromEnum $ rs !! rA == vB) rs
gtrr (Instr _ rA rB rC) rs = update rC (fromEnum $ rs !! rA > rs !! rB) rs
eqrr (Instr _ rA rB rC) rs = update rC (fromEnum $ rs !! rA == rs !! rB) rs
ops = [addr, addi, mulr, muli, banr, bani, borr, bori, setr, seti, gtir, gtri, gtrr, eqir, eqri, eqrr]
opNames = ["addr","addi","mulr","muli","banr","bani","borr","bori","setr","seti","gtir","gtri","gtrr","eqir","eqri","eqrr"]
opNameToOp :: String -> Op
opNameToOp = (!!!) . M'.fromList $ zip opNames ops
parse :: [String] -> ([Sample], [Instruction])
parse ("":"":instrs) = ([], parseInstrs instrs)
parse (before:instr:after:_:rest) =
let beforeRegs = fromList . read . drop 8 $ before
afterRegs = fromList . read . drop 8 $ after
(op:a:b:c:[]) = map read . words $ instr
(samples, instrs) = parse rest
in ((Instr op a b c, beforeRegs, afterRegs):samples, instrs)
parseInstrs :: [String] -> [Instruction]
parseInstrs [] = []
parseInstrs (instr:rest) =
let (op:a:b:c:[]) = map read . words $ instr
in (Instr op a b c):(parseInstrs rest)
opCount :: Sample -> Int
opCount (instr, beforeRegs, afterRegs) = length . filter (\op -> afterRegs == op instr beforeRegs) $ ops
opIdentify :: Sample -> OpsMap -> OpsMap
opIdentify (instr@(Instr opCode _ _ _), beforeRegs, afterRegs) m =
foldr (\(op, opName) m' -> if afterRegs == op instr beforeRegs then insertWith S.union opCode (singleton opName) m' else m') m $ zip ops opNames
reduceOpMap :: OpsMap -> OpMap
reduceOpMap = reduceOpMapRec M.empty
where reduceOpMapRec assigned m =
let (singletons, rest) = partition ((== 1) . size) m
singletonsSet = foldr S.union S.empty singletons
newAssigned = M.union assigned singletons
in if null rest
then fmap (opNameToOp . head . toList) newAssigned
else reduceOpMapRec newAssigned $ fmap (\\ singletonsSet) rest
part1 :: [Sample] -> Int
part1 = length . filter (>= 3) . map opCount
part2a :: [Sample] -> OpMap
part2a samples = reduceOpMap . foldr opIdentify M.empty $ samples
part2b :: OpMap -> [Instruction] -> Registers
part2b opMap = foldr (applyInstruction opMap) initialRegisters . reverse
main :: IO ()
main = do
input <- readFile "input/16.txt"
print input
(samples, instrs) <- parse . lines <$> readFile "input/16.txt"
print $ part1 samples
let opMap = part2a samples
print $ part2b opMap instrs