-
Notifications
You must be signed in to change notification settings - Fork 0
/
day16.hs
108 lines (81 loc) · 3.13 KB
/
day16.hs
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
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
import Data.Bits
import Data.List
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Tuple
type Registers = [Int]
type Op = Registers -> Int -> Int -> Int -> Registers
type Instruction = (Int, Int, Int, Int)
get :: Int -> Registers -> Int
get 0 [value, _, _, _] = value
get 1 [_, value, _, _] = value
get 2 [_, _, value, _] = value
get 3 [_, _, _, value] = value
set :: Int -> Registers -> Int -> Registers
set 0 [_, _1, _2, _3] value = [value, _1, _2, _3]
set 1 [_0, _, _2, _3] value = [_0, value, _2, _3]
set 2 [_0, _1, _, _3] value = [_0, _1, value, _3]
set 3 [_0, _1, _2, _] value = [_0, _1, _2, value]
op :: (Int -> Registers -> Int) -> (Int -> Registers -> Int) -> (Int -> Int -> Int) -> Op
op getA getB fun registers a b c = set c registers (fun (getA a registers) (getB b registers))
addr :: Op
addr = op get get (+)
addi :: Op
addi = op get (const . id) (+)
mulr :: Op
mulr = op get get (*)
muli :: Op
muli = op get (const . id) (*)
banr :: Op
banr = op get get (.&.)
bani :: Op
bani = op get (const . id) (.&.)
borr :: Op
borr = op get get (.|.)
bori :: Op
bori = op get (const . id) (.|.)
setr :: Op
setr = op get get const
seti :: Op
seti = op (const . id) get const
gtir :: Op
gtir = op (const . id) get (\x y -> fromEnum $ x > y)
gtri :: Op
gtri = op get (const . id) (\x y -> fromEnum $ x > y)
gtrr :: Op
gtrr = op get get (\x y -> fromEnum $ x > y)
eqir :: Op
eqir = op (const . id) get (\x y -> fromEnum $ x == y)
eqri :: Op
eqri = op get (const . id) (\x y -> fromEnum $ x == y)
eqrr :: Op
eqrr = op get get (\x y -> fromEnum $ x == y)
opcodes :: [Op]
opcodes = [addr, addi, mulr, muli, banr, bani, borr, bori, setr, seti, gtir, gtri, gtrr, eqir, eqri, eqrr]
execute :: [Op] -> Registers -> Instruction -> Registers
execute ops registers (op, a, b, c) = (ops !! op) registers a b c
parseInstruction :: String -> Instruction
parseInstruction instruction =
let [op, a, b, c] = map read $ words $ instruction
in (op, a, b, c)
parse :: [String] -> ([(Registers, Instruction, Registers)], [Instruction])
parse ("" : "" : xs) = ([], map parseInstruction xs)
parse (('B':'e':'f':'o':'r':'e':':':' ':before) : instruction : ('A':'f':'t':'e':'r':':':' ':' ':after) : "" : xs) =
let (samples, program) = parse xs
in ((read before, parseInstruction instruction, read after) : samples, program)
ops :: [(Registers, Instruction, Registers)] -> Map Int Int -> [Op]
ops samples mapping =
if Map.size mapping == length opcodes
then map (\(_, i) -> opcodes !! i) $ sort $ map swap $ Map.toList mapping
else ops samples $ foldl matching mapping samples
where matching mapping (before, (op, a, b, c), after) =
case filter (\(i, op) -> op before a b c == after && i `Map.notMember` mapping) $ zip [0..] opcodes of
[(i, _)] -> Map.insert i op mapping
_ -> mapping
part1 :: String -> Int
part1 = length . filter (>= 3) . map matching . fst . parse . lines
where matching (before, (_, a, b, c), after) = length $ filter (\op -> op before a b c == after) opcodes
part2 :: String -> Int
part2 input =
let (samples, program) = parse $ lines input
in get 0 $ foldl (execute $ ops samples Map.empty) [0,0,0,0] program