-
Notifications
You must be signed in to change notification settings - Fork 12
/
Copy pathchart.rkt
172 lines (151 loc) · 9.02 KB
/
chart.rkt
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
#lang racket/base
(require gregor
pict
plot
racket/class
racket/list
racket/gui/base
"db-queries.rkt"
"plot-util.rkt"
"structs.rkt"
"technical-indicators.rkt")
(provide show-chart
refresh-chart)
(define (refresh-chart symbol start-date end-date)
(send chart-ticker-symbol-field set-value symbol)
(send chart-start-date-field set-value start-date)
(send chart-end-date-field set-value end-date)
(send chart-price-canvas set-snip (chart-price-plot))
(send chart-atr-canvas set-snip (chart-atr-plot))
(send chart-volume-canvas set-snip (chart-volume-plot)))
(define (next-day d)
(date->iso8601 (+days (iso8601->date d) 1)))
(plot-y-tick-labels? #f)
(plot-y-far-tick-labels? #t)
(define chart-frame (new frame% [label "Chart"] [width 1400] [height 1000]))
(define chart-input-pane (new horizontal-pane%
[parent chart-frame]
[stretchable-height #f]))
(define chart-ticker-symbol-field (new text-field%
[parent chart-input-pane]
[label "Symbol"]
[init-value "GE"]))
(define chart-start-date-field (new text-field%
[parent chart-input-pane]
[label "Start Date"]
[init-value "2018-01-01"]))
(define chart-end-date-field (new text-field%
[parent chart-input-pane]
[label "End Date"]
[init-value "2018-06-30"]))
(define chart-refresh-button (new button%
[parent chart-input-pane]
[label "Refresh"]
[callback (λ (b e) (send chart-price-canvas set-snip (chart-price-plot))
(send chart-atr-canvas set-snip (chart-atr-plot))
(send chart-volume-canvas set-snip (chart-volume-plot)))]))
(define next-day-button (new button%
[parent chart-input-pane]
[label "Next Day"]
[callback (λ (b e) (send chart-start-date-field set-value (next-day (send chart-start-date-field get-value)))
(send chart-end-date-field set-value (next-day (send chart-end-date-field get-value)))
(send chart-price-canvas set-snip (chart-price-plot))
(send chart-atr-canvas set-snip (chart-atr-plot))
(send chart-volume-canvas set-snip (chart-volume-plot)))]))
(define chart-plot-pane (new vertical-pane%
[parent chart-frame]))
(define prev-time-stamp (current-milliseconds))
(define (chart-price-plot)
(let* ([date-ohlc-vector (get-date-ohlc (send chart-ticker-symbol-field get-value)
(send chart-start-date-field get-value)
(send chart-end-date-field get-value))]
[snip (parameterize ([plot-x-ticks (date-ticks)]
[plot-y-ticks (currency-ticks #:kind 'USD)]
[plot-width (- (send chart-price-canvas get-width) 12)]
[plot-height (- (send chart-price-canvas get-height) 12)])
(plot-snip (list (tick-grid)
(let-values ([(highs lows) (donchian-channel (list->vector date-ohlc-vector) 50)])
(lines-interval highs lows #:color 7 #:alpha 1/3 #:label "50-day DC"))
(let-values ([(highs lows) (donchian-channel (list->vector date-ohlc-vector) 10)])
(lines-interval highs lows #:color 6 #:alpha 1/3 #:label "10-day DC"))
(candlesticks date-ohlc-vector #:width 86400)
(lines (simple-moving-average (list->vector date-ohlc-vector) 20) #:color 3 #:label "20-day SMA")
(lines (simple-moving-average (list->vector date-ohlc-vector) 50) #:color 4 #:label "50-day SMA"))
#:x-label "Date"
#:y-label "Price"))])
(define item-font (send the-font-list find-or-create-font 12 'default 'normal 'normal))
(define background (make-object color% #xff #xf8 #xdc 0.8))
(define (make-tag dohlc)
(define p (if (empty? dohlc) (text "" item-font)
(vl-append
(hc-append
(text "Date: " item-font)
(text (~t (posix->datetime (dohlc-date (first dohlc))) "yyyy-MM-dd") item-font))
(hc-append
(text "Open: " item-font)
(text (real->decimal-string (dohlc-open (first dohlc))) item-font))
(hc-append
(text "High: " item-font)
(text (real->decimal-string (dohlc-high (first dohlc))) item-font))
(hc-append
(text "Low: " item-font)
(text (real->decimal-string (dohlc-low (first dohlc))) item-font))
(hc-append
(text "Close: " item-font)
(text (real->decimal-string (dohlc-close (first dohlc))) item-font)))))
(define r (filled-rectangle
(+ (pict-width p) 10) (+ (pict-height p) 10)
#:draw-border? #f #:color background))
(cc-superimpose r p))
(define (get-ohlc dv d)
(filter (λ (e) (date=? (->date (posix->datetime d)) (->date (posix->datetime (dohlc-date e))))) dv))
(define ((make-current-value-renderer dv) snip event x y)
(define delta (- (current-milliseconds) prev-time-stamp))
(cond [(< 40 delta)
(define overlays
(and x y (eq? (send event get-event-type) 'motion)
(let ([shift (if (< 43200 (modulo (round x) 86400)) 86400 0)])
(list (vrule (+ (- x (modulo (round x) 86400)) shift) #:style 'long-dash)
(point-pict (vector (+ (- x (modulo (round x) 86400)) shift) y)
(make-tag (get-ohlc dv (+ x 43200)))
#:anchor 'auto)))))
(send snip set-overlay-renderers overlays)
(set! prev-time-stamp (current-milliseconds))]))
(send snip set-mouse-event-callback (make-current-value-renderer date-ohlc-vector))
snip))
(define chart-price-canvas (new settable-snip-canvas%
[parent chart-plot-pane]))
(define (chart-atr-plot)
(let ([date-ohlc-vector (get-date-ohlc (send chart-ticker-symbol-field get-value)
(send chart-start-date-field get-value)
(send chart-end-date-field get-value))])
(parameterize ([plot-x-label #f]
[plot-x-ticks (date-ticks)]
[plot-y-ticks (currency-ticks #:kind 'USD)]
[plot-width (- (send chart-atr-canvas get-width) 12)]
[plot-height (- (send chart-atr-canvas get-height) 12)])
(plot-snip (list (tick-grid)
(lines (simple-average-true-range (list->vector date-ohlc-vector) 50)
#:x-min (dohlc-date (first date-ohlc-vector))))
#:y-label "50-day SATR"))))
(define chart-atr-canvas (new settable-snip-canvas%
[parent chart-plot-pane]
[min-height 150]
[stretchable-height #f]))
(define (chart-volume-plot) (parameterize ([plot-x-label #f]
[plot-x-ticks (date-ticks)]
[plot-y-ticks (linear-ticks)]
[plot-width (- (send chart-volume-canvas get-width) 12)]
[plot-height (- (send chart-volume-canvas get-height) 12)])
(plot-snip (list (tick-grid)
(rectangles (get-date-volume (send chart-ticker-symbol-field get-value)
(send chart-start-date-field get-value)
(send chart-end-date-field get-value))
#:color 3))
#:y-label "Volume")))
(define chart-volume-canvas (new settable-snip-canvas%
[parent chart-plot-pane]
[min-height 150]
[stretchable-height #f]))
(define (show-chart)
(send chart-frame show #t))