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
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215 | ;; ported-from: src/gym/valley-blocks.ts @ v1.3.0
;;
;; Offline valley-blocks gym: one round per episode, one PLACEMENT per seat per
;; step() — the game has no host tick, so the gym is piece-synchronous. Every
;; seat runs the same ported engine from the same round seed (identical piece
;; sequences, exactly like live), placements execute through the same
;; placementStep path the live client paces, the scripted snake handler runs
;; bounded, and the verdict comes from the REAL ValleyBlocksSim referee fed with
;; boardStateOf — not a reimplementation. Views are field-identical to the live
;; client's onPiece views, so a policy trained here plugs in unchanged.
;;
;; Accepted skew vs live (the neon-grid one-tick-skew of this game): there is no
;; wall clock — no passive gravity, no soft-drop points, and "first to the
;; target" resolves in seat order within a step rather than in real time, so the
;; live speed race becomes a score-efficiency race here. The per-placement
;; afterstate value is pacing-agnostic; the live pacing layer owns time.
;;
;; Default rewards: min(scoreDelta, 2000)/1000 per placement, −1 on topping out,
;; +1 for winning the round. Pinned by test/vectors/gym-valley-blocks.json.
(ns ardegazu.peer.gym.valley-blocks
(:require [ardegazu.peer.obj :as obj]
[ardegazu.peer.games.host.valley-blocks-engine :as eng]
[ardegazu.peer.games.host.valley-blocks-sim :as vb]
[ardegazu.peer.games.host.valley-blocks-protocol :as proto]
[ardegazu.peer.games.valley-blocks-brain :as brain]
[shadow.cljs.modern :refer (defclass)]))
(def ^:private SNAKE-STEP-BUDGET 200)
(declare gym-views report report-forced)
(defclass ValleyBlocksGym
(constructor [this opts]
(let [players (unchecked-get opts "players")]
(when (< players 2) (throw (js/Error. "valley-blocks gym needs at least 2 players")))
(unchecked-set this "players" players)
(let [mode (unchecked-get opts "mode")
target (unchecked-get opts "target")
max-p (unchecked-get opts "maxPlacements")]
(unchecked-set this "mode" (if ^boolean (js* "~{} == null" mode) "race-survival" mode))
(unchecked-set this "target" (if ^boolean (js* "~{} == null" target) 5000 target))
(unchecked-set this "_maxPlacements" (if ^boolean (js* "~{} == null" max-p) 300 max-p)))
(unchecked-set this "_seed" (unchecked-get opts "seed"))
(let [ids (js/Array. players)]
(dotimes [i players] (aset ids i (str "p" i)))
(unchecked-set this "_ids" ids)
(unchecked-set this "_wins" (.map ids (fn [_] 0)))))
(unchecked-set this "_episode" 0)
(unchecked-set this "_engines" #js [])
(unchecked-set this "_sim" nil)
(unchecked-set this "_round" 0)
(unchecked-set this "_firstSeat" 0)
(unchecked-set this "_placements" 0)
(unchecked-set this "_lastCandidates" #js [])))
(defn- gym-views [self]
(let [engines (unchecked-get self "_engines")]
(unchecked-set self "_lastCandidates"
(.map ^js engines
(fn [e] (if (unchecked-get e "over") #js [] (brain/enumerate-placements e)))))
;; field-identical to games/valley-blocks.cljs ValleyBlocksView, IN ORDER;
;; 12 keys, so sequential sets (the eight-pair js-obj rule)
(.map ^js engines
(fn [e seat]
(obj/ordered
"seat" seat
"over" (unchecked-get e "over")
"score" (unchecked-get e "score")
"lines" (unchecked-get e "lines")
"level" (unchecked-get e "level")
"piece" (unchecked-get (unchecked-get e "active") "type")
"hold" (unchecked-get e "hold")
"canHold" (not (unchecked-get e "holdUsed"))
"candidates" (aget (unchecked-get self "_lastCandidates") seat)
"rivals" (let [out #js []]
(.forEach ^js engines
(fn [r s]
(when-not (identical? s seat)
(.push out (js-obj "score" (unchecked-get r "score")
"over" (unchecked-get r "over"))))))
out)
"mode" (unchecked-get self "mode")
"target" (unchecked-get self "target"))))))
(defn reset
"Start a fresh round; returns the first placement views."
[self]
(unchecked-set self "_episode" (inc (unchecked-get self "_episode")))
(let [round-seed (unsigned-bit-shift-right (+ (unchecked-get self "_seed")
(unchecked-get self "_episode"))
0)
ids (unchecked-get self "_ids")
sim (vb/ValleyBlocksSim.
(js-obj "roster" (fn [] (.map ^js ids
(fn [id i] #js [id id (aget (unchecked-get self "_wins") i)])))
"addWin" (fn [id]
(let [wins (unchecked-get self "_wins")
i (.indexOf ^js ids id)]
(aset wins i (inc (aget wins i))))
js/undefined)
"mode" (unchecked-get self "mode")
"target" (unchecked-get self "target")))]
(unchecked-set self "_sim" sim)
(let [emit (vb/start-round sim ids round-seed)
first-frame (aget (unchecked-get emit "frames") 0)
st (when ^boolean (js* "!!(~{})" first-frame) (unchecked-get first-frame "f"))]
(when-not ^boolean (js* "!!(~{})" st)
(throw (js/Error. "referee refused to start the round")))
(unchecked-set self "_round" (unchecked-get st "round"))
(unchecked-set self "_engines"
(.map ^js ids (fn [_] (eng/ValleyBlocksEngine. (unchecked-get st "seed")
js/undefined))))
(unchecked-set self "_firstSeat" (mod (dec (unchecked-get self "_episode"))
(unchecked-get self "players")))
(unchecked-set self "_placements" 0)
(gym-views self))))
(defn- report [self seat]
(let [emit (vb/on-board-state (unchecked-get self "_sim")
(aget (unchecked-get self "_ids") seat)
(unchecked-get self "_round")
seat
(proto/board-state-of (aget (unchecked-get self "_engines") seat)))
ov (.find ^js (unchecked-get emit "frames")
(fn [x] (identical? "ov" (unchecked-get (unchecked-get x "f") "t"))))]
(if ^boolean (js* "!!(~{})" ov) (unchecked-get ov "f") nil)))
(defn- report-forced [self seat]
(let [s (proto/board-state-of (aget (unchecked-get self "_engines") seat))
forced (js/Object.assign (js-obj) s)]
(unchecked-set forced "over" true)
(let [emit (vb/on-board-state (unchecked-get self "_sim")
(aget (unchecked-get self "_ids") seat)
(unchecked-get self "_round") seat forced)
ov (.find ^js (unchecked-get emit "frames")
(fn [x] (identical? "ov" (unchecked-get (unchecked-get x "f") "t"))))]
(if ^boolean (js* "!!(~{})" ov) (unchecked-get ov "f") nil))))
(defn step
"One placement per alive seat, in rotated seat order; actions index the
candidates of the views returned by the previous call (boards are
independent, so those candidates are still exact). Invalid/null actions fall
back to the stock pick."
[self actions]
(let [sim (unchecked-get self "_sim")]
(when-not (and ^boolean (js* "!!(~{})" sim) (unchecked-get sim "_running"))
(throw (js/Error. "call reset() first")))
(let [engines (unchecked-get self "_engines")
players (unchecked-get self "players")
ids (unchecked-get self "_ids")
score-before (.map ^js engines (fn [e] (unchecked-get e "score")))
over-before (.map ^js engines (fn [e] (unchecked-get e "over")))
over (volatile! nil)]
(loop [i 0]
(when (and (< i players) (nil? @over))
(let [seat (mod (+ (unchecked-get self "_firstSeat") i) players)
e (aget engines seat)]
(when-not (unchecked-get e "over")
(let [cands (let [c (aget (unchecked-get self "_lastCandidates") seat)]
(if ^boolean (js* "~{} == null" c) #js [] c))]
(if (pos? (.-length cands))
(let [raw (aget actions seat)
a (if (or ^boolean (js* "~{} == null" raw)
(< raw 0)
(>= raw (.-length cands)))
(brain/stock-pick cands)
raw)]
(brain/execute-placement e (aget cands a)))
(eng/hard-drop e))) ; nothing fit — commit and end the board
(let [budget (volatile! SNAKE-STEP-BUDGET)]
(loop []
(when (and (unchecked-get e "snake") (> @budget 0))
(vswap! budget dec)
(brain/snake-step e)
(recur))))
(when (unchecked-get e "snake") (eng/hard-drop e))
(vreset! over (report self seat)))
(recur (inc i)))))
(unchecked-set self "_placements" (inc (unchecked-get self "_placements")))
(when (and (nil? @over)
(>= (unchecked-get self "_placements") (unchecked-get self "_maxPlacements")))
;; out of patience: everyone is declared out, highest score takes it
(loop [seat 0]
(when (and (< seat players) (nil? @over))
(vreset! over (report-forced self seat))
(recur (inc seat)))))
(let [rewards (.map ^js engines
(fn [e seat]
(if (aget over-before seat)
0
(let [r (/ (js/Math.min (- (unchecked-get e "score")
(aget score-before seat))
2000)
1000)]
(if (unchecked-get e "over") (- r 1) r)))))]
(if ^boolean (js* "!!(~{})" @over)
(let [w (unchecked-get @over "w")
winner (if (nil? w) nil (.indexOf ^js ids w))]
(when (and (not (nil? winner)) (>= winner 0) (not (aget over-before winner)))
(aset rewards winner (+ (aget rewards winner) 1)))
(js-obj "views" (gym-views self)
"rewards" rewards
"done" true
"winner" (if (and (not (nil? winner)) (>= winner 0)) winner nil)
"reason" (unchecked-get @over "reason")))
(js-obj "views" (gym-views self) "rewards" rewards
"done" false "winner" nil "reason" nil))))))
(let [proto (.-prototype ValleyBlocksGym)]
(unchecked-set proto "reset" (fn [] (this-as self (reset self))))
(unchecked-set proto "step" (fn [actions] (this-as self (step self actions)))))
|