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 | ;; ported-from: src/gym/seance.ts @ v1.3.0
;;
;; Offline séance gym: the pure sim stepped synchronously, one bell per step(),
;; with per-seat views field-identical to the live SeanceClient's SeanceView —
;; a policy trained here plugs into SeanceOptions.onTurn unchanged. No
;; networking, no timers; a fixed seed makes a whole training run reproducible.
;;
;; Default rewards (shape further from the views if you need more): −1 when a
;; seat loses a candle, +5 for winning the séance, −2 when eliminated, else 0.
;;
;; The trainer scores promotions against this, so the reward shaping, the RNG
;; consumption and the view field ORDER are pinned by test/vectors/gym-seance.json
;; plus the gym↔client view-parity assertion.
(ns ardegazu.peer.gym.seance
(:require [ardegazu.peer.games.host.rng :refer (mulberry32)]
[ardegazu.peer.games.host.seance-sim :as seance-sim]
[shadow.cljs.modern :refer (defclass)]))
(declare gym-apply gym-views gym-roster)
(defclass SeanceGym
(constructor [this opts]
(let [players (unchecked-get opts "players")]
(when (< players 1) (throw (js/Error. "seance gym needs at least 1 player")))
(unchecked-set this "players" players)
(let [seed (unchecked-get opts "seed")]
(unchecked-set this "_rng" (mulberry32 (if ^boolean (js* "~{} == null" seed) 1 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 "_seanceNo" 0)
(unchecked-set this "_sim" nil)
;; client-visible state, folded from frames exactly like SeanceClient
(unchecked-set this "_bell" 0)
(unchecked-set this "_candles" #js [])
(unchecked-set this "_rooms" #js [])
(unchecked-set this "_medium" -1)
(unchecked-set this "_hintNot" -1)))
(defn- gym-roster [self]
(.map ^js (unchecked-get self "_ids")
(fn [id i] #js [id id i (aget (unchecked-get self "_wins") i)])))
(defn- gym-apply
"Fold host frames into the client-visible state (mirrors SeanceClient)."
[self frames]
(.forEach ^js frames
(fn [e]
(let [f (unchecked-get e "f")
t (unchecked-get f "t")]
(cond
(identical? t "st")
(do (unchecked-set self "_candles"
(.map ^js (unchecked-get f "order")
(fn [_] (unchecked-get f "candles"))))
(unchecked-set self "_rooms"
(.map ^js (unchecked-get f "order") (fn [_] 0)))
(unchecked-set self "_bell" 0)
(unchecked-set self "_hintNot" -1)
(unchecked-set self "_medium" -1))
(identical? t "be")
(do (unchecked-set self "_bell" (unchecked-get f "bell"))
(unchecked-set self "_medium" (unchecked-get f "medium"))
(unchecked-set self "_hintNot" -1))
(identical? t "hm")
(unchecked-set self "_hintNot" (unchecked-get f "not"))
(identical? t "rv")
(do (unchecked-set self "_rooms" (.slice ^js (unchecked-get f "rooms")))
(unchecked-set self "_candles" (.slice ^js (unchecked-get f "candles"))))
:else nil))))
js/undefined)
(defn- gym-views [self]
;; SeanceGymView — field-identical to games/seance.cljs SeanceView, IN ORDER
(.map ^js (unchecked-get self "_ids")
(fn [_ seat]
(js-obj "bell" (unchecked-get self "_bell")
"seat" seat
"candles" (.slice ^js (unchecked-get self "_candles"))
"rooms" (.slice ^js (unchecked-get self "_rooms"))
"hintNot" (if (identical? seat (unchecked-get self "_medium"))
(unchecked-get self "_hintNot")
-1)
"isMedium" (identical? seat (unchecked-get self "_medium"))))))
(defn reset
"Start a séance and ring the first bell; returns the first decision views."
[self]
(let [ids (unchecked-get self "_ids")
sim (seance-sim/SeanceSim.
(js-obj "rng" (unchecked-get self "_rng")
"now" (fn [] 0)
"roster" (fn [] (gym-roster self))
"addWin" (fn [id]
(let [wins (unchecked-get self "_wins")
i (.indexOf ^js ids id)]
(aset wins i (inc (aget wins i))))
js/undefined)))]
(unchecked-set self "_sim" sim)
(unchecked-set self "_seanceNo" (inc (unchecked-get self "_seanceNo")))
(gym-apply self (unchecked-get (seance-sim/start sim (unchecked-get self "_seanceNo") ids)
"frames"))
(gym-apply self (unchecked-get (seance-sim/step sim "bell") "frames"))
(gym-views self)))
(defn step
"One bell: actions[seat] = room 0..2 or null (stay)."
[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 [players (unchecked-get self "players")
ids (unchecked-get self "_ids")]
(dotimes [s players]
(let [a (aget actions s)]
(when-not ^boolean (js* "~{} == null" a)
(gym-apply self (unchecked-get (seance-sim/pick sim (aget ids s) a) "frames")))))
(let [before (.slice ^js (unchecked-get self "_candles"))
resolved (seance-sim/step sim "resolve")]
(gym-apply self (unchecked-get resolved "frames"))
(let [candles (unchecked-get self "_candles")
rewards (.map candles (fn [c s] (if (< c (aget before s)) -1 0)))
nxt (unchecked-get resolved "next")]
(if (and ^boolean (js* "!!(~{})" nxt) (identical? "end" (unchecked-get nxt "step")))
(let [end (seance-sim/step sim "end")]
(gym-apply self (unchecked-get end "frames"))
(let [ov (unchecked-get (aget (unchecked-get end "frames") 0) "f")
w (unchecked-get ov "w")
winner (if (nil? w) nil (.indexOf ^js ids w))]
(dotimes [s players]
(if (identical? s winner)
(aset rewards s (+ (aget rewards s) 5))
(when (and (<= (aget (unchecked-get self "_candles") s) 0)
(> (aget before s) 0))
(aset rewards s (+ (aget rewards s) -2)))))
(js-obj "views" (gym-views self) "rewards" rewards "done" true "winner" winner)))
(do
(gym-apply self (unchecked-get (seance-sim/step sim "bell") "frames"))
(js-obj "views" (gym-views self) "rewards" rewards
"done" false "winner" nil))))))))
(let [proto (.-prototype SeanceGym)]
(unchecked-set proto "reset" (fn [] (this-as self (reset self))))
(unchecked-set proto "step" (fn [actions] (this-as self (step self actions)))))
|