forked from wzrdsappr/trading-core
-
Notifications
You must be signed in to change notification settings - Fork 0
/
agent.lisp
317 lines (279 loc) · 14.5 KB
/
agent.lisp
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
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
;;;; agent.lisp
(in-package #:trading-core)
(named-readtables:in-readtable rutils-readtable)
(defclass agent ()
((name :accessor name :initarg :name :initform nil
:documentation "Human-readable name of the agent.")
(security :accessor security :initarg :security :type keyword
:documentation "Keyword symbol of the security being traded by the agent.")
(market-hours :accessor market-hours :initarg :market-hours
:initform (list (local-time:parse-timestring "09:30:00")
(local-time:parse-timestring "15:45:00"))
:documentation "Hours the market is open. Can be used in conjunction with the MARKET-CLOSED-P method
to close out open positions or prevent trading during high volatility/low liquidity times.")
(short-size :accessor unblock-short :initform -1)
(long-size :accessor unblock-long :initform 1)
(timestamps :accessor timestamps :initform nil
:documentation "Reverse-chronological series of event timestamps seen by the agent.")
(revalprices :accessor revalprices :initform nil
:documentation "Reverse-chronological series of price events seen by the agent.")
(orders :accessor orders :initform nil
:documentation "Reverse-chronological series of orders issued by the agent.")
(positions :accessor positions :initform nil
:documentation "Reverse-chronological series of positions requested by the agent.")
(pls :accessor pls :initform nil
:documentation "Reverse-chronological series of profits/losses. Does not account for slippage.")
(navs :initform nil
:documentation "Reverse-chronological series of agent's clock-time Net Asset Value (NAV). Does not account for slippage.")
(indicators :accessor indicators :initform nil
:documentation "Reverse-chronological series of indicator values.")
(fitnesses :accessor fitnesses :initform nil
:documentation "Reverse-chronological series of trading strategy fitness calculations.")
(trade-groups-cache :accessor trade-groups-cache :initform nil :type (or list nil)
:documentation "Cached grouped trades (market entry to exit) in reverse-chronological order.")
(unprocessed-trades :accessor unprocessed-trades :initform nil
:documentation "New, unprocessed/grouped trades in reverse-chronological order.")
(latest-trade-stats :initform nil :type (or 'trade-stats nil)
:documentation "Cached version of the last computed trade stats.")
(incoming-messages :accessor incoming-messages :initform nil
:documentation "Set of messages from other agents. Used for inter-agent coordination.")
(outgoing-messages :accessor outgoing-messages :initform nil
:documentation "Set of messages to be passed to the other agents in the RECIPIENTS-LIST.")
(recipients-list :accessor recipients-list :initarg :recipients-list :initform nil
:documentation "Names of other agents that should receive outgoing messages.")
(fitness-feedback-control :accessor fitness-feedback-control :initarg :fitness-feedback-control :initform nil)))
;;; Agent methods
(defmethod initialize-instance :after ((a agent) &key)
;; Build the agent name
(let ((format-string "~A")
(name-parameter-values (list (extract-initials (type-of a)))))
;; Add security differentiator
(when (and (slot-boundp a 'security)
(slot-value a 'security))
(setf format-string (concatenate 'string format-string "_~A"))
(push (slot-value a 'security) name-parameter-values))
;; Add direct initialization values
(loop for slot in (c2mop:class-direct-slots (class-of a))
for slot-name = (c2mop:slot-definition-name slot)
for arg-value = (when (slot-boundp a slot-name)
(slot-value a slot-name))
when (and arg-value
(c2mop:slot-definition-initargs slot)
(not (eql (type-of arg-value) 'fitness-feedback-control)))
do (progn
(setf format-string (concatenate 'string format-string
(cond
((floatp arg-value) "_~4,2F")
(t "_~A"))))
(push arg-value name-parameter-values)))
;; Add fitness-feedback-control differentiator
(when (and (slot-boundp a 'fitness-feedback-control)
(slot-value a 'fitness-feedback-control))
(setf format-string (concatenate 'string format-string "_~A"))
(push (slot-value (slot-value a 'fitness-feedback-control) 'name) name-parameter-values))
(setf (slot-value a 'name) (format nil "~?" format-string (nreverse name-parameter-values)))))
(defmethod print-object ((a agent) stream)
(with-slots (name security) a
(print-unreadable-object (a stream :type t :identity t)
(when (and (slot-boundp a 'name) name)
(princ name stream))
(when (slot-boundp a 'security)
(princ " " stream)
(princ security stream)))))
;; Memoized "slot" functions
(defmethod trade-groups ((agent agent))
"Retrieve/partition trades grouped by market position (entry/exit).
Single-trade position reversals (long-to-short/short-to-long) will be broken into
two dummy trades for easier accounting/statistics calcuations. A dummy trade will
also be inserted into the last group to close out an on-going trade."
(with-slots (trade-groups-cache unprocessed-trades timestamps revalprices) agent
;; group any unprocessed trades and add them to the trade group cache.
(unless (null unprocessed-trades)
(let* ((dummy-exit-trade-p #`(string= "DummyExit" (trade-description %)))
(last-group-trades (and (not (null trade-groups-cache))
(trade-group-trades (first trade-groups-cache)))))
(setf trade-groups-cache
(if (and (not (null last-group-trades)) ;; Reprocess last trade group if it
(some dummy-exit-trade-p last-group-trades)) ;; contains a dummy exit trade.
`(,@(partition-trades
`(,@unprocessed-trades
,@(remove-if dummy-exit-trade-p last-group-trades))
(first timestamps) (first revalprices))
,@(rest trade-groups-cache))
`(,@(partition-trades unprocessed-trades (first timestamps) (first revalprices))
,@trade-groups-cache))
unprocessed-trades nil)))
trade-groups-cache))
(defmethod trade-stats ((a agent))
"Retrieve/calculate the current the agent's current trade stats."
(with-slots (unprocessed-trades latest-trade-stats) a
(if (and latest-trade-stats (null unprocessed-trades))
latest-trade-stats
(setf latest-trade-stats (compute-trade-stats a)))))
(defmethod trades ((a agent))
"Retrieve all trades an agent has made."
(with-slots (unprocessed-trades trade-groups-cache) a
`(,@unprocessed-trades
,@(unless (null trade-groups-cache)
(rutils:flatten (loop for trade-group in trade-groups-cache
collecting (reverse (trade-group-trades trade-group))))))))
;; Position retrieval functions
(defun adjusted-position (position)
"Retrieve the final fitness-feedback-control adjusted position."
(if (listp position)
(car position)
position))
(defun original-position (position)
"Retrieve the original, unadjusted position."
(if (listp position)
(second position)
position))
;; Trading methods
(defmethod observe ((a agent) (e event))
t)
(defmethod observe ((a agent) (e market-update))
(or (not (security a))
(eql (security a) (security e))))
(defmethod observe ((a agent) (e comm))
(and (not (equal a (originator e)))
(member a (recipients e))))
(defun consume (agent event)
(when (observe agent event)
(update agent event)))
(defmethod emit ((a agent) msg &optional (comm-type 'comm))
(let ((timestamp (first (timestamps a))))
(push (make-instance
comm-type
:originator a
:recipients (recipients-list a)
:timestamp timestamp
:value msg)
*events-queue*)
(push (list timestamp msg) (outgoing-messages a))))
(defun market-closed-p (agent timestamp)
"Predicate to determine if the market is in after-hours trading for the given event.
The market is indicated as closed 15 minutes before the end of the trading session to give the
agent time to close any open positions."
(with-slots (market-hours) agent
(or (member (local-time:timestamp-day-of-week timestamp)
'(0 6)) ; Sunday or Saturday
(or (not (<= (local-time:sec-of (first market-hours))
(local-time:sec-of timestamp)
(local-time:sec-of (second market-hours))))))))
(defmethod preprocess ((a agent) (e market-direction-comm))
"Set the allowed trading position based on market direction"
(with-slots (short-size long-size) a
(case (value e)
(:range (setf short-size 0
long-size 0))
(:long (setf short-size 0
long-size 1))
(:short (setf short-size -1
long-size 0)))))
;; UPDATE :BEFORE methods
(defmethod update :before ((a agent) (e market-update))
(with-slots (timestamps revalprices) a
(push (timestamp e) timestamps)
(push (price e) revalprices))
(oms a e :algo-category :all)
(preprocess a e)
(log:debug ":BEFORE completed for agent ~A and event ~A~%" a e))
(defmethod update :before ((a agent) (e comm))
(push e (incoming-messages a))
(preprocess a e)
(log:debug ":BEFORE completed for agent ~A and COMM event ~A~%" a e))
;; UPDATE MAIN methods
(defmethod update ((a agent) (e market-update))
(log:debug "Enter new position for T= ~A and P= ~A" (timestamp e) (price e))
(let ((new-position (read)))
(push new-position (positions a))))
;; UPDATE :AFTER methods
(defmethod adjust-positions-for-fitness ((a agent))
"Adjust an agent's position size per the fitness feedback."
(with-slots (fitness-feedback-control positions) a
(when fitness-feedback-control
(let ((ffc-state (compute-fitness-feedback a fitness-feedback-control)))
(when (and (eql ffc-state :offline) (/= (first positions) 0)) ;; force agent to flat when fitness is bad
(push (list 0 (pop positions)) positions))))))
(defmethod update :after ((a agent) (e market-update))
(adjust-positions-for-fitness a)
(with-slots (positions revalprices pls navs) a
(let* ((last-position (adjusted-position (first positions)))
(prev-position-adjusted (or (adjusted-position (second positions)) 0))
(prev-position-original (or (original-position (second positions)) 0))
(trade-quantity (- last-position prev-position-adjusted))
(last-price (first revalprices))
(prev-price (or (second revalprices) 0))
(pl (or (* prev-position-original (- last-price prev-price)) 0)))
(push pl pls)
(push (+ (or (first navs) 0) pl) navs)
(unless (zerop trade-quantity)
(send-order a e
:opc (price e)
:oqt trade-quantity
:otp (cond ((and (typep e 'time-bar) (eql (time-unit e) :day)) :moo)
(t :stp))
:oid :poschg)
(log:debug "generated aggressive order for ~S and quantity ~S~%" a trade-quantity))
(postprocess a e)
(log:debug ":AFTER completed for agent ~A and event ~A~%" a e))))
(defmethod update :after ((a agent) (e comm))
(postprocess a e)
(log:debug ":AFTER completed for agent ~A and COMM event ~A~%" a e))
(defmethod postprocess ((a agent) (e event))
(log:debug "Event ~S ~S Consumed for Agent ~S :~%"
(timestamp e) (value e) (name a)))
(defmethod send-order ((a agent) (e market-update) &key opc oqt otp oid)
"Create an order.
SEND-ORDER - Three places in the event consumption cycle by the agent where orders can
be emitted:
1. In the FSM transitions ACTUATOR functions. Passive orders should be emitted
when transitions happen.
2. In the UPDATE :AFTER method. The immediate change in the agent's desired market position
is being generated at the level of the FSM transition, and the resulting aggressive order
can be dealt with after the FSM is processed and before post-processing.
3. In the aggregator. When several agents are trading in the same security it is also possible
to route all the agents' positions into an aggregator so that the slippage is minimized. "
(push (make-instance 'order
:timestamp (timestamp e)
:value oid
:security (security e)
:order-type otp
:order-quantity oqt
:order-price opc
:algo-instance (make-instance
'simul
:algo-type (case otp
((:stp :ioc :moc :moo) :aggressive)
((:lmt) :passive))))
(orders a)))
(defmethod change-order ((a agent) (e market-update) &key new-opc new-oqt new-otp old-oid)
"Change an unfilled, passive order."
(let* ((o (car (remove-if-not #`(equal (value %) old-oid) (orders a))))
(rest-orders (remove-if #`(equal (value %) old-oid) (orders a))))
(when new-opc (setf (order-price o) new-opc))
(when new-oqt (setf (order-quantity o) new-oqt))
(when new-otp (setf (order-type o) new-otp))
(setf (timestamp o) (timestamp e)
(orders a) `(,o ,@rest-orders))))
(defmethod cancel-order ((a agent) old-oid)
(setf (orders a) (remove-if #`(equal (value %) old-oid)
(orders a))))
;; Order Management system simulation
(defmethod oms ((a agent) (e market-update) &key (algo-category :all))
(let* ((category-p #`(or (equal algo-category :all)
(equal (algo-type (algo-instance %)) algo-category)))
(bins (classify (orders a) (list category-p (complement category-p))))
(category-orders (first bins))
(non-category-orders (second bins))
(new-category-orders nil))
(dolist (o category-orders)
(when (equal (security o) (security e))
(multiple-value-bind (executions remaining-order)
(execute o (algo-instance o) e)
(when executions
(setf (unprocessed-trades a) `(,@executions ,@(unprocessed-trades a))))
(when remaining-order
(push remaining-order new-category-orders)))))
(setf (orders a) (append new-category-orders non-category-orders))))
;; EOF