/
day19.hs
114 lines (105 loc) · 4.36 KB
/
day19.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
109
110
111
112
113
114
import MyUtils (readInt)
import Data.Set (Set)
import qualified Data.Set as S
data Blueprint = BP
{ bpId :: Int,
oreCost :: Int,
clayCost :: Int,
obsCost :: (Int, Int),
geoCost :: (Int, Int)
} deriving (Show, Eq, Ord)
data Robot = Ore | Clay | Obsidian | Geode deriving (Show, Eq, Ord)
data State = S
{ blueprint :: Blueprint,
target :: Robot,
candidates :: [Robot],
numOre :: Int,
numClay :: Int,
numObs :: Int,
numGeo :: Int,
robOre :: Int,
robClay :: Int,
robObs :: Int,
robGeo :: Int
} deriving (Show, Eq, Ord)
stateIter :: State -> [State]
stateIter st@(S {blueprint, target, candidates, numOre, numClay, numObs, numGeo, robOre, robClay, robObs, robGeo}) = nextStates
where
robotType = target
orePrice = oreCost blueprint
clayPrice = clayCost blueprint
(obsOrePrice, obsClayPrice) = obsCost blueprint
(geoOrePrice, geoObsPrice) = geoCost blueprint
spend = case robotType of
Ore -> numOre >= orePrice
Clay -> numOre >= clayPrice
Obsidian -> numOre >= obsOrePrice && numClay >= obsClayPrice
Geode -> numOre >= geoOrePrice && numObs >= geoObsPrice
candidates'
| robObs' > 0 = [Ore, Clay, Obsidian, Geode]
| robClay > 0 = [Ore, Clay, Obsidian]
| otherwise = [Ore, Clay]
numOre' = numOre + robOre - spentOre
numClay' = numClay + robClay - spentClay
numObs' = numObs + robObs - spentObs
numGeo' = numGeo + robGeo
robOre' = if spend && robotType == Ore then robOre + 1 else robOre
robClay' = if spend && robotType == Clay then robClay + 1 else robClay
robObs' = if spend && robotType == Obsidian then robObs + 1 else robObs
robGeo' = if spend && robotType == Geode then robGeo + 1 else robGeo
spentObs = if spend && robotType == Geode then geoObsPrice else 0
spentClay = if spend && robotType == Obsidian then obsClayPrice else 0
spentOre = if not spend then 0 else case robotType of
Ore -> orePrice
Clay -> clayPrice
Obsidian -> obsOrePrice
Geode -> geoOrePrice
nextTemplate = st {target=target, candidates = candidates', numOre = numOre', numClay = numClay', numObs = numObs', numGeo = numGeo', robOre = robOre', robClay = robClay', robObs = robObs', robGeo = robGeo'}
nextStates = if spend then map (\x -> nextTemplate {target=x}) candidates' else [nextTemplate]
initStates :: Blueprint -> Set State
initStates bp = S.fromList [template, template {target=Clay}]
where
template = S { blueprint = bp,
target = Ore,
candidates = [Ore, Clay],
numOre = 0,
numClay = 0,
numObs = 0,
numGeo = 0,
robOre = 1,
robClay = 0,
robObs = 0,
robGeo = 0
}
numInc :: Int -> Int -> Int
numInc x y = go (x +1) (y -1) x
where
go x y z
| y <= 0 = z
| otherwise = go (x + 1) (y -1) (x + z)
multiTurn :: Set State -> Int -> Set State
multiTurn sts 0 = sts
multiTurn sts n = ( multiTurn $ S.filter (\x -> maxPossible x >= maxCurrent) unfiltered) (n-1)
where
unfiltered = S.fromList $ concatMap stateIter sts
num = n + 1
maxCurrent = maximum $ S.map (\x -> numGeo x + num * robGeo x) unfiltered
maxPossible x = numGeo x + numInc (robGeo x) num
solver :: [Set State] -> Int -> Int
solver sts int = foldl (folder (int -1)) 0 sts
where
folder int acc st = acc + maximum (S.map (\x -> bpId (blueprint x) * (numGeo x + robGeo x)) $ multiTurn st int)
main = do
rawInput <- readFile "day19.txt"
let input = map words $ lines rawInput
blueprints = map (\x -> BP {bpId = readInt $ init $ x !! 1, oreCost = readInt $ x !! 6, clayCost = readInt $ x !! 12, obsCost = (readInt $ x !! 18, readInt $ x !! 21), geoCost = (readInt $ x !! 27, readInt $ x !! 30)}) input
part2BP = take 3 blueprints
initHeadStates = initStates (head part2BP)
initMidStates = initStates (head $ tail part2BP)
initLastStates = initStates (last part2BP)
allInitStates = map initStates blueprints
first = maximum $ S.map (\x -> numGeo x + robGeo x) $ multiTurn initHeadStates 31
second = maximum $ S.map (\x -> numGeo x + robGeo x) $ multiTurn initMidStates 31
third = maximum $ S.map (\x -> numGeo x + robGeo x) $ multiTurn initLastStates 31
print $ solver allInitStates 24
print $ first * second * third