├── LICENSE ├── README.md ├── chart.rkt ├── cmd-line.rkt ├── db-queries.rkt ├── image ├── chart.png └── simulator.png ├── main.rkt ├── plot-util.rkt ├── simulator.rkt ├── strategy ├── ascending-triangle.rkt ├── bear-rally.rkt ├── bull-pullback.rkt ├── descending-triangle.rkt ├── high-base.rkt ├── low-base.rkt ├── range-pullback.rkt └── range-rally.rkt ├── structs.rkt └── technical-indicators.rkt /LICENSE: -------------------------------------------------------------------------------- 1 | Mozilla Public License Version 2.0 2 | ================================== 3 | 4 | 1. Definitions 5 | -------------- 6 | 7 | 1.1. "Contributor" 8 | means each individual or legal entity that creates, contributes to 9 | the creation of, or owns Covered Software. 10 | 11 | 1.2. "Contributor Version" 12 | means the combination of the Contributions of others (if any) used 13 | by a Contributor and that particular Contributor's Contribution. 14 | 15 | 1.3. "Contribution" 16 | means Covered Software of a particular Contributor. 17 | 18 | 1.4. "Covered Software" 19 | means Source Code Form to which the initial Contributor has attached 20 | the notice in Exhibit A, the Executable Form of such Source Code 21 | Form, and Modifications of such Source Code Form, in each case 22 | including portions thereof. 23 | 24 | 1.5. "Incompatible With Secondary Licenses" 25 | means 26 | 27 | (a) that the initial Contributor has attached the notice described 28 | in Exhibit B to the Covered Software; or 29 | 30 | (b) that the Covered Software was made available under the terms of 31 | version 1.1 or earlier of the License, but not also under the 32 | terms of a Secondary License. 33 | 34 | 1.6. "Executable Form" 35 | means any form of the work other than Source Code Form. 36 | 37 | 1.7. "Larger Work" 38 | means a work that combines Covered Software with other material, in 39 | a separate file or files, that is not Covered Software. 40 | 41 | 1.8. "License" 42 | means this document. 43 | 44 | 1.9. "Licensable" 45 | means having the right to grant, to the maximum extent possible, 46 | whether at the time of the initial grant or subsequently, any and 47 | all of the rights conveyed by this License. 48 | 49 | 1.10. "Modifications" 50 | means any of the following: 51 | 52 | (a) any file in Source Code Form that results from an addition to, 53 | deletion from, or modification of the contents of Covered 54 | Software; or 55 | 56 | (b) any new file in Source Code Form that contains any Covered 57 | Software. 58 | 59 | 1.11. "Patent Claims" of a Contributor 60 | means any patent claim(s), including without limitation, method, 61 | process, and apparatus claims, in any patent Licensable by such 62 | Contributor that would be infringed, but for the grant of the 63 | License, by the making, using, selling, offering for sale, having 64 | made, import, or transfer of either its Contributions or its 65 | Contributor Version. 66 | 67 | 1.12. "Secondary License" 68 | means either the GNU General Public License, Version 2.0, the GNU 69 | Lesser General Public License, Version 2.1, the GNU Affero General 70 | Public License, Version 3.0, or any later versions of those 71 | licenses. 72 | 73 | 1.13. "Source Code Form" 74 | means the form of the work preferred for making modifications. 75 | 76 | 1.14. "You" (or "Your") 77 | means an individual or a legal entity exercising rights under this 78 | License. For legal entities, "You" includes any entity that 79 | controls, is controlled by, or is under common control with You. For 80 | purposes of this definition, "control" means (a) the power, direct 81 | or indirect, to cause the direction or management of such entity, 82 | whether by contract or otherwise, or (b) ownership of more than 83 | fifty percent (50%) of the outstanding shares or beneficial 84 | ownership of such entity. 85 | 86 | 2. License Grants and Conditions 87 | -------------------------------- 88 | 89 | 2.1. Grants 90 | 91 | Each Contributor hereby grants You a world-wide, royalty-free, 92 | non-exclusive license: 93 | 94 | (a) under intellectual property rights (other than patent or trademark) 95 | Licensable by such Contributor to use, reproduce, make available, 96 | modify, display, perform, distribute, and otherwise exploit its 97 | Contributions, either on an unmodified basis, with Modifications, or 98 | as part of a Larger Work; and 99 | 100 | (b) under Patent Claims of such Contributor to make, use, sell, offer 101 | for sale, have made, import, and otherwise transfer either its 102 | Contributions or its Contributor Version. 103 | 104 | 2.2. Effective Date 105 | 106 | The licenses granted in Section 2.1 with respect to any Contribution 107 | become effective for each Contribution on the date the Contributor first 108 | distributes such Contribution. 109 | 110 | 2.3. Limitations on Grant Scope 111 | 112 | The licenses granted in this Section 2 are the only rights granted under 113 | this License. No additional rights or licenses will be implied from the 114 | distribution or licensing of Covered Software under this License. 115 | Notwithstanding Section 2.1(b) above, no patent license is granted by a 116 | Contributor: 117 | 118 | (a) for any code that a Contributor has removed from Covered Software; 119 | or 120 | 121 | (b) for infringements caused by: (i) Your and any other third party's 122 | modifications of Covered Software, or (ii) the combination of its 123 | Contributions with other software (except as part of its Contributor 124 | Version); or 125 | 126 | (c) under Patent Claims infringed by Covered Software in the absence of 127 | its Contributions. 128 | 129 | This License does not grant any rights in the trademarks, service marks, 130 | or logos of any Contributor (except as may be necessary to comply with 131 | the notice requirements in Section 3.4). 132 | 133 | 2.4. Subsequent Licenses 134 | 135 | No Contributor makes additional grants as a result of Your choice to 136 | distribute the Covered Software under a subsequent version of this 137 | License (see Section 10.2) or under the terms of a Secondary License (if 138 | permitted under the terms of Section 3.3). 139 | 140 | 2.5. Representation 141 | 142 | Each Contributor represents that the Contributor believes its 143 | Contributions are its original creation(s) or it has sufficient rights 144 | to grant the rights to its Contributions conveyed by this License. 145 | 146 | 2.6. Fair Use 147 | 148 | This License is not intended to limit any rights You have under 149 | applicable copyright doctrines of fair use, fair dealing, or other 150 | equivalents. 151 | 152 | 2.7. Conditions 153 | 154 | Sections 3.1, 3.2, 3.3, and 3.4 are conditions of the licenses granted 155 | in Section 2.1. 156 | 157 | 3. Responsibilities 158 | ------------------- 159 | 160 | 3.1. Distribution of Source Form 161 | 162 | All distribution of Covered Software in Source Code Form, including any 163 | Modifications that You create or to which You contribute, must be under 164 | the terms of this License. You must inform recipients that the Source 165 | Code Form of the Covered Software is governed by the terms of this 166 | License, and how they can obtain a copy of this License. You may not 167 | attempt to alter or restrict the recipients' rights in the Source Code 168 | Form. 169 | 170 | 3.2. Distribution of Executable Form 171 | 172 | If You distribute Covered Software in Executable Form then: 173 | 174 | (a) such Covered Software must also be made available in Source Code 175 | Form, as described in Section 3.1, and You must inform recipients of 176 | the Executable Form how they can obtain a copy of such Source Code 177 | Form by reasonable means in a timely manner, at a charge no more 178 | than the cost of distribution to the recipient; and 179 | 180 | (b) You may distribute such Executable Form under the terms of this 181 | License, or sublicense it under different terms, provided that the 182 | license for the Executable Form does not attempt to limit or alter 183 | the recipients' rights in the Source Code Form under this License. 184 | 185 | 3.3. Distribution of a Larger Work 186 | 187 | You may create and distribute a Larger Work under terms of Your choice, 188 | provided that You also comply with the requirements of this License for 189 | the Covered Software. If the Larger Work is a combination of Covered 190 | Software with a work governed by one or more Secondary Licenses, and the 191 | Covered Software is not Incompatible With Secondary Licenses, this 192 | License permits You to additionally distribute such Covered Software 193 | under the terms of such Secondary License(s), so that the recipient of 194 | the Larger Work may, at their option, further distribute the Covered 195 | Software under the terms of either this License or such Secondary 196 | License(s). 197 | 198 | 3.4. Notices 199 | 200 | You may not remove or alter the substance of any license notices 201 | (including copyright notices, patent notices, disclaimers of warranty, 202 | or limitations of liability) contained within the Source Code Form of 203 | the Covered Software, except that You may alter any license notices to 204 | the extent required to remedy known factual inaccuracies. 205 | 206 | 3.5. Application of Additional Terms 207 | 208 | You may choose to offer, and to charge a fee for, warranty, support, 209 | indemnity or liability obligations to one or more recipients of Covered 210 | Software. However, You may do so only on Your own behalf, and not on 211 | behalf of any Contributor. You must make it absolutely clear that any 212 | such warranty, support, indemnity, or liability obligation is offered by 213 | You alone, and You hereby agree to indemnify every Contributor for any 214 | liability incurred by such Contributor as a result of warranty, support, 215 | indemnity or liability terms You offer. You may include additional 216 | disclaimers of warranty and limitations of liability specific to any 217 | jurisdiction. 218 | 219 | 4. Inability to Comply Due to Statute or Regulation 220 | --------------------------------------------------- 221 | 222 | If it is impossible for You to comply with any of the terms of this 223 | License with respect to some or all of the Covered Software due to 224 | statute, judicial order, or regulation then You must: (a) comply with 225 | the terms of this License to the maximum extent possible; and (b) 226 | describe the limitations and the code they affect. Such description must 227 | be placed in a text file included with all distributions of the Covered 228 | Software under this License. Except to the extent prohibited by statute 229 | or regulation, such description must be sufficiently detailed for a 230 | recipient of ordinary skill to be able to understand it. 231 | 232 | 5. Termination 233 | -------------- 234 | 235 | 5.1. The rights granted under this License will terminate automatically 236 | if You fail to comply with any of its terms. However, if You become 237 | compliant, then the rights granted under this License from a particular 238 | Contributor are reinstated (a) provisionally, unless and until such 239 | Contributor explicitly and finally terminates Your grants, and (b) on an 240 | ongoing basis, if such Contributor fails to notify You of the 241 | non-compliance by some reasonable means prior to 60 days after You have 242 | come back into compliance. Moreover, Your grants from a particular 243 | Contributor are reinstated on an ongoing basis if such Contributor 244 | notifies You of the non-compliance by some reasonable means, this is the 245 | first time You have received notice of non-compliance with this License 246 | from such Contributor, and You become compliant prior to 30 days after 247 | Your receipt of the notice. 248 | 249 | 5.2. If You initiate litigation against any entity by asserting a patent 250 | infringement claim (excluding declaratory judgment actions, 251 | counter-claims, and cross-claims) alleging that a Contributor Version 252 | directly or indirectly infringes any patent, then the rights granted to 253 | You by any and all Contributors for the Covered Software under Section 254 | 2.1 of this License shall terminate. 255 | 256 | 5.3. In the event of termination under Sections 5.1 or 5.2 above, all 257 | end user license agreements (excluding distributors and resellers) which 258 | have been validly granted by You or Your distributors under this License 259 | prior to termination shall survive termination. 260 | 261 | ************************************************************************ 262 | * * 263 | * 6. Disclaimer of Warranty * 264 | * ------------------------- * 265 | * * 266 | * Covered Software is provided under this License on an "as is" * 267 | * basis, without warranty of any kind, either expressed, implied, or * 268 | * statutory, including, without limitation, warranties that the * 269 | * Covered Software is free of defects, merchantable, fit for a * 270 | * particular purpose or non-infringing. The entire risk as to the * 271 | * quality and performance of the Covered Software is with You. * 272 | * Should any Covered Software prove defective in any respect, You * 273 | * (not any Contributor) assume the cost of any necessary servicing, * 274 | * repair, or correction. This disclaimer of warranty constitutes an * 275 | * essential part of this License. No use of any Covered Software is * 276 | * authorized under this License except under this disclaimer. * 277 | * * 278 | ************************************************************************ 279 | 280 | ************************************************************************ 281 | * * 282 | * 7. Limitation of Liability * 283 | * -------------------------- * 284 | * * 285 | * Under no circumstances and under no legal theory, whether tort * 286 | * (including negligence), contract, or otherwise, shall any * 287 | * Contributor, or anyone who distributes Covered Software as * 288 | * permitted above, be liable to You for any direct, indirect, * 289 | * special, incidental, or consequential damages of any character * 290 | * including, without limitation, damages for lost profits, loss of * 291 | * goodwill, work stoppage, computer failure or malfunction, or any * 292 | * and all other commercial damages or losses, even if such party * 293 | * shall have been informed of the possibility of such damages. This * 294 | * limitation of liability shall not apply to liability for death or * 295 | * personal injury resulting from such party's negligence to the * 296 | * extent applicable law prohibits such limitation. Some * 297 | * jurisdictions do not allow the exclusion or limitation of * 298 | * incidental or consequential damages, so this exclusion and * 299 | * limitation may not apply to You. * 300 | * * 301 | ************************************************************************ 302 | 303 | 8. Litigation 304 | ------------- 305 | 306 | Any litigation relating to this License may be brought only in the 307 | courts of a jurisdiction where the defendant maintains its principal 308 | place of business and such litigation shall be governed by laws of that 309 | jurisdiction, without reference to its conflict-of-law provisions. 310 | Nothing in this Section shall prevent a party's ability to bring 311 | cross-claims or counter-claims. 312 | 313 | 9. Miscellaneous 314 | ---------------- 315 | 316 | This License represents the complete agreement concerning the subject 317 | matter hereof. If any provision of this License is held to be 318 | unenforceable, such provision shall be reformed only to the extent 319 | necessary to make it enforceable. Any law or regulation which provides 320 | that the language of a contract shall be construed against the drafter 321 | shall not be used to construe this License against a Contributor. 322 | 323 | 10. Versions of the License 324 | --------------------------- 325 | 326 | 10.1. New Versions 327 | 328 | Mozilla Foundation is the license steward. Except as provided in Section 329 | 10.3, no one other than the license steward has the right to modify or 330 | publish new versions of this License. Each version will be given a 331 | distinguishing version number. 332 | 333 | 10.2. Effect of New Versions 334 | 335 | You may distribute the Covered Software under the terms of the version 336 | of the License under which You originally received the Covered Software, 337 | or under the terms of any subsequent version published by the license 338 | steward. 339 | 340 | 10.3. Modified Versions 341 | 342 | If you create software not governed by this License, and you want to 343 | create a new license for such software, you may create and use a 344 | modified version of this License if you rename the license and remove 345 | any references to the name of the license steward (except to note that 346 | such modified license differs from this License). 347 | 348 | 10.4. Distributing Source Code Form that is Incompatible With Secondary 349 | Licenses 350 | 351 | If You choose to distribute Source Code Form that is Incompatible With 352 | Secondary Licenses under the terms of this version of the License, the 353 | notice described in Exhibit B of this License must be attached. 354 | 355 | Exhibit A - Source Code Form License Notice 356 | ------------------------------------------- 357 | 358 | This Source Code Form is subject to the terms of the Mozilla Public 359 | License, v. 2.0. If a copy of the MPL was not distributed with this 360 | file, You can obtain one at http://mozilla.org/MPL/2.0/. 361 | 362 | If it is not possible or desirable to put the notice in a particular 363 | file, then You may include the notice in a location (such as a LICENSE 364 | file in a relevant directory) where a recipient would be likely to look 365 | for such a notice. 366 | 367 | You may add additional accurate notices of copyright ownership. 368 | 369 | Exhibit B - "Incompatible With Secondary Licenses" Notice 370 | --------------------------------------------------------- 371 | 372 | This Source Code Form is "Incompatible With Secondary Licenses", as 373 | defined by the Mozilla Public License, v. 2.0. 374 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # chart-simulator 2 | 3 | This Racket application will display stock price charts and trade simulation output. 4 | You can click on a trade execution pair in the simulator to view the corresponding stock chart. 5 | 6 | Here is a sample image of the simulator: 7 | ![Simulator](image/simulator.png) 8 | 9 | Here is a sample image of a stock chart: 10 | ![Chart](image/chart.png) 11 | 12 | The intended way to launch this application is by doing the following: 13 | 14 | ```bash 15 | $ racket main.rkt -u db-username -n db-name -p db-password 16 | ``` 17 | 18 | `db-username` defaults to 'user' and `db-name` defaults to local, so those arguments can be omitted if they match your database. 19 | `db-password` must be provided. 20 | 21 | You will need to either use data from these projects or provide a database schema that mirrors the schema provided by: 22 | * [nasdaq-symbols](https://github.com/evdubs/nasdaq-symbols) 23 | * [quandl-wiki-prices](https://github.com/evdubs/quandl-wiki-prices) 24 | * [yahoo-dividends-splits](https://github.com/evdubs/yahoo-dividends-splits) 25 | 26 | Requires Racket 7.0 or greater. 27 | 28 | ### Dependencies 29 | 30 | It is recommended that you start with the standard Racket distribution. With that, you will need to install the following packages: 31 | 32 | ```bash 33 | $ raco pkg install --skip-installed gregor 34 | ``` 35 | -------------------------------------------------------------------------------- /chart.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require gregor 4 | pict 5 | plot 6 | racket/class 7 | racket/list 8 | racket/gui/base 9 | "db-queries.rkt" 10 | "plot-util.rkt" 11 | "structs.rkt" 12 | "technical-indicators.rkt") 13 | 14 | (provide show-chart 15 | refresh-chart) 16 | 17 | (define (refresh-chart symbol start-date end-date) 18 | (send chart-ticker-symbol-field set-value symbol) 19 | (send chart-start-date-field set-value start-date) 20 | (send chart-end-date-field set-value end-date) 21 | (send chart-price-canvas set-snip (chart-price-plot)) 22 | (send chart-atr-canvas set-snip (chart-atr-plot)) 23 | (send chart-volume-canvas set-snip (chart-volume-plot))) 24 | 25 | (define (next-day d) 26 | (date->iso8601 (+days (iso8601->date d) 1))) 27 | 28 | (plot-y-tick-labels? #f) 29 | (plot-y-far-tick-labels? #t) 30 | 31 | (define chart-frame (new frame% [label "Chart"] [width 1400] [height 1000])) 32 | 33 | (define chart-input-pane (new horizontal-pane% 34 | [parent chart-frame] 35 | [stretchable-height #f])) 36 | 37 | (define chart-ticker-symbol-field (new text-field% 38 | [parent chart-input-pane] 39 | [label "Symbol"] 40 | [init-value "GE"])) 41 | 42 | (define chart-start-date-field (new text-field% 43 | [parent chart-input-pane] 44 | [label "Start Date"] 45 | [init-value "2018-01-01"])) 46 | 47 | (define chart-end-date-field (new text-field% 48 | [parent chart-input-pane] 49 | [label "End Date"] 50 | [init-value "2018-06-30"])) 51 | 52 | (define chart-refresh-button (new button% 53 | [parent chart-input-pane] 54 | [label "Refresh"] 55 | [callback (λ (b e) (send chart-price-canvas set-snip (chart-price-plot)) 56 | (send chart-atr-canvas set-snip (chart-atr-plot)) 57 | (send chart-volume-canvas set-snip (chart-volume-plot)))])) 58 | 59 | (define next-day-button (new button% 60 | [parent chart-input-pane] 61 | [label "Next Day"] 62 | [callback (λ (b e) (send chart-start-date-field set-value (next-day (send chart-start-date-field get-value))) 63 | (send chart-end-date-field set-value (next-day (send chart-end-date-field get-value))) 64 | (send chart-price-canvas set-snip (chart-price-plot)) 65 | (send chart-atr-canvas set-snip (chart-atr-plot)) 66 | (send chart-volume-canvas set-snip (chart-volume-plot)))])) 67 | 68 | (define chart-plot-pane (new vertical-pane% 69 | [parent chart-frame])) 70 | 71 | (define prev-time-stamp (current-milliseconds)) 72 | 73 | (define (chart-price-plot) 74 | (let* ([date-ohlc-vector (get-date-ohlc (send chart-ticker-symbol-field get-value) 75 | (send chart-start-date-field get-value) 76 | (send chart-end-date-field get-value))] 77 | [snip (parameterize ([plot-x-ticks (date-ticks)] 78 | [plot-y-ticks (currency-ticks #:kind 'USD)] 79 | [plot-width (- (send chart-price-canvas get-width) 12)] 80 | [plot-height (- (send chart-price-canvas get-height) 12)]) 81 | (plot-snip (list (tick-grid) 82 | (let-values ([(highs lows) (donchian-channel (list->vector date-ohlc-vector) 50)]) 83 | (lines-interval highs lows #:color 7 #:alpha 1/3 #:label "50-day DC")) 84 | (let-values ([(highs lows) (donchian-channel (list->vector date-ohlc-vector) 10)]) 85 | (lines-interval highs lows #:color 6 #:alpha 1/3 #:label "10-day DC")) 86 | (candlesticks date-ohlc-vector #:width 86400) 87 | (lines (simple-moving-average (list->vector date-ohlc-vector) 20) #:color 3 #:label "20-day SMA") 88 | (lines (simple-moving-average (list->vector date-ohlc-vector) 50) #:color 4 #:label "50-day SMA")) 89 | #:x-label "Date" 90 | #:y-label "Price"))]) 91 | (define item-font (send the-font-list find-or-create-font 12 'default 'normal 'normal)) 92 | (define background (make-object color% #xff #xf8 #xdc 0.8)) 93 | (define (make-tag dohlc) 94 | (define p (if (empty? dohlc) (text "" item-font) 95 | (vl-append 96 | (hc-append 97 | (text "Date: " item-font) 98 | (text (~t (posix->datetime (dohlc-date (first dohlc))) "yyyy-MM-dd") item-font)) 99 | (hc-append 100 | (text "Open: " item-font) 101 | (text (real->decimal-string (dohlc-open (first dohlc))) item-font)) 102 | (hc-append 103 | (text "High: " item-font) 104 | (text (real->decimal-string (dohlc-high (first dohlc))) item-font)) 105 | (hc-append 106 | (text "Low: " item-font) 107 | (text (real->decimal-string (dohlc-low (first dohlc))) item-font)) 108 | (hc-append 109 | (text "Close: " item-font) 110 | (text (real->decimal-string (dohlc-close (first dohlc))) item-font))))) 111 | (define r (filled-rectangle 112 | (+ (pict-width p) 10) (+ (pict-height p) 10) 113 | #:draw-border? #f #:color background)) 114 | (cc-superimpose r p)) 115 | (define (get-ohlc dv d) 116 | (filter (λ (e) (date=? (->date (posix->datetime d)) (->date (posix->datetime (dohlc-date e))))) dv)) 117 | (define ((make-current-value-renderer dv) snip event x y) 118 | (define delta (- (current-milliseconds) prev-time-stamp)) 119 | (cond [(< 40 delta) 120 | (define overlays 121 | (and x y (eq? (send event get-event-type) 'motion) 122 | (let ([shift (if (< 43200 (modulo (round x) 86400)) 86400 0)]) 123 | (list (vrule (+ (- x (modulo (round x) 86400)) shift) #:style 'long-dash) 124 | (point-pict (vector (+ (- x (modulo (round x) 86400)) shift) y) 125 | (make-tag (get-ohlc dv (+ x 43200))) 126 | #:anchor 'auto))))) 127 | (send snip set-overlay-renderers overlays) 128 | (set! prev-time-stamp (current-milliseconds))])) 129 | (send snip set-mouse-event-callback (make-current-value-renderer date-ohlc-vector)) 130 | snip)) 131 | 132 | (define chart-price-canvas (new settable-snip-canvas% 133 | [parent chart-plot-pane])) 134 | 135 | (define (chart-atr-plot) 136 | (let ([date-ohlc-vector (get-date-ohlc (send chart-ticker-symbol-field get-value) 137 | (send chart-start-date-field get-value) 138 | (send chart-end-date-field get-value))]) 139 | (parameterize ([plot-x-label #f] 140 | [plot-x-ticks (date-ticks)] 141 | [plot-y-ticks (currency-ticks #:kind 'USD)] 142 | [plot-width (- (send chart-atr-canvas get-width) 12)] 143 | [plot-height (- (send chart-atr-canvas get-height) 12)]) 144 | (plot-snip (list (tick-grid) 145 | (lines (simple-average-true-range (list->vector date-ohlc-vector) 50) 146 | #:x-min (dohlc-date (first date-ohlc-vector)))) 147 | #:y-label "50-day SATR")))) 148 | 149 | (define chart-atr-canvas (new settable-snip-canvas% 150 | [parent chart-plot-pane] 151 | [min-height 150] 152 | [stretchable-height #f])) 153 | 154 | (define (chart-volume-plot) (parameterize ([plot-x-label #f] 155 | [plot-x-ticks (date-ticks)] 156 | [plot-y-ticks (linear-ticks)] 157 | [plot-width (- (send chart-volume-canvas get-width) 12)] 158 | [plot-height (- (send chart-volume-canvas get-height) 12)]) 159 | (plot-snip (list (tick-grid) 160 | (rectangles (get-date-volume (send chart-ticker-symbol-field get-value) 161 | (send chart-start-date-field get-value) 162 | (send chart-end-date-field get-value)) 163 | #:color 3)) 164 | #:y-label "Volume"))) 165 | 166 | (define chart-volume-canvas (new settable-snip-canvas% 167 | [parent chart-plot-pane] 168 | [min-height 150] 169 | [stretchable-height #f])) 170 | 171 | (define (show-chart) 172 | (send chart-frame show #t)) 173 | -------------------------------------------------------------------------------- /cmd-line.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require racket/cmdline) 4 | 5 | (provide db-user 6 | db-name 7 | db-pass) 8 | 9 | (define db-user (make-parameter "user")) 10 | 11 | (define db-name (make-parameter "local")) 12 | 13 | (define db-pass (make-parameter "")) 14 | 15 | (command-line 16 | #:program "racket main.rkt" 17 | #:once-each 18 | [("-n" "--db-name") name 19 | "Database name. Defaults to 'local'" 20 | (db-name name)] 21 | [("-p" "--db-pass") password 22 | "Database password" 23 | (db-pass password)] 24 | [("-u" "--db-user") user 25 | "Database user name. Defaults to 'user'" 26 | (db-user user)]) 27 | -------------------------------------------------------------------------------- /db-queries.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require db 4 | db/util/datetime 5 | gregor 6 | plot 7 | racket/list 8 | "cmd-line.rkt" 9 | "structs.rkt") 10 | 11 | (provide get-date-ohlc 12 | get-date-volume 13 | get-random-sp-500-symbols 14 | get-random-symbols-over-price) 15 | 16 | (define dbc (postgresql-connect #:user (db-user) #:database (db-name) #:password (db-pass))) 17 | 18 | (define (get-date-ohlc ticker-symbol start-date end-date) 19 | (let ([price-query (query-rows dbc " 20 | select 21 | date::text, 22 | open, 23 | high, 24 | low, 25 | close 26 | from 27 | iex.split_adjusted_chart( 28 | $1, 29 | case 30 | when $2::text::date > (select max(date) from iex.chart) then (select max(date) from iex.chart) 31 | else $2::text::date 32 | end, 33 | $3::text::date, 34 | false); 35 | " 36 | ticker-symbol 37 | start-date 38 | end-date)]) 39 | (map (λ (row) (dohlc (->posix (iso8601->date (vector-ref row 0))) 40 | (vector-ref row 1) (vector-ref row 2) (vector-ref row 3) (vector-ref row 4))) 41 | price-query))) 42 | 43 | (define (get-date-volume ticker-symbol start-date end-date) 44 | (let ([volume-query (query-rows dbc " 45 | select 46 | date::text, 47 | volume 48 | from 49 | iex.split_adjusted_chart( 50 | $1, 51 | case 52 | when $2::text::date > (select max(date) from iex.chart) then (select max(date) from iex.chart) 53 | else $2::text::date 54 | end, 55 | $3::text::date, 56 | false); 57 | " 58 | ticker-symbol 59 | start-date 60 | end-date)]) 61 | (map (λ (r) (dv (ivl (- (->posix (iso8601->date (vector-ref r 0))) 43200) 62 | (+ (->posix (iso8601->date (vector-ref r 0))) 43200)) 63 | (ivl 70 (+ (vector-ref r 1) 70)))) 64 | volume-query))) 65 | 66 | (define (get-random-sp-500-symbols count) 67 | (let ([random-symbol-query (query-rows dbc " 68 | select 69 | c.act_symbol 70 | from 71 | quandl.wiki_price c 72 | join 73 | nasdaq.symbol s 74 | on 75 | c.act_symbol = s.act_symbol and 76 | c.date = '2000-01-04' and 77 | s.last_seen = (select max(last_seen) from nasdaq.symbol) and 78 | s.is_etf = false and 79 | s.is_test_issue = false and 80 | s.is_next_shares = false and 81 | s.security_name !~ 'ETN' and 82 | s.nasdaq_symbol !~ '[-\\$\\+\\*#!@%\\^=~]' and 83 | case when s.nasdaq_symbol ~ '[A-Z]{4}[L-Z]' 84 | then s.security_name !~ '(Note|Preferred|Right|Unit|Warrant)' 85 | else true 86 | end 87 | join 88 | spdr.etf_holding e 89 | on 90 | c.act_symbol = e.component_symbol and 91 | e.etf_symbol = 'SPY' and 92 | e.date = (select max(date) from spdr.etf_holding where etf_symbol = 'SPY') 93 | order by 94 | random() 95 | limit $1; 96 | " 97 | count)]) 98 | (flatten (map (λ (v) (vector->list v)) random-symbol-query)))) 99 | 100 | (define (get-random-symbols-over-price price count) 101 | (let ([q (query-rows dbc " 102 | select 103 | w.act_symbol 104 | from 105 | quandl.wiki_price w 106 | join 107 | (select 108 | act_symbol, 109 | mul(new_share_amount) / mul(old_share_amount) as split_ratio 110 | from 111 | yahoo.stock_split 112 | where 113 | date >= '2000-01-01' and 114 | new_share_amount != 0 and 115 | old_share_amount != 0 116 | group by 117 | act_symbol 118 | order by 119 | act_symbol) s 120 | on 121 | w.act_symbol = s.act_symbol 122 | where 123 | w.date = '2000-01-03' and 124 | w.close / s.split_ratio > $1 125 | order by 126 | random() 127 | limit $2; 128 | " 129 | price 130 | count)]) 131 | (flatten (map (λ (v) (vector->list v)) q)))) 132 | -------------------------------------------------------------------------------- /image/chart.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/evdubs/chart-simulator/17cab1c3b72d9d234e05c529a4b3c259aa41db13/image/chart.png -------------------------------------------------------------------------------- /image/simulator.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/evdubs/chart-simulator/17cab1c3b72d9d234e05c529a4b3c259aa41db13/image/simulator.png -------------------------------------------------------------------------------- /main.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require "chart.rkt" 4 | "cmd-line.rkt" 5 | "simulator.rkt") 6 | 7 | (show-chart) 8 | 9 | (show-simulator) -------------------------------------------------------------------------------- /plot-util.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | ;; plot-util.rkt -- plot helpers and utilities 4 | ;; This file is originally from ActivityLog2, a fitness activity tracker. 5 | ;; This file was adapted for use in chart-simulator. The original plot-util 6 | ;; work was done by Alex Harsanyi. See https://github.com/alex-hhh/ActivityLog2 7 | 8 | (require racket/gui) 9 | 10 | (provide settable-snip-canvas%) 11 | 12 | (define (draw-centered-message dc msg font) 13 | (let-values (([cw ch] (send dc get-size)) 14 | ([w h x y] (send dc get-text-extent msg font #t))) 15 | (send dc set-font font) 16 | (send dc set-text-foreground "gray") 17 | (let ((ox (- (/ cw 2) (/ w 2))) 18 | (oy (- (/ ch 2) (/ h 2)))) 19 | (send dc draw-text msg ox oy)))) 20 | 21 | (define read-only-pb% 22 | (class pasteboard% 23 | (define writable? #t) 24 | (define main-snip #f) 25 | (define floating-snips '()) 26 | ;; Message to be shown when there is no main snip in the canvas. 27 | (define no-main-snip-message #f) 28 | (define message-font 29 | (send the-font-list find-or-create-font 36 'default 'normal 'normal)) 30 | 31 | (define/public (set-writable w?) (set! writable? w?)) 32 | 33 | ;; (define/augment (can-change-style? start len) writable?) 34 | (define/augment (can-delete? snip) writable?) 35 | (define/augment (can-insert? snip before x y) writable?) 36 | (define/augment (can-load-file? filename format) writable?) 37 | (define/augment (can-save-file? filename format) writable?) 38 | (define/augment (can-move-to? snip x y dragging?) 39 | (or (not dragging?) (not (eq? snip main-snip)))) 40 | (define/override (can-do-edit-operation? op [recursive? #t]) 41 | (case op 42 | [(copy select-all) #t] 43 | [else writable?])) 44 | 45 | (define/augment (on-insert snip before x y) 46 | (unless (send this find-first-snip) 47 | (set! main-snip snip))) 48 | 49 | (define/augment (after-insert snip before x y) 50 | (when (eq? main-snip snip) 51 | (send this move-to snip 0 0)) 52 | (when (and main-snip (not (eq? snip main-snip))) 53 | (send this set-before snip main-snip))) 54 | 55 | (define/public (set-background-message msg) 56 | (set! no-main-snip-message msg)) 57 | 58 | (define/override (on-paint before? dc left top right bottom dx dy draw-caret) 59 | (when before? 60 | ;; Draw a message when there is no snip in the pasteboard. 61 | (unless (send this find-first-snip) 62 | (send dc clear) 63 | (when no-main-snip-message 64 | (draw-centered-message dc no-main-snip-message message-font))))) 65 | 66 | (super-new) 67 | ;;(send this hide-caret #t) 68 | (send this set-selection-visible #f) 69 | )) 70 | 71 | (define settable-snip-canvas% 72 | (class editor-canvas% 73 | (init parent 74 | [style null] 75 | [label #f] 76 | [horizontal-inset 5] 77 | [vertical-inset 5] 78 | [enabled #t] 79 | [vert-margin 0] 80 | [horiz-margin 0] 81 | [min-width 0] 82 | [min-height 0] 83 | [stretchable-width #t] 84 | [stretchable-height #t]) 85 | 86 | (define snip #f) 87 | (define pb (new read-only-pb%)) 88 | (send pb set-writable #f) 89 | 90 | (define/public (get-snip) snip) 91 | 92 | (define/override (on-size w h) 93 | (update-snip w h) 94 | (super on-size w h)) 95 | 96 | (define (update-snip w h) 97 | (define snip-w (max 0 (- w (* 2 horizontal-inset)))) 98 | (define snip-h (max 0 (- h (* 2 vertical-inset)))) 99 | (when snip 100 | (send snip resize snip-w snip-h) 101 | (send pb move-to snip 0 0))) 102 | 103 | (define/public (set-snip s) 104 | (set! snip s) 105 | (send this suspend-flush) 106 | (send pb set-writable #t) 107 | (send pb begin-edit-sequence #f) 108 | (send pb erase) 109 | (when snip 110 | (let-values (([w h] (send (send this get-dc) get-size))) 111 | (update-snip w h)) 112 | (send pb insert snip)) 113 | (send pb end-edit-sequence) 114 | (send pb set-writable #f) 115 | (send this resume-flush)) 116 | 117 | (define/public (set-floating-snip s) 118 | (send pb set-writable #t) 119 | (send pb insert s) 120 | (send pb set-writable #f)) 121 | 122 | (define/public (export-image-to-file file-name (width #f) (height #f)) 123 | (let-values (((cw ch) (send this get-size))) 124 | (unless (and width height) 125 | (set! width (or width cw)) 126 | (set! height (or height ch))) 127 | (let* ((bitmap (if (regexp-match #px".*\\.(?i:svg)" file-name) 128 | #f 129 | (make-bitmap width height #t))) 130 | (dc (if bitmap 131 | (new bitmap-dc% [bitmap bitmap]) 132 | (new svg-dc% 133 | [width width] [height height] 134 | [output file-name] 135 | [exists 'truncate/replace])))) 136 | ;; NOTE: scaling works, but makes the entire plot blurry 137 | (send dc scale (/ width cw) (/ height ch)) 138 | (unless bitmap 139 | (send dc start-doc "export to file")) 140 | ;; NOTE: print-to-dc handles start-page/end-page calls 141 | (send (send this get-editor) print-to-dc dc 0) 142 | (unless bitmap 143 | (send dc end-doc)) 144 | (when bitmap 145 | (send bitmap save-file file-name 'png))))) 146 | 147 | (super-new [parent parent] 148 | [editor pb] 149 | [horizontal-inset horizontal-inset] 150 | [vertical-inset vertical-inset] 151 | [label label] 152 | [enabled enabled] 153 | [style (list* 'no-hscroll 'no-vscroll style)] 154 | [vert-margin vert-margin] 155 | [horiz-margin horiz-margin] 156 | [min-width min-width] 157 | [min-height min-height] 158 | [stretchable-width stretchable-width] 159 | [stretchable-height stretchable-height]) 160 | 161 | (define/public (set-background-message msg) 162 | (send pb set-background-message msg) 163 | (send this refresh)) 164 | 165 | (send this lazy-refresh #t))) 166 | -------------------------------------------------------------------------------- /simulator.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require gregor 4 | math/statistics 5 | racket/class 6 | racket/list 7 | racket/gui/base 8 | "chart.rkt" 9 | "db-queries.rkt" 10 | "strategy/ascending-triangle.rkt" 11 | "strategy/bear-rally.rkt" 12 | "strategy/bull-pullback.rkt" 13 | "strategy/descending-triangle.rkt" 14 | "strategy/high-base.rkt" 15 | "strategy/low-base.rkt" 16 | "strategy/range-pullback.rkt" 17 | "strategy/range-rally.rkt" 18 | "structs.rkt") 19 | 20 | (provide show-simulator) 21 | 22 | (struct trade-with-exit (symbol date price amount exit-date exit-price test) 23 | #:transparent) 24 | 25 | (struct test-with-symbol (symbol date entry stop target) 26 | #:transparent) 27 | 28 | (define (trade-with-exit-history symbol trade-history) 29 | (if (or (empty? trade-history) 30 | (= 1 (length trade-history))) 31 | (list) 32 | (let ([first (first trade-history)] 33 | [second (second trade-history)]) 34 | (append (list (trade-with-exit symbol 35 | (trade-date first) 36 | (trade-price first) 37 | (trade-amount first) 38 | (trade-date second) 39 | (trade-price second) 40 | (trade-test first))) 41 | (trade-with-exit-history symbol (list-tail trade-history 2)))))) 42 | 43 | (define (trade-with-exit-history->ratios tweh) 44 | (map (λ (e) (real->decimal-string (/ (- (test-target (trade-with-exit-test e)) (trade-with-exit-price e)) 45 | (- (test-entry (trade-with-exit-test e)) (test-stop (trade-with-exit-test e)))))) 46 | tweh)) 47 | 48 | (define (trade-with-exit-history->risks tweh) 49 | (map (λ (e) (real->decimal-string (* (- (test-entry (trade-with-exit-test e)) (test-stop (trade-with-exit-test e))) 50 | (trade-with-exit-amount e)))) 51 | tweh)) 52 | 53 | (define (trade-with-exit-history->rewards tweh) 54 | (map (λ (e) (real->decimal-string (* (- (test-target (trade-with-exit-test e)) (test-entry (trade-with-exit-test e))) 55 | (trade-with-exit-amount e)))) 56 | tweh)) 57 | 58 | (define (trade-with-exit-history->pcts tweh) 59 | (map (λ (e) (* (/ (- (trade-with-exit-exit-price e) (trade-with-exit-price e)) 60 | (trade-with-exit-price e)) 61 | (trade-with-exit-amount e) 100)) 62 | tweh)) 63 | 64 | (define (trade-with-exit-history->pcts-str tweh) 65 | (map (λ (e) (real->decimal-string e)) 66 | (trade-with-exit-history->pcts tweh))) 67 | 68 | (define simulator-frame (new frame% [label "Simulator"] [width 1000] [height 1000])) 69 | 70 | (define simulator-input-pane (new horizontal-pane% 71 | [parent simulator-frame] 72 | [stretchable-height #f])) 73 | 74 | (define start-date-field 75 | (new text-field% 76 | [parent simulator-input-pane] 77 | [label "Start Date"] 78 | [init-value "2000-01-01"])) 79 | 80 | (define end-date-field 81 | (new text-field% 82 | [parent simulator-input-pane] 83 | [label "End Date"] 84 | [init-value "2018-01-01"])) 85 | 86 | (define random-above-25-str "From 2000 above $25") 87 | 88 | (define random-sp-500-str "From current S&P 500") 89 | 90 | (define symbol-source-choice 91 | (new choice% 92 | [parent simulator-input-pane] 93 | [label "Symbol Source"] 94 | [choices (list random-above-25-str random-sp-500-str)])) 95 | 96 | (define strategy-hash 97 | (hash "Bull Pullback" bull-pullback-execution 98 | "Bear Rally" bear-rally-execution 99 | "High Base" high-base-execution 100 | "Low Base" low-base-execution 101 | "Ascending Triangle" ascending-triangle-execution 102 | "Descending Triangle" descending-triangle-execution 103 | "Range Pullback" range-pullback-execution 104 | "Range Rally" range-rally-execution)) 105 | 106 | (define strategy-choice 107 | (new choice% 108 | [parent simulator-input-pane] 109 | [label "Strategy"] 110 | [choices (sort (hash-keys strategy-hash) stringpcts winners)))] 136 | [losers (remove* winners tweh)] 137 | [lose-pct (if (= 0 (length tweh)) 0 138 | (* (/ (length losers) (length tweh)) 100))] 139 | [lose-pct-avg (if (= 0 (length losers)) 0 140 | (mean (trade-with-exit-history->pcts losers)))] 141 | [reward-ratio (if (= 0 lose-pct-avg) 0 (/ win-pct-avg (abs lose-pct-avg)))] 142 | [return (+ (* win-pct win-pct-avg) (* lose-pct lose-pct-avg))]) 143 | ; (display-low-base-execution symbol lbe) 144 | ; (displayln tweh) 145 | (send simulator-trades-box set 146 | (map (λ (e) (trade-with-exit-symbol e)) tweh) 147 | (map (λ (e) (~t (posix->datetime (trade-with-exit-date e)) "yyyy-MM-dd")) tweh) 148 | (map (λ (e) (real->decimal-string (trade-with-exit-price e))) tweh) 149 | (map (λ (e) (real->decimal-string (test-entry (trade-with-exit-test e)))) tweh) 150 | (map (λ (e) (real->decimal-string (test-stop (trade-with-exit-test e)))) tweh) 151 | (map (λ (e) (real->decimal-string (test-target (trade-with-exit-test e)))) tweh) 152 | (map (λ (e) (~t (posix->datetime (trade-with-exit-exit-date e)) "yyyy-MM-dd")) tweh) 153 | (map (λ (e) (real->decimal-string (trade-with-exit-exit-price e))) tweh) 154 | (trade-with-exit-history->ratios tweh) 155 | (trade-with-exit-history->risks tweh) 156 | (trade-with-exit-history->rewards tweh) 157 | (trade-with-exit-history->pcts-str tweh)) 158 | (map (λ (t i) (send simulator-trades-box set-data i 159 | (list symbol (trade-with-exit-date t)))) 160 | tweh (range (length tweh))) 161 | (send simulator-trades-box set-label 162 | (string-append "Trades History - Reward Ratio: " 163 | (real->decimal-string reward-ratio) 164 | " Win Pct: " (real->decimal-string win-pct) 165 | " Lose Pct: " (real->decimal-string lose-pct) 166 | " Win Pct Avg: " (real->decimal-string win-pct-avg) 167 | " Lose Pct Avg: " (real->decimal-string lose-pct-avg) 168 | " Return: " (real->decimal-string return))) 169 | (send simulator-test-box set 170 | (map (λ (e) symbol) (history-test exec)) 171 | (map (λ (e) (~t (posix->datetime (dv-date e)) "yyyy-MM-dd")) (history-test exec)) 172 | (map (λ (e) (real->decimal-string (test-entry (dv-value e)))) (history-test exec)) 173 | (map (λ (e) (real->decimal-string (test-stop (dv-value e)))) (history-test exec)) 174 | (map (λ (e) (real->decimal-string (test-target (dv-value e)))) (history-test exec))) 175 | (map (λ (t i) (send simulator-test-box set-data i 176 | (list symbol (dv-date t)))) 177 | (history-test exec) (range (length (history-test exec))))) 178 | (send c enable #t))])) 179 | 180 | (define simulator-get-40-button 181 | (new button% 182 | [parent simulator-input-pane] 183 | [label "Get 40"] 184 | [callback (λ (c e) 185 | (send c enable #f) 186 | (let* ([symbols (cond 187 | [(equal? (send symbol-source-choice get-string-selection) 188 | random-above-25-str) 189 | (get-random-symbols-over-price 25.0 40)] 190 | [(equal? (send symbol-source-choice get-string-selection) 191 | random-sp-500-str) 192 | (get-random-sp-500-symbols 40)])] 193 | [execs (map (λ (s) (list s ((hash-ref strategy-hash (send strategy-choice get-string-selection)) 194 | (get-date-ohlc s (send start-date-field get-value) 195 | (send end-date-field get-value))))) symbols)] 196 | [tweh (flatten (map (λ (lbe) (trade-with-exit-history 197 | (first lbe) 198 | (history-trade (second lbe)))) 199 | execs))] 200 | [tws (flatten (map (λ (lbe) (map (λ (t) (test-with-symbol (first lbe) 201 | (dv-date t) 202 | (test-entry (dv-value t)) 203 | (test-stop (dv-value t)) 204 | (test-target (dv-value t)))) 205 | (history-test (second lbe)))) 206 | execs))] 207 | [winners (filter (λ (t) (<= 0 (* (- (trade-with-exit-exit-price t) 208 | (trade-with-exit-price t)) 209 | (trade-with-exit-amount t)))) tweh)] 210 | [win-pct (if (= 0 (length tweh)) 0 211 | (* (/ (length winners) (length tweh)) 100))] 212 | [win-pct-avg (if (= 0 (length winners)) 0 213 | (mean (trade-with-exit-history->pcts winners)))] 214 | [losers (remove* winners tweh)] 215 | [lose-pct (if (= 0 (length tweh)) 0 216 | (* (/ (length losers) (length tweh)) 100))] 217 | [lose-pct-avg (if (= 0 (length losers)) 0 218 | (mean (trade-with-exit-history->pcts losers)))] 219 | [reward-ratio (if (= 0 lose-pct-avg) 0 (/ win-pct-avg (abs lose-pct-avg)))] 220 | [return (+ (* win-pct win-pct-avg) (* lose-pct lose-pct-avg))]) 221 | (send simulator-trades-box set 222 | (map (λ (e) (trade-with-exit-symbol e)) tweh) 223 | (map (λ (e) (~t (posix->datetime (trade-with-exit-date e)) "yyyy-MM-dd")) tweh) 224 | (map (λ (e) (real->decimal-string (trade-with-exit-price e))) tweh) 225 | (map (λ (e) (real->decimal-string (test-entry (trade-with-exit-test e)))) tweh) 226 | (map (λ (e) (real->decimal-string (test-stop (trade-with-exit-test e)))) tweh) 227 | (map (λ (e) (real->decimal-string (test-target (trade-with-exit-test e)))) tweh) 228 | (map (λ (e) (~t (posix->datetime (trade-with-exit-exit-date e)) "yyyy-MM-dd")) tweh) 229 | (map (λ (e) (real->decimal-string (trade-with-exit-exit-price e))) tweh) 230 | (trade-with-exit-history->ratios tweh) 231 | (trade-with-exit-history->risks tweh) 232 | (trade-with-exit-history->rewards tweh) 233 | (trade-with-exit-history->pcts-str tweh)) 234 | (map (λ (t i) (send simulator-trades-box set-data i 235 | (list (trade-with-exit-symbol t) (trade-with-exit-date t)))) 236 | tweh (range (length tweh))) 237 | (send simulator-trades-box set-label 238 | (string-append "Trades History - Reward Ratio: " (real->decimal-string reward-ratio) 239 | " Win Pct: " (real->decimal-string win-pct) 240 | " Lose Pct: " (real->decimal-string lose-pct) 241 | " Win Pct Avg: " (real->decimal-string win-pct-avg) 242 | " Lose Pct Avg: " (real->decimal-string lose-pct-avg) 243 | " Return: " (real->decimal-string return))) 244 | (send simulator-test-box set 245 | (map (λ (t) (test-with-symbol-symbol t)) tws) 246 | (map (λ (t) (~t (posix->datetime (test-with-symbol-date t)) "yyyy-MM-dd")) tws) 247 | (map (λ (t) (real->decimal-string (test-with-symbol-entry t))) tws) 248 | (map (λ (t) (real->decimal-string (test-with-symbol-stop t))) tws) 249 | (map (λ (t) (real->decimal-string (test-with-symbol-target t))) tws)) 250 | (map (λ (t i) (send simulator-test-box set-data i 251 | (list (test-with-symbol-symbol t) (test-with-symbol-date t)))) 252 | tws (range (length tws)))) 253 | (send c enable #t))])) 254 | 255 | (define simulator-table-pane (new vertical-pane% 256 | [parent simulator-frame])) 257 | 258 | (define (add-months d n) 259 | (~t (+months (posix->datetime d) n) "yyyy-MM-dd")) 260 | 261 | (define (subtract-months d n) 262 | (~t (-months (posix->datetime d) n) "yyyy-MM-dd")) 263 | 264 | (define simulator-trades-box-columns (list "Symbol" "Date" "Price" "Entry Price" "Stop Price" "Target Price" "Exit Date" 265 | "Exit Price" "Ratio" "Risk" "Reward" "Pct Gain")) 266 | 267 | (define simulator-trades-box (new list-box% 268 | [label "Trade History"] 269 | [parent simulator-table-pane] 270 | [callback (λ (b e) 271 | (let ([symbol (first (send b get-data (first (send b get-selections))))] 272 | [date (second (send b get-data (first (send b get-selections))))]) 273 | (refresh-chart symbol 274 | (subtract-months date 5) 275 | (add-months date 3))))] 276 | [style (list 'single 'column-headers 'vertical-label)] 277 | [columns simulator-trades-box-columns] 278 | [choices (list "")])) 279 | 280 | (define simulator-test-box-columns (list "Symbol" "Date" "Entry Price" "Stop Price" "Target Price")) 281 | 282 | (define simulator-test-box (new list-box% 283 | [label "TEST History"] 284 | [parent simulator-table-pane] 285 | [callback (λ (b e) 286 | (let ([symbol (first (send b get-data (first (send b get-selections))))] 287 | [date (second (send b get-data (first (send b get-selections))))]) 288 | (refresh-chart symbol 289 | (subtract-months date 5) 290 | (add-months date 3))))] 291 | [style (list 'single 'column-headers 'vertical-label)] 292 | [columns simulator-test-box-columns] 293 | [choices (list "")])) 294 | 295 | (define (show-simulator) 296 | (send simulator-frame show #t) 297 | (let ([box-width (send simulator-trades-box get-width)] 298 | [num-cols (length simulator-trades-box-columns)]) 299 | (for-each (λ (i) (send simulator-trades-box set-column-width i 300 | 100 301 | 100 302 | 100)) (range num-cols))) 303 | (let ([box-width (send simulator-test-box get-width)] 304 | [num-cols (length simulator-test-box-columns)]) 305 | (for-each (λ (i) (send simulator-test-box set-column-width i 306 | 250 307 | 250 308 | 250)) (range num-cols)))) 309 | -------------------------------------------------------------------------------- /strategy/ascending-triangle.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require racket/stream 4 | racket/vector 5 | "../structs.rkt" 6 | "../technical-indicators.rkt") 7 | 8 | (provide ascending-triangle-execution) 9 | 10 | (struct ascending-triangle-in 11 | (dohlc 12 | sma-20 13 | sma-20-slope 14 | sma-50 15 | sma-50-slope 16 | satr-50 17 | dc-25-high 18 | dc-25-low 19 | dc-25-prev-high 20 | dc-25-prev-low) 21 | #:transparent) 22 | 23 | (define (ascending-triangle-in-drop-1 atid) 24 | (ascending-triangle-in (stream-rest (ascending-triangle-in-dohlc atid)) 25 | (stream-rest (ascending-triangle-in-sma-20 atid)) 26 | (stream-rest (ascending-triangle-in-sma-20-slope atid)) 27 | (stream-rest (ascending-triangle-in-sma-50 atid)) 28 | (stream-rest (ascending-triangle-in-sma-50-slope atid)) 29 | (stream-rest (ascending-triangle-in-satr-50 atid)) 30 | (stream-rest (ascending-triangle-in-dc-25-high atid)) 31 | (stream-rest (ascending-triangle-in-dc-25-low atid)) 32 | (stream-rest (ascending-triangle-in-dc-25-prev-high atid)) 33 | (stream-rest (ascending-triangle-in-dc-25-prev-low atid)))) 34 | 35 | (define (ascending-triangle t ; timeframe entry stop target 36 | p ; position 37 | h ; history 38 | i) ; market data inputs 39 | (if (or (stream-empty? (ascending-triangle-in-dohlc i)) 40 | (stream-empty? (ascending-triangle-in-sma-20 i)) 41 | (stream-empty? (ascending-triangle-in-sma-20-slope i)) 42 | (stream-empty? (ascending-triangle-in-sma-50 i)) 43 | (stream-empty? (ascending-triangle-in-sma-50-slope i)) 44 | (stream-empty? (ascending-triangle-in-satr-50 i)) 45 | (stream-empty? (ascending-triangle-in-dc-25-high i)) 46 | (stream-empty? (ascending-triangle-in-dc-25-low i)) 47 | (stream-empty? (ascending-triangle-in-dc-25-prev-high i)) 48 | (stream-empty? (ascending-triangle-in-dc-25-prev-low i))) 49 | h 50 | 51 | (let ([date (dohlc-date (stream-first (ascending-triangle-in-dohlc i)))] 52 | [open (dohlc-open (stream-first (ascending-triangle-in-dohlc i)))] 53 | [high (dohlc-high (stream-first (ascending-triangle-in-dohlc i)))] 54 | [low (dohlc-low (stream-first (ascending-triangle-in-dohlc i)))] 55 | [close (dohlc-close (stream-first (ascending-triangle-in-dohlc i)))] 56 | [sma-20 (dv-value (stream-first (ascending-triangle-in-sma-20 i)))] 57 | [sma-20-slope (dv-value (stream-first (ascending-triangle-in-sma-20-slope i)))] 58 | [sma-50 (dv-value (stream-first (ascending-triangle-in-sma-50 i)))] 59 | [sma-50-slope (dv-value (stream-first (ascending-triangle-in-sma-50-slope i)))] 60 | [satr (dv-value (stream-first (ascending-triangle-in-satr-50 i)))] 61 | [dc-25-high (dv-value (stream-first (ascending-triangle-in-dc-25-high i)))] 62 | [dc-25-low (dv-value (stream-first (ascending-triangle-in-dc-25-low i)))] 63 | [dc-25-prev-high (dv-value (stream-first (ascending-triangle-in-dc-25-prev-high i)))] 64 | [dc-25-prev-low (dv-value (stream-first (ascending-triangle-in-dc-25-prev-low i)))]) 65 | ; (displayln t) 66 | ; (displayln p) 67 | ; (displayln h) 68 | ; (printf "~a ~a ~a ~a ~a ~a ~a ~a ~a ~a\n" date open high low close sma-20 sma-50 satr dc-high dc-low) 69 | (cond 70 | ; found satisfactory conditions for entry for the first time 71 | [(and (null? t) 72 | (null? p) 73 | (< satr (* close 4/100)) 74 | (> sma-20 sma-50) 75 | (< 0 sma-50-slope) 76 | (> close sma-20) 77 | (< 0 sma-20-slope) 78 | (> close (- dc-25-high (* satr 4/2))) 79 | (> dc-25-high dc-25-prev-high) 80 | (> dc-25-prev-high (* dc-25-high 99/100)) 81 | (> (- dc-25-low (* (- dc-25-high dc-25-low) 1/2)) dc-25-prev-low)) 82 | ; (< (- dc-25-high dc-25-low) (* satr 4/2)) 83 | ; (< dc-25-prev-high (+ dc-25-high (/ satr 5)))) 84 | (let ([new-test (test 20 85 | (+ dc-25-high 5/100) 86 | (- dc-25-high (* satr 2)) 87 | (+ dc-25-high (* satr 4)))]) 88 | (ascending-triangle new-test 89 | p 90 | (history (append (history-test h) 91 | (list (dv date new-test))) 92 | (history-trade h)) 93 | (ascending-triangle-in-drop-1 i)))] 94 | ; satisfactory conditions no longer exist for entry 95 | [(and (not (null? t)) 96 | (null? p) 97 | (or (<= open (test-stop t)) 98 | (<= high (test-stop t)) 99 | (<= low (test-stop t)) 100 | (<= close (test-stop t)))) 101 | (ascending-triangle null p h (ascending-triangle-in-drop-1 i))] 102 | ; satisfactory conditions exist for entry and open price leads to execution 103 | [(and (not (null? t)) 104 | (null? p) 105 | (>= open (test-entry t))) 106 | (ascending-triangle t (position open 1) 107 | (history (history-test h) 108 | (append (history-trade h) (list (trade date open 1 t)))) 109 | (ascending-triangle-in-drop-1 i))] 110 | ; satisfactory conditions exist for entry and price range leads to execution 111 | [(and (not (null? t)) 112 | (null? p) 113 | (<= open (test-entry t)) 114 | (>= high (test-entry t)) 115 | (<= low (test-entry t))) 116 | (ascending-triangle t 117 | (position (test-entry t) 1) 118 | (history (history-test h) 119 | (append (history-trade h) (list (trade date (test-entry t) 1 t)))) 120 | (ascending-triangle-in-drop-1 i))] 121 | ; have position and open below stop 122 | [(and (not (null? p)) 123 | (<= open (test-stop t))) 124 | (ascending-triangle null null 125 | (history (history-test h) 126 | (append (history-trade h) (list (trade date open -1 t)))) 127 | (ascending-triangle-in-drop-1 i))] 128 | ; have position and price range above stop 129 | [(and (not (null? p)) 130 | (> open (test-stop t)) 131 | (>= high (test-stop t)) 132 | (<= low (test-stop t))) 133 | (ascending-triangle null null 134 | (history (history-test h) 135 | (append (history-trade h) (list (trade date (test-stop t) -1 t)))) 136 | (ascending-triangle-in-drop-1 i))] 137 | ; have position and both parts of open/close above target and stop 138 | [(and (not (null? p)) 139 | (> open (test-target t)) 140 | (> close (test-target t)) 141 | (> open (test-stop t)) 142 | (> close (test-stop t))) 143 | (let ([new-test (test (test-timeframe t) 144 | (test-entry t) 145 | (min open close) 146 | (test-target t))]) 147 | (ascending-triangle new-test 148 | p 149 | (history (append (history-test h) 150 | (list (dv date new-test))) 151 | (history-trade h)) 152 | (ascending-triangle-in-drop-1 i)))] 153 | ; have position and timeframe has ended 154 | [(and (not (null? p)) 155 | (= 0 (test-timeframe t))) 156 | (ascending-triangle null null 157 | (history (history-test h) 158 | (append (history-trade h) (list (trade date close -1 t)))) 159 | (ascending-triangle-in-drop-1 i))] 160 | ; have position and should move stop closer to close 161 | [(and (not (null? p)) 162 | (< (* 3 satr) (- low (test-stop t)))) 163 | (let ([new-test (test (- (test-timeframe t) 1) 164 | (test-entry t) 165 | (+ (test-stop t) satr) 166 | (test-target t))]) 167 | (ascending-triangle new-test 168 | p 169 | (history (append (history-test h) 170 | (list (dv date new-test))) 171 | (history-trade h)) 172 | (ascending-triangle-in-drop-1 i)))] 173 | ; have position and can do nothing 174 | [(not (null? p)) 175 | (ascending-triangle (test-timeframe-minus-1 t) p h (ascending-triangle-in-drop-1 i))] 176 | ; have no position and can do nothing 177 | [else (ascending-triangle t p h (ascending-triangle-in-drop-1 i))])))) 178 | 179 | (define (ascending-triangle-execution dohlc-list) 180 | (let*-values ([(dohlc-vector) (list->vector dohlc-list)] 181 | [(sma-20) (simple-moving-average dohlc-vector 20)] 182 | [(sma-20-slope) (delta sma-20 50)] 183 | [(sma-50) (simple-moving-average dohlc-vector 50)] 184 | [(sma-50-slope) (delta sma-50 50)] 185 | [(satr-50) (simple-average-true-range dohlc-vector 50)] 186 | [(dc-25-high dc-25-low) (donchian-channel dohlc-vector 25)] 187 | [(dc-25-prev-high dc-25-prev-low) (values (shift dc-25-high 25) (shift dc-25-low 25))] 188 | [(min-length) (min (vector-length dohlc-vector) 189 | (vector-length sma-20) 190 | (vector-length sma-20-slope) 191 | (vector-length sma-50) 192 | (vector-length sma-50-slope) 193 | (vector-length satr-50) 194 | (vector-length dc-25-high) 195 | (vector-length dc-25-low) 196 | (vector-length dc-25-prev-high) 197 | (vector-length dc-25-prev-low))]) 198 | (ascending-triangle null null 199 | (history (list) (list)) 200 | (ascending-triangle-in (sequence->stream (vector-take-right dohlc-vector min-length)) 201 | (sequence->stream (vector-take-right sma-20 min-length)) 202 | (sequence->stream (vector-take-right sma-20-slope min-length)) 203 | (sequence->stream (vector-take-right sma-50 min-length)) 204 | (sequence->stream (vector-take-right sma-50-slope min-length)) 205 | (sequence->stream (vector-take-right satr-50 min-length)) 206 | (sequence->stream (vector-take-right dc-25-high min-length)) 207 | (sequence->stream (vector-take-right dc-25-low min-length)) 208 | (sequence->stream (vector-take-right dc-25-prev-high min-length)) 209 | (sequence->stream (vector-take-right dc-25-prev-low min-length)))))) 210 | -------------------------------------------------------------------------------- /strategy/bear-rally.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require racket/stream 4 | racket/vector 5 | "../structs.rkt" 6 | "../technical-indicators.rkt") 7 | 8 | (provide bear-rally-execution) 9 | 10 | (struct bear-rally-in 11 | (dohlc 12 | sma-20 13 | sma-20-slope 14 | sma-50 15 | sma-50-slope 16 | satr-50 17 | dc-20-high 18 | dc-20-low) 19 | #:transparent) 20 | 21 | (define (bear-rally-in-drop-1 lbi) 22 | (bear-rally-in (stream-rest (bear-rally-in-dohlc lbi)) 23 | (stream-rest (bear-rally-in-sma-20 lbi)) 24 | (stream-rest (bear-rally-in-sma-20-slope lbi)) 25 | (stream-rest (bear-rally-in-sma-50 lbi)) 26 | (stream-rest (bear-rally-in-sma-50-slope lbi)) 27 | (stream-rest (bear-rally-in-satr-50 lbi)) 28 | (stream-rest (bear-rally-in-dc-20-high lbi)) 29 | (stream-rest (bear-rally-in-dc-20-low lbi)))) 30 | 31 | (define (bear-rally t ; timeframe entry stop target 32 | p ; position 33 | h ; history 34 | i) ; market data inputs 35 | (if (or (stream-empty? (bear-rally-in-dohlc i)) 36 | (stream-empty? (bear-rally-in-sma-20 i)) 37 | (stream-empty? (bear-rally-in-sma-20-slope i)) 38 | (stream-empty? (bear-rally-in-sma-50 i)) 39 | (stream-empty? (bear-rally-in-sma-50-slope i)) 40 | (stream-empty? (bear-rally-in-satr-50 i)) 41 | (stream-empty? (bear-rally-in-dc-20-high i)) 42 | (stream-empty? (bear-rally-in-dc-20-low i))) 43 | h 44 | 45 | (let ([date (dohlc-date (stream-first (bear-rally-in-dohlc i)))] 46 | [open (dohlc-open (stream-first (bear-rally-in-dohlc i)))] 47 | [high (dohlc-high (stream-first (bear-rally-in-dohlc i)))] 48 | [low (dohlc-low (stream-first (bear-rally-in-dohlc i)))] 49 | [close (dohlc-close (stream-first (bear-rally-in-dohlc i)))] 50 | [sma-20 (dv-value (stream-first (bear-rally-in-sma-20 i)))] 51 | [sma-20-slope (dv-value (stream-first (bear-rally-in-sma-20-slope i)))] 52 | [sma-50 (dv-value (stream-first (bear-rally-in-sma-50 i)))] 53 | [sma-50-slope (dv-value (stream-first (bear-rally-in-sma-50-slope i)))] 54 | [satr (dv-value (stream-first (bear-rally-in-satr-50 i)))] 55 | [dc-20-high (dv-value (stream-first (bear-rally-in-dc-20-high i)))] 56 | [dc-20-low (dv-value (stream-first (bear-rally-in-dc-20-low i)))]) 57 | ; (displayln t) 58 | ; (displayln p) 59 | ; (displayln h) 60 | ; (printf "~a ~a ~a ~a ~a ~a ~a ~a ~a ~a\n" date open high low close sma-20 sma-50 satr dc-high dc-low) 61 | (cond 62 | ; found satisfactory conditions for entry for the first time 63 | [(and (null? t) 64 | (null? p) 65 | (< satr (* close 4/100)) 66 | (< sma-20 sma-50) 67 | (> 0 sma-50-slope) 68 | (< close sma-20) 69 | (> 0 sma-20-slope) 70 | (< close open) 71 | (> (+ dc-20-low satr) low) 72 | (> open sma-20 close) 73 | (> (- sma-50 sma-20) (- sma-20 dc-20-low))) 74 | (let ([new-test (test 20 75 | (- low 5/100) 76 | (+ low (* satr 2)) 77 | (- low (* satr 4)))]) 78 | (bear-rally new-test 79 | p 80 | (history (append (history-test h) 81 | (list (dv date new-test))) 82 | (history-trade h)) 83 | (bear-rally-in-drop-1 i)))] 84 | ; satisfactory conditions no longer exist for entry 85 | [(and (not (null? t)) 86 | (null? p) 87 | (or (>= open (test-stop t)) 88 | (>= high (test-stop t)) 89 | (>= low (test-stop t)) 90 | (>= close (test-stop t)))) 91 | (bear-rally null p h (bear-rally-in-drop-1 i))] 92 | ; satisfactory conditions exist for entry and open price leads to execution 93 | [(and (not (null? t)) 94 | (null? p) 95 | (< open (test-entry t))) 96 | (bear-rally t (position open -1) 97 | (history (history-test h) 98 | (append (history-trade h) (list (trade date open -1 t)))) 99 | (bear-rally-in-drop-1 i))] 100 | ; satisfactory conditions exist for entry and price range leads to execution 101 | [(and (not (null? t)) 102 | (null? p) 103 | (>= open (test-entry t)) 104 | (>= high (test-entry t)) 105 | (<= low (test-entry t))) 106 | (bear-rally t 107 | (position (test-entry t) -1) 108 | (history (history-test h) 109 | (append (history-trade h) (list (trade date (test-entry t) -1 t)))) 110 | (bear-rally-in-drop-1 i))] 111 | ; have position and open above stop 112 | [(and (not (null? p)) 113 | (>= open (test-stop t))) 114 | (bear-rally null null 115 | (history (history-test h) 116 | (append (history-trade h) (list (trade date open 1 t)))) 117 | (bear-rally-in-drop-1 i))] 118 | ; have position and price range above stop 119 | [(and (not (null? p)) 120 | (< open (test-stop t)) 121 | (>= high (test-stop t)) 122 | (<= low (test-stop t))) 123 | (bear-rally null null 124 | (history (history-test h) 125 | (append (history-trade h) (list (trade date (test-stop t) 1 t)))) 126 | (bear-rally-in-drop-1 i))] 127 | ; have position and both parts of open/close below target and stop 128 | [(and (not (null? p)) 129 | (< open (test-target t)) 130 | (< close (test-target t)) 131 | (< open (test-stop t)) 132 | (< close (test-stop t))) 133 | (let ([new-test (test (test-timeframe t) 134 | (test-entry t) 135 | (max open close) 136 | (test-target t))]) 137 | (bear-rally new-test 138 | p 139 | (history (append (history-test h) 140 | (list (dv date new-test))) 141 | (history-trade h)) 142 | (bear-rally-in-drop-1 i)))] 143 | ; have position and timeframe has ended 144 | [(and (not (null? p)) 145 | (= 0 (test-timeframe t))) 146 | (bear-rally null null 147 | (history (history-test h) 148 | (append (history-trade h) (list (trade date close 1 t)))) 149 | (bear-rally-in-drop-1 i))] 150 | ; have position and should move stop closer to close 151 | [(and (not (null? p)) 152 | (< (* 3 satr) (- (test-stop t) high))) 153 | (let ([new-test (test (- (test-timeframe t) 1) 154 | (test-entry t) 155 | (- (test-stop t) satr) ; (+ close (* 2 satr)) 156 | (test-target t))]) 157 | (bear-rally new-test 158 | p 159 | (history (append (history-test h) 160 | (list (dv date new-test))) 161 | (history-trade h)) 162 | (bear-rally-in-drop-1 i)))] 163 | ; have position and can do nothing 164 | [(not (null? p)) 165 | (bear-rally (test-timeframe-minus-1 t) p h (bear-rally-in-drop-1 i))] 166 | ; have no position and can do nothing 167 | [else (bear-rally t p h (bear-rally-in-drop-1 i))])))) 168 | 169 | (define (bear-rally-execution dohlc-list) 170 | (let*-values ([(dohlc-vector) (list->vector dohlc-list)] 171 | [(sma-20) (simple-moving-average dohlc-vector 20)] 172 | [(sma-20-slope) (delta sma-20 50)] 173 | [(sma-50) (simple-moving-average dohlc-vector 50)] 174 | [(sma-50-slope) (delta sma-50 50)] 175 | [(satr-50) (simple-average-true-range dohlc-vector 50)] 176 | [(dc-20-high dc-20-low) (donchian-channel dohlc-vector 20)] 177 | [(min-length) (min (vector-length dohlc-vector) 178 | (vector-length sma-20) 179 | (vector-length sma-20-slope) 180 | (vector-length sma-50) 181 | (vector-length sma-50-slope) 182 | (vector-length satr-50) 183 | (vector-length dc-20-high) 184 | (vector-length dc-20-low))]) 185 | (bear-rally null null 186 | (history (list) (list)) 187 | (bear-rally-in (sequence->stream (vector-take-right dohlc-vector min-length)) 188 | (sequence->stream (vector-take-right sma-20 min-length)) 189 | (sequence->stream (vector-take-right sma-20-slope min-length)) 190 | (sequence->stream (vector-take-right sma-50 min-length)) 191 | (sequence->stream (vector-take-right sma-50-slope min-length)) 192 | (sequence->stream (vector-take-right satr-50 min-length)) 193 | (sequence->stream (vector-take-right dc-20-high min-length)) 194 | (sequence->stream (vector-take-right dc-20-low min-length)))))) 195 | -------------------------------------------------------------------------------- /strategy/bull-pullback.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require racket/stream 4 | racket/vector 5 | "../structs.rkt" 6 | "../technical-indicators.rkt") 7 | 8 | (provide bull-pullback-execution) 9 | 10 | (struct bull-pullback-in 11 | (dohlc 12 | sma-20 13 | sma-20-slope 14 | sma-50 15 | sma-50-slope 16 | satr-50 17 | dc-20-high 18 | dc-20-low) 19 | #:transparent) 20 | 21 | (define (bull-pullback-in-drop-1 lbi) 22 | (bull-pullback-in (stream-rest (bull-pullback-in-dohlc lbi)) 23 | (stream-rest (bull-pullback-in-sma-20 lbi)) 24 | (stream-rest (bull-pullback-in-sma-20-slope lbi)) 25 | (stream-rest (bull-pullback-in-sma-50 lbi)) 26 | (stream-rest (bull-pullback-in-sma-50-slope lbi)) 27 | (stream-rest (bull-pullback-in-satr-50 lbi)) 28 | (stream-rest (bull-pullback-in-dc-20-high lbi)) 29 | (stream-rest (bull-pullback-in-dc-20-low lbi)))) 30 | 31 | (define (bull-pullback t ; timeframe entry stop target 32 | p ; position 33 | h ; history 34 | i) ; market data inputs 35 | (if (or (stream-empty? (bull-pullback-in-dohlc i)) 36 | (stream-empty? (bull-pullback-in-sma-20 i)) 37 | (stream-empty? (bull-pullback-in-sma-20-slope i)) 38 | (stream-empty? (bull-pullback-in-sma-50 i)) 39 | (stream-empty? (bull-pullback-in-sma-50-slope i)) 40 | (stream-empty? (bull-pullback-in-satr-50 i)) 41 | (stream-empty? (bull-pullback-in-dc-20-high i)) 42 | (stream-empty? (bull-pullback-in-dc-20-low i))) 43 | h 44 | 45 | (let ([date (dohlc-date (stream-first (bull-pullback-in-dohlc i)))] 46 | [open (dohlc-open (stream-first (bull-pullback-in-dohlc i)))] 47 | [high (dohlc-high (stream-first (bull-pullback-in-dohlc i)))] 48 | [low (dohlc-low (stream-first (bull-pullback-in-dohlc i)))] 49 | [close (dohlc-close (stream-first (bull-pullback-in-dohlc i)))] 50 | [sma-20 (dv-value (stream-first (bull-pullback-in-sma-20 i)))] 51 | [sma-20-slope (dv-value (stream-first (bull-pullback-in-sma-20-slope i)))] 52 | [sma-50 (dv-value (stream-first (bull-pullback-in-sma-50 i)))] 53 | [sma-50-slope (dv-value (stream-first (bull-pullback-in-sma-50-slope i)))] 54 | [satr (dv-value (stream-first (bull-pullback-in-satr-50 i)))] 55 | [dc-20-high (dv-value (stream-first (bull-pullback-in-dc-20-high i)))] 56 | [dc-20-low (dv-value (stream-first (bull-pullback-in-dc-20-low i)))]) 57 | ; (displayln t) 58 | ; (displayln p) 59 | ; (displayln h) 60 | ; (printf "~a ~a ~a ~a ~a ~a ~a ~a ~a ~a\n" date open high low close sma-20 sma-50 satr dc-high dc-low) 61 | (cond 62 | ; found satisfactory conditions for entry for the first time 63 | [(and (null? t) 64 | (null? p) 65 | (< satr (* close 4/100)) 66 | (> sma-20 sma-50) 67 | (< 0 sma-50-slope) 68 | (> close sma-20) 69 | (< 0 sma-20-slope) 70 | (> close open) 71 | (> (- dc-20-high satr) high) 72 | (> close sma-20 open) 73 | (> (- sma-20 sma-50) (- dc-20-high sma-20)) 74 | ; (or (and (> close sma-20 open)) 75 | ; (and (> close sma-50 open))) 76 | ) 77 | (let ([new-test (test 20 78 | (+ high 5/100) 79 | (- high (* satr 2)) 80 | (+ high (* satr 4)))]) 81 | (bull-pullback new-test 82 | p 83 | (history (append (history-test h) 84 | (list (dv date new-test))) 85 | (history-trade h)) 86 | (bull-pullback-in-drop-1 i)))] 87 | ; satisfactory conditions no longer exist for entry 88 | [(and (not (null? t)) 89 | (null? p) 90 | (or (<= open (test-stop t)) 91 | (<= high (test-stop t)) 92 | (<= low (test-stop t)) 93 | (<= close (test-stop t)))) 94 | (bull-pullback null p h (bull-pullback-in-drop-1 i))] 95 | ; satisfactory conditions exist for entry and open price leads to execution 96 | [(and (not (null? t)) 97 | (null? p) 98 | (>= open (test-entry t))) 99 | (bull-pullback t (position open 1) 100 | (history (history-test h) 101 | (append (history-trade h) (list (trade date open 1 t)))) 102 | (bull-pullback-in-drop-1 i))] 103 | ; satisfactory conditions exist for entry and price range leads to execution 104 | [(and (not (null? t)) 105 | (null? p) 106 | (<= open (test-entry t)) 107 | (>= high (test-entry t)) 108 | (<= low (test-entry t))) 109 | (bull-pullback t 110 | (position (test-entry t) 1) 111 | (history (history-test h) 112 | (append (history-trade h) (list (trade date (test-entry t) 1 t)))) 113 | (bull-pullback-in-drop-1 i))] 114 | ; have position and open below stop 115 | [(and (not (null? p)) 116 | (<= open (test-stop t))) 117 | (bull-pullback null null 118 | (history (history-test h) 119 | (append (history-trade h) (list (trade date open -1 t)))) 120 | (bull-pullback-in-drop-1 i))] 121 | ; have position and price range above stop 122 | [(and (not (null? p)) 123 | (> open (test-stop t)) 124 | (>= high (test-stop t)) 125 | (<= low (test-stop t))) 126 | (bull-pullback null null 127 | (history (history-test h) 128 | (append (history-trade h) (list (trade date (test-stop t) -1 t)))) 129 | (bull-pullback-in-drop-1 i))] 130 | ; have position and both parts of open/close above target and stop 131 | [(and (not (null? p)) 132 | (> open (test-target t)) 133 | (> close (test-target t)) 134 | (> open (test-stop t)) 135 | (> close (test-stop t))) 136 | (let ([new-test (test (test-timeframe t) 137 | (test-entry t) 138 | (min open close) 139 | (test-target t))]) 140 | (bull-pullback new-test 141 | p 142 | (history (append (history-test h) 143 | (list (dv date new-test))) 144 | (history-trade h)) 145 | (bull-pullback-in-drop-1 i)))] 146 | ; have position and timeframe has ended 147 | [(and (not (null? p)) 148 | (= 0 (test-timeframe t))) 149 | (bull-pullback null null 150 | (history (history-test h) 151 | (append (history-trade h) (list (trade date close -1 t)))) 152 | (bull-pullback-in-drop-1 i))] 153 | ; have position and should move stop closer to close 154 | [(and (not (null? p)) 155 | (< (* 3 satr) (- low (test-stop t)))) 156 | (let ([new-test (test (- (test-timeframe t) 1) 157 | (test-entry t) 158 | (+ (test-stop t) satr) 159 | (test-target t))]) 160 | (bull-pullback new-test 161 | p 162 | (history (append (history-test h) 163 | (list (dv date new-test))) 164 | (history-trade h)) 165 | (bull-pullback-in-drop-1 i)))] 166 | ; have position and can do nothing 167 | [(not (null? p)) 168 | (bull-pullback (test-timeframe-minus-1 t) p h (bull-pullback-in-drop-1 i))] 169 | ; have no position and can do nothing 170 | [else (bull-pullback t p h (bull-pullback-in-drop-1 i))])))) 171 | 172 | (define (bull-pullback-execution dohlc-list) 173 | (let*-values ([(dohlc-vector) (list->vector dohlc-list)] 174 | [(sma-20) (simple-moving-average dohlc-vector 20)] 175 | [(sma-20-slope) (delta sma-20 50)] 176 | [(sma-50) (simple-moving-average dohlc-vector 50)] 177 | [(sma-50-slope) (delta sma-50 50)] 178 | [(satr-50) (simple-average-true-range dohlc-vector 50)] 179 | [(dc-20-high dc-20-low) (donchian-channel dohlc-vector 20)] 180 | [(min-length) (min (vector-length dohlc-vector) 181 | (vector-length sma-20) 182 | (vector-length sma-20-slope) 183 | (vector-length sma-50) 184 | (vector-length sma-50-slope) 185 | (vector-length satr-50) 186 | (vector-length dc-20-high) 187 | (vector-length dc-20-low))]) 188 | (bull-pullback null null 189 | (history (list) (list)) 190 | (bull-pullback-in (sequence->stream (vector-take-right dohlc-vector min-length)) 191 | (sequence->stream (vector-take-right sma-20 min-length)) 192 | (sequence->stream (vector-take-right sma-20-slope min-length)) 193 | (sequence->stream (vector-take-right sma-50 min-length)) 194 | (sequence->stream (vector-take-right sma-50-slope min-length)) 195 | (sequence->stream (vector-take-right satr-50 min-length)) 196 | (sequence->stream (vector-take-right dc-20-high min-length)) 197 | (sequence->stream (vector-take-right dc-20-low min-length)))))) 198 | -------------------------------------------------------------------------------- /strategy/descending-triangle.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require racket/stream 4 | racket/vector 5 | "../structs.rkt" 6 | "../technical-indicators.rkt") 7 | 8 | (provide descending-triangle-execution) 9 | 10 | (struct descending-triangle-in 11 | (dohlc 12 | sma-20 13 | sma-20-slope 14 | sma-50 15 | sma-50-slope 16 | satr-50 17 | dc-25-high 18 | dc-25-low 19 | dc-25-prev-high 20 | dc-25-prev-low) 21 | #:transparent) 22 | 23 | (define (descending-triangle t ; timeframe entry stop target 24 | p ; position 25 | h ; history 26 | i) ; market data inputs 27 | (if (or (stream-empty? (descending-triangle-in-dohlc i)) 28 | (stream-empty? (descending-triangle-in-sma-20 i)) 29 | (stream-empty? (descending-triangle-in-sma-20-slope i)) 30 | (stream-empty? (descending-triangle-in-sma-50 i)) 31 | (stream-empty? (descending-triangle-in-sma-50-slope i)) 32 | (stream-empty? (descending-triangle-in-satr-50 i)) 33 | (stream-empty? (descending-triangle-in-dc-25-high i)) 34 | (stream-empty? (descending-triangle-in-dc-25-low i)) 35 | (stream-empty? (descending-triangle-in-dc-25-prev-high i)) 36 | (stream-empty? (descending-triangle-in-dc-25-prev-low i))) 37 | h 38 | 39 | (let ([date (dohlc-date (stream-first (descending-triangle-in-dohlc i)))] 40 | [open (dohlc-open (stream-first (descending-triangle-in-dohlc i)))] 41 | [high (dohlc-high (stream-first (descending-triangle-in-dohlc i)))] 42 | [low (dohlc-low (stream-first (descending-triangle-in-dohlc i)))] 43 | [close (dohlc-close (stream-first (descending-triangle-in-dohlc i)))] 44 | [sma-20 (dv-value (stream-first (descending-triangle-in-sma-20 i)))] 45 | [sma-20-slope (dv-value (stream-first (descending-triangle-in-sma-20-slope i)))] 46 | [sma-50 (dv-value (stream-first (descending-triangle-in-sma-50 i)))] 47 | [sma-50-slope (dv-value (stream-first (descending-triangle-in-sma-50-slope i)))] 48 | [satr (dv-value (stream-first (descending-triangle-in-satr-50 i)))] 49 | [dc-25-high (dv-value (stream-first (descending-triangle-in-dc-25-high i)))] 50 | [dc-25-low (dv-value (stream-first (descending-triangle-in-dc-25-low i)))] 51 | [dc-25-prev-high (dv-value (stream-first (descending-triangle-in-dc-25-prev-high i)))] 52 | [dc-25-prev-low (dv-value (stream-first (descending-triangle-in-dc-25-prev-low i)))]) 53 | ; (displayln t) 54 | ; (displayln p) 55 | ; (displayln h) 56 | ; (printf "~a ~a ~a ~a ~a ~a ~a ~a ~a ~a\n" date open high low close sma-20 sma-50 satr dc-high dc-low) 57 | (cond 58 | ; found satisfactory conditions for entry for the first time 59 | [(and (null? t) 60 | (null? p) 61 | (< satr (* close 4/100)) 62 | (< sma-20 sma-50) 63 | (> 0 sma-50-slope) 64 | (< close sma-20) 65 | (> 0 sma-20-slope) 66 | (< close (+ dc-25-low (* satr 4/2))) 67 | (< dc-25-low dc-25-prev-low) 68 | (< dc-25-prev-low (* dc-25-low 101/100)) 69 | (< (+ dc-25-high (* (- dc-25-high dc-25-low) 1/2)) dc-25-prev-high)) 70 | (let ([new-test (test 20 71 | (- dc-25-low 5/100) 72 | (+ dc-25-low (* satr 2)) 73 | (- dc-25-low (* satr 4)))]) 74 | (descending-triangle new-test 75 | p 76 | (history (append (history-test h) 77 | (list (dv date new-test))) 78 | (history-trade h)) 79 | (descending-triangle-in-drop-1 i)))] 80 | ; satisfactory conditions no longer exist for entry 81 | [(and (not (null? t)) 82 | (null? p) 83 | (or (>= open (test-stop t)) 84 | (>= high (test-stop t)) 85 | (>= low (test-stop t)) 86 | (>= close (test-stop t)))) 87 | (descending-triangle null p h (descending-triangle-in-drop-1 i))] 88 | ; satisfactory conditions exist for entry and open price leads to execution 89 | [(and (not (null? t)) 90 | (null? p) 91 | (< open (test-entry t))) 92 | (descending-triangle t (position open -1) 93 | (history (history-test h) 94 | (append (history-trade h) (list (trade date open -1 t)))) 95 | (descending-triangle-in-drop-1 i))] 96 | ; satisfactory conditions exist for entry and price range leads to execution 97 | [(and (not (null? t)) 98 | (null? p) 99 | (>= open (test-entry t)) 100 | (>= high (test-entry t)) 101 | (<= low (test-entry t))) 102 | (descending-triangle t 103 | (position (test-entry t) -1) 104 | (history (history-test h) 105 | (append (history-trade h) (list (trade date (test-entry t) -1 t)))) 106 | (descending-triangle-in-drop-1 i))] 107 | ; have position and open above stop 108 | [(and (not (null? p)) 109 | (>= open (test-stop t))) 110 | (descending-triangle null null 111 | (history (history-test h) 112 | (append (history-trade h) (list (trade date open 1 t)))) 113 | (descending-triangle-in-drop-1 i))] 114 | ; have position and price range above stop 115 | [(and (not (null? p)) 116 | (< open (test-stop t)) 117 | (>= high (test-stop t)) 118 | (<= low (test-stop t))) 119 | (descending-triangle null null 120 | (history (history-test h) 121 | (append (history-trade h) (list (trade date (test-stop t) 1 t)))) 122 | (descending-triangle-in-drop-1 i))] 123 | ; have position and both parts of open/close below target and stop 124 | [(and (not (null? p)) 125 | (< open (test-target t)) 126 | (< close (test-target t)) 127 | (< open (test-stop t)) 128 | (< close (test-stop t))) 129 | (let ([new-test (test (test-timeframe t) 130 | (test-entry t) 131 | (max open close) 132 | (test-target t))]) 133 | (descending-triangle new-test 134 | p 135 | (history (append (history-test h) 136 | (list (dv date new-test))) 137 | (history-trade h)) 138 | (descending-triangle-in-drop-1 i)))] 139 | ; have position and timeframe has ended 140 | [(and (not (null? p)) 141 | (= 0 (test-timeframe t))) 142 | (descending-triangle null null 143 | (history (history-test h) 144 | (append (history-trade h) (list (trade date close 1 t)))) 145 | (descending-triangle-in-drop-1 i))] 146 | ; have position and should move stop closer to close 147 | [(and (not (null? p)) 148 | (< (* 3 satr) (- (test-stop t) high))) 149 | (let ([new-test (test (- (test-timeframe t) 1) 150 | (test-entry t) 151 | (- (test-stop t) satr) ; (+ close (* 2 satr)) 152 | (test-target t))]) 153 | (descending-triangle new-test 154 | p 155 | (history (append (history-test h) 156 | (list (dv date new-test))) 157 | (history-trade h)) 158 | (descending-triangle-in-drop-1 i)))] 159 | ; have position and can do nothing 160 | [(not (null? p)) 161 | (descending-triangle (test-timeframe-minus-1 t) p h (descending-triangle-in-drop-1 i))] 162 | ; have no position and can do nothing 163 | [else (descending-triangle t p h (descending-triangle-in-drop-1 i))])))) 164 | 165 | (define (descending-triangle-in-drop-1 atid) 166 | (descending-triangle-in (stream-rest (descending-triangle-in-dohlc atid)) 167 | (stream-rest (descending-triangle-in-sma-20 atid)) 168 | (stream-rest (descending-triangle-in-sma-20-slope atid)) 169 | (stream-rest (descending-triangle-in-sma-50 atid)) 170 | (stream-rest (descending-triangle-in-sma-50-slope atid)) 171 | (stream-rest (descending-triangle-in-satr-50 atid)) 172 | (stream-rest (descending-triangle-in-dc-25-high atid)) 173 | (stream-rest (descending-triangle-in-dc-25-low atid)) 174 | (stream-rest (descending-triangle-in-dc-25-prev-high atid)) 175 | (stream-rest (descending-triangle-in-dc-25-prev-low atid)))) 176 | 177 | (define (descending-triangle-execution dohlc-list) 178 | (let*-values ([(dohlc-vector) (list->vector dohlc-list)] 179 | [(sma-20) (simple-moving-average dohlc-vector 20)] 180 | [(sma-20-slope) (delta sma-20 50)] 181 | [(sma-50) (simple-moving-average dohlc-vector 50)] 182 | [(sma-50-slope) (delta sma-50 50)] 183 | [(satr-50) (simple-average-true-range dohlc-vector 50)] 184 | [(dc-25-high dc-25-low) (donchian-channel dohlc-vector 25)] 185 | [(dc-25-prev-high dc-25-prev-low) (values (shift dc-25-high 25) (shift dc-25-low 25))] 186 | [(min-length) (min (vector-length dohlc-vector) 187 | (vector-length sma-20) 188 | (vector-length sma-20-slope) 189 | (vector-length sma-50) 190 | (vector-length sma-50-slope) 191 | (vector-length satr-50) 192 | (vector-length dc-25-high) 193 | (vector-length dc-25-low) 194 | (vector-length dc-25-prev-high) 195 | (vector-length dc-25-prev-low))]) 196 | (descending-triangle null null 197 | (history (list) (list)) 198 | (descending-triangle-in (sequence->stream (vector-take-right dohlc-vector min-length)) 199 | (sequence->stream (vector-take-right sma-20 min-length)) 200 | (sequence->stream (vector-take-right sma-20-slope min-length)) 201 | (sequence->stream (vector-take-right sma-50 min-length)) 202 | (sequence->stream (vector-take-right sma-50-slope min-length)) 203 | (sequence->stream (vector-take-right satr-50 min-length)) 204 | (sequence->stream (vector-take-right dc-25-high min-length)) 205 | (sequence->stream (vector-take-right dc-25-low min-length)) 206 | (sequence->stream (vector-take-right dc-25-prev-high min-length)) 207 | (sequence->stream (vector-take-right dc-25-prev-low min-length)))))) 208 | -------------------------------------------------------------------------------- /strategy/high-base.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require racket/stream 4 | racket/vector 5 | "../structs.rkt" 6 | "../technical-indicators.rkt") 7 | 8 | (provide high-base-execution) 9 | 10 | (struct high-base-in 11 | (dohlc 12 | sma-20 13 | sma-20-slope 14 | sma-50 15 | sma-50-slope 16 | satr-50 17 | dc-10-high 18 | dc-10-low 19 | dc-50-high 20 | dc-50-low) 21 | #:transparent) 22 | 23 | (define (high-base-in-drop-1 lbi) 24 | (high-base-in (stream-rest (high-base-in-dohlc lbi)) 25 | (stream-rest (high-base-in-sma-20 lbi)) 26 | (stream-rest (high-base-in-sma-20-slope lbi)) 27 | (stream-rest (high-base-in-sma-50 lbi)) 28 | (stream-rest (high-base-in-sma-50-slope lbi)) 29 | (stream-rest (high-base-in-satr-50 lbi)) 30 | (stream-rest (high-base-in-dc-10-high lbi)) 31 | (stream-rest (high-base-in-dc-10-low lbi)) 32 | (stream-rest (high-base-in-dc-50-high lbi)) 33 | (stream-rest (high-base-in-dc-50-low lbi)))) 34 | 35 | (define (high-base t ; timeframe entry stop target 36 | p ; position 37 | h ; history 38 | i) ; market data inputs 39 | (if (or (stream-empty? (high-base-in-dohlc i)) 40 | (stream-empty? (high-base-in-sma-20 i)) 41 | (stream-empty? (high-base-in-sma-20-slope i)) 42 | (stream-empty? (high-base-in-sma-50 i)) 43 | (stream-empty? (high-base-in-sma-50-slope i)) 44 | (stream-empty? (high-base-in-satr-50 i)) 45 | (stream-empty? (high-base-in-dc-10-high i)) 46 | (stream-empty? (high-base-in-dc-10-low i)) 47 | (stream-empty? (high-base-in-dc-50-high i)) 48 | (stream-empty? (high-base-in-dc-50-low i))) 49 | h 50 | 51 | (let ([date (dohlc-date (stream-first (high-base-in-dohlc i)))] 52 | [open (dohlc-open (stream-first (high-base-in-dohlc i)))] 53 | [high (dohlc-high (stream-first (high-base-in-dohlc i)))] 54 | [low (dohlc-low (stream-first (high-base-in-dohlc i)))] 55 | [close (dohlc-close (stream-first (high-base-in-dohlc i)))] 56 | [sma-20 (dv-value (stream-first (high-base-in-sma-20 i)))] 57 | [sma-20-slope (dv-value (stream-first (high-base-in-sma-20-slope i)))] 58 | [sma-50 (dv-value (stream-first (high-base-in-sma-50 i)))] 59 | [sma-50-slope (dv-value (stream-first (high-base-in-sma-50-slope i)))] 60 | [satr (dv-value (stream-first (high-base-in-satr-50 i)))] 61 | [dc-10-high (dv-value (stream-first (high-base-in-dc-10-high i)))] 62 | [dc-10-low (dv-value (stream-first (high-base-in-dc-10-low i)))] 63 | [dc-50-high (dv-value (stream-first (high-base-in-dc-50-high i)))] 64 | [dc-50-low (dv-value (stream-first (high-base-in-dc-50-low i)))]) 65 | ; (displayln t) 66 | ; (displayln p) 67 | ; (displayln h) 68 | ; (printf "~a ~a ~a ~a ~a ~a ~a ~a ~a ~a\n" date open high low close sma-20 sma-50 satr dc-high dc-low) 69 | (cond 70 | ; found satisfactory conditions for entry for the first time 71 | [(and (null? t) 72 | (null? p) 73 | (< satr (* close 4/100)) 74 | (> sma-20 sma-50) 75 | (< 0 sma-50-slope) 76 | (> close sma-20) 77 | (< 0 sma-20-slope) 78 | (< (- dc-10-high dc-10-low) (* satr 4/2)) 79 | (< dc-50-high (+ dc-10-high (/ satr 5)))) 80 | (let ([new-test (test 20 81 | (+ dc-10-high 5/100) 82 | (- dc-10-high (* satr 2)) 83 | (+ dc-10-high (* satr 4)))]) 84 | (high-base new-test 85 | p 86 | (history (append (history-test h) 87 | (list (dv date new-test))) 88 | (history-trade h)) 89 | (high-base-in-drop-1 i)))] 90 | ; satisfactory conditions no longer exist for entry 91 | [(and (not (null? t)) 92 | (null? p) 93 | (or (<= open (test-stop t)) 94 | (<= high (test-stop t)) 95 | (<= low (test-stop t)) 96 | (<= close (test-stop t)))) 97 | (high-base null p h (high-base-in-drop-1 i))] 98 | ; satisfactory conditions exist for entry and open price leads to execution 99 | [(and (not (null? t)) 100 | (null? p) 101 | (>= open (test-entry t))) 102 | (high-base t (position open 1) 103 | (history (history-test h) 104 | (append (history-trade h) (list (trade date open 1 t)))) 105 | (high-base-in-drop-1 i))] 106 | ; satisfactory conditions exist for entry and price range leads to execution 107 | [(and (not (null? t)) 108 | (null? p) 109 | (<= open (test-entry t)) 110 | (>= high (test-entry t)) 111 | (<= low (test-entry t))) 112 | (high-base t 113 | (position (test-entry t) 1) 114 | (history (history-test h) 115 | (append (history-trade h) (list (trade date (test-entry t) 1 t)))) 116 | (high-base-in-drop-1 i))] 117 | ; have position and open below stop 118 | [(and (not (null? p)) 119 | (<= open (test-stop t))) 120 | (high-base null null 121 | (history (history-test h) 122 | (append (history-trade h) (list (trade date open -1 t)))) 123 | (high-base-in-drop-1 i))] 124 | ; have position and price range above stop 125 | [(and (not (null? p)) 126 | (> open (test-stop t)) 127 | (>= high (test-stop t)) 128 | (<= low (test-stop t))) 129 | (high-base null null 130 | (history (history-test h) 131 | (append (history-trade h) (list (trade date (test-stop t) -1 t)))) 132 | (high-base-in-drop-1 i))] 133 | ; have position and both parts of open/close above target and stop 134 | [(and (not (null? p)) 135 | (> open (test-target t)) 136 | (> close (test-target t)) 137 | (> open (test-stop t)) 138 | (> close (test-stop t))) 139 | (let ([new-test (test (test-timeframe t) 140 | (test-entry t) 141 | (min open close) 142 | (test-target t))]) 143 | (high-base new-test 144 | p 145 | (history (append (history-test h) 146 | (list (dv date new-test))) 147 | (history-trade h)) 148 | (high-base-in-drop-1 i)))] 149 | ; have position and timeframe has ended 150 | [(and (not (null? p)) 151 | (= 0 (test-timeframe t))) 152 | (high-base null null 153 | (history (history-test h) 154 | (append (history-trade h) (list (trade date close -1 t)))) 155 | (high-base-in-drop-1 i))] 156 | ; have position and should move stop closer to close 157 | [(and (not (null? p)) 158 | (< (* 3 satr) (- low (test-stop t)))) 159 | (let ([new-test (test (- (test-timeframe t) 1) 160 | (test-entry t) 161 | (+ (test-stop t) satr) 162 | (test-target t))]) 163 | (high-base new-test 164 | p 165 | (history (append (history-test h) 166 | (list (dv date new-test))) 167 | (history-trade h)) 168 | (high-base-in-drop-1 i)))] 169 | ; have position and can do nothing 170 | [(not (null? p)) 171 | (high-base (test-timeframe-minus-1 t) p h (high-base-in-drop-1 i))] 172 | ; have no position and can do nothing 173 | [else (high-base t p h (high-base-in-drop-1 i))])))) 174 | 175 | (define (high-base-execution dohlc-list) 176 | (let*-values ([(dohlc-vector) (list->vector dohlc-list)] 177 | [(sma-20) (simple-moving-average dohlc-vector 20)] 178 | [(sma-20-slope) (delta sma-20 50)] 179 | [(sma-50) (simple-moving-average dohlc-vector 50)] 180 | [(sma-50-slope) (delta sma-50 50)] 181 | [(satr-50) (simple-average-true-range dohlc-vector 50)] 182 | [(dc-10-high dc-10-low) (donchian-channel dohlc-vector 10)] 183 | [(dc-50-high dc-50-low) (donchian-channel dohlc-vector 50)] 184 | [(min-length) (min (vector-length dohlc-vector) 185 | (vector-length sma-20) 186 | (vector-length sma-20-slope) 187 | (vector-length sma-50) 188 | (vector-length sma-50-slope) 189 | (vector-length satr-50) 190 | (vector-length dc-10-high) 191 | (vector-length dc-10-low) 192 | (vector-length dc-50-high) 193 | (vector-length dc-50-low))]) 194 | (high-base null null 195 | (history (list) (list)) 196 | (high-base-in (sequence->stream (vector-take-right dohlc-vector min-length)) 197 | (sequence->stream (vector-take-right sma-20 min-length)) 198 | (sequence->stream (vector-take-right sma-20-slope min-length)) 199 | (sequence->stream (vector-take-right sma-50 min-length)) 200 | (sequence->stream (vector-take-right sma-50-slope min-length)) 201 | (sequence->stream (vector-take-right satr-50 min-length)) 202 | (sequence->stream (vector-take-right dc-10-high min-length)) 203 | (sequence->stream (vector-take-right dc-10-low min-length)) 204 | (sequence->stream (vector-take-right dc-50-high min-length)) 205 | (sequence->stream (vector-take-right dc-50-low min-length)))))) 206 | -------------------------------------------------------------------------------- /strategy/low-base.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require racket/stream 4 | racket/vector 5 | "../structs.rkt" 6 | "../technical-indicators.rkt") 7 | 8 | (provide low-base-execution) 9 | 10 | (struct low-base-in 11 | (dohlc 12 | sma-20 13 | sma-20-slope 14 | sma-50 15 | sma-50-slope 16 | satr-50 17 | dc-10-high 18 | dc-10-low 19 | dc-50-high 20 | dc-50-low) 21 | #:transparent) 22 | 23 | (define (low-base-in-drop-1 lbi) 24 | (low-base-in (stream-rest (low-base-in-dohlc lbi)) 25 | (stream-rest (low-base-in-sma-20 lbi)) 26 | (stream-rest (low-base-in-sma-20-slope lbi)) 27 | (stream-rest (low-base-in-sma-50 lbi)) 28 | (stream-rest (low-base-in-sma-50-slope lbi)) 29 | (stream-rest (low-base-in-satr-50 lbi)) 30 | (stream-rest (low-base-in-dc-10-high lbi)) 31 | (stream-rest (low-base-in-dc-10-low lbi)) 32 | (stream-rest (low-base-in-dc-50-high lbi)) 33 | (stream-rest (low-base-in-dc-50-low lbi)))) 34 | 35 | (define (low-base t ; timeframe entry stop target 36 | p ; position 37 | h ; history 38 | i) ; market data inputs 39 | (if (or (stream-empty? (low-base-in-dohlc i)) 40 | (stream-empty? (low-base-in-sma-20 i)) 41 | (stream-empty? (low-base-in-sma-20-slope i)) 42 | (stream-empty? (low-base-in-sma-50 i)) 43 | (stream-empty? (low-base-in-sma-50-slope i)) 44 | (stream-empty? (low-base-in-satr-50 i)) 45 | (stream-empty? (low-base-in-dc-10-high i)) 46 | (stream-empty? (low-base-in-dc-10-low i)) 47 | (stream-empty? (low-base-in-dc-50-high i)) 48 | (stream-empty? (low-base-in-dc-50-low i))) 49 | h 50 | 51 | (let ([date (dohlc-date (stream-first (low-base-in-dohlc i)))] 52 | [open (dohlc-open (stream-first (low-base-in-dohlc i)))] 53 | [high (dohlc-high (stream-first (low-base-in-dohlc i)))] 54 | [low (dohlc-low (stream-first (low-base-in-dohlc i)))] 55 | [close (dohlc-close (stream-first (low-base-in-dohlc i)))] 56 | [sma-20 (dv-value (stream-first (low-base-in-sma-20 i)))] 57 | [sma-20-slope (dv-value (stream-first (low-base-in-sma-20-slope i)))] 58 | [sma-50 (dv-value (stream-first (low-base-in-sma-50 i)))] 59 | [sma-50-slope (dv-value (stream-first (low-base-in-sma-50-slope i)))] 60 | [satr (dv-value (stream-first (low-base-in-satr-50 i)))] 61 | [dc-10-high (dv-value (stream-first (low-base-in-dc-10-high i)))] 62 | [dc-10-low (dv-value (stream-first (low-base-in-dc-10-low i)))] 63 | [dc-50-high (dv-value (stream-first (low-base-in-dc-50-high i)))] 64 | [dc-50-low (dv-value (stream-first (low-base-in-dc-50-low i)))]) 65 | ; (displayln t) 66 | ; (displayln p) 67 | ; (displayln h) 68 | ; (printf "~a ~a ~a ~a ~a ~a ~a ~a ~a ~a\n" date open high low close sma-20 sma-50 satr dc-high dc-low) 69 | (cond 70 | ; found satisfactory conditions for entry for the first time 71 | [(and (null? t) 72 | (null? p) 73 | (< satr (* close 4/100)) 74 | (< sma-20 sma-50) 75 | (> 0 sma-50-slope) 76 | (< close sma-20) 77 | (> 0 sma-20-slope) 78 | (< (- dc-10-high dc-10-low) (* satr 4/2)) 79 | (> dc-50-low (- dc-10-low (/ satr 5)))) 80 | (let ([new-test (test 20 81 | (- dc-10-low 5/100) 82 | (+ dc-10-low (* satr 2)) 83 | (- dc-10-low (* satr 4)))]) 84 | (low-base new-test 85 | p 86 | (history (append (history-test h) 87 | (list (dv date new-test))) 88 | (history-trade h)) 89 | (low-base-in-drop-1 i)))] 90 | ; satisfactory conditions no longer exist for entry 91 | [(and (not (null? t)) 92 | (null? p) 93 | (or (>= open (test-stop t)) 94 | (>= high (test-stop t)) 95 | (>= low (test-stop t)) 96 | (>= close (test-stop t)))) 97 | (low-base null p h (low-base-in-drop-1 i))] 98 | ; satisfactory conditions exist for entry and open price leads to execution 99 | [(and (not (null? t)) 100 | (null? p) 101 | (< open (test-entry t))) 102 | (low-base t (position open -1) 103 | (history (history-test h) 104 | (append (history-trade h) (list (trade date open -1 t)))) 105 | (low-base-in-drop-1 i))] 106 | ; satisfactory conditions exist for entry and price range leads to execution 107 | [(and (not (null? t)) 108 | (null? p) 109 | (>= open (test-entry t)) 110 | (>= high (test-entry t)) 111 | (<= low (test-entry t))) 112 | (low-base t 113 | (position (test-entry t) -1) 114 | (history (history-test h) 115 | (append (history-trade h) (list (trade date (test-entry t) -1 t)))) 116 | (low-base-in-drop-1 i))] 117 | ; have position and open above stop 118 | [(and (not (null? p)) 119 | (>= open (test-stop t))) 120 | (low-base null null 121 | (history (history-test h) 122 | (append (history-trade h) (list (trade date open 1 t)))) 123 | (low-base-in-drop-1 i))] 124 | ; have position and price range above stop 125 | [(and (not (null? p)) 126 | (< open (test-stop t)) 127 | (>= high (test-stop t)) 128 | (<= low (test-stop t))) 129 | (low-base null null 130 | (history (history-test h) 131 | (append (history-trade h) (list (trade date (test-stop t) 1 t)))) 132 | (low-base-in-drop-1 i))] 133 | ; have position and both parts of open/close below target and stop 134 | [(and (not (null? p)) 135 | (< open (test-target t)) 136 | (< close (test-target t)) 137 | (< open (test-stop t)) 138 | (< close (test-stop t))) 139 | (let ([new-test (test (test-timeframe t) 140 | (test-entry t) 141 | (max open close) 142 | (test-target t))]) 143 | (low-base new-test 144 | p 145 | (history (append (history-test h) 146 | (list (dv date new-test))) 147 | (history-trade h)) 148 | (low-base-in-drop-1 i)))] 149 | ; have position and timeframe has ended 150 | [(and (not (null? p)) 151 | (= 0 (test-timeframe t))) 152 | (low-base null null 153 | (history (history-test h) 154 | (append (history-trade h) (list (trade date close 1 t)))) 155 | (low-base-in-drop-1 i))] 156 | ; have position and should move stop closer to close 157 | [(and (not (null? p)) 158 | (< (* 3 satr) (- (test-stop t) high))) 159 | (let ([new-test (test (- (test-timeframe t) 1) 160 | (test-entry t) 161 | (- (test-stop t) satr) ; (+ close (* 2 satr)) 162 | (test-target t))]) 163 | (low-base new-test 164 | p 165 | (history (append (history-test h) 166 | (list (dv date new-test))) 167 | (history-trade h)) 168 | (low-base-in-drop-1 i)))] 169 | ; have position and can do nothing 170 | [(not (null? p)) 171 | (low-base (test-timeframe-minus-1 t) p h (low-base-in-drop-1 i))] 172 | ; have no position and can do nothing 173 | [else (low-base t p h (low-base-in-drop-1 i))])))) 174 | 175 | (define (low-base-execution dohlc-list) 176 | (let*-values ([(dohlc-vector) (list->vector dohlc-list)] 177 | [(sma-20) (simple-moving-average dohlc-vector 20)] 178 | [(sma-20-slope) (delta sma-20 50)] 179 | [(sma-50) (simple-moving-average dohlc-vector 50)] 180 | [(sma-50-slope) (delta sma-50 50)] 181 | [(satr-50) (simple-average-true-range dohlc-vector 50)] 182 | [(dc-10-high dc-10-low) (donchian-channel dohlc-vector 10)] 183 | [(dc-50-high dc-50-low) (donchian-channel dohlc-vector 50)] 184 | [(min-length) (min (vector-length dohlc-vector) 185 | (vector-length sma-20) 186 | (vector-length sma-20-slope) 187 | (vector-length sma-50) 188 | (vector-length sma-50-slope) 189 | (vector-length satr-50) 190 | (vector-length dc-10-high) 191 | (vector-length dc-10-low) 192 | (vector-length dc-50-high) 193 | (vector-length dc-50-low))]) 194 | (low-base null null 195 | (history (list) (list)) 196 | (low-base-in (sequence->stream (vector-take-right dohlc-vector min-length)) 197 | (sequence->stream (vector-take-right sma-20 min-length)) 198 | (sequence->stream (vector-take-right sma-20-slope min-length)) 199 | (sequence->stream (vector-take-right sma-50 min-length)) 200 | (sequence->stream (vector-take-right sma-50-slope min-length)) 201 | (sequence->stream (vector-take-right satr-50 min-length)) 202 | (sequence->stream (vector-take-right dc-10-high min-length)) 203 | (sequence->stream (vector-take-right dc-10-low min-length)) 204 | (sequence->stream (vector-take-right dc-50-high min-length)) 205 | (sequence->stream (vector-take-right dc-50-low min-length)))))) 206 | -------------------------------------------------------------------------------- /strategy/range-pullback.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require racket/stream 4 | racket/vector 5 | "../structs.rkt" 6 | "../technical-indicators.rkt") 7 | 8 | (provide range-pullback-execution) 9 | 10 | (struct range-pullback-in 11 | (dohlc 12 | sma-50 13 | sma-50-slope 14 | satr-50 15 | dc-25-high 16 | dc-25-low 17 | dc-50-high 18 | dc-50-low 19 | csr-3) 20 | #:transparent) 21 | 22 | (define (range-pullback t ; timeframe entry stop target 23 | p ; position 24 | h ; history 25 | i) ; market data inputs 26 | (if (or (stream-empty? (range-pullback-in-dohlc i)) 27 | (stream-empty? (range-pullback-in-sma-50 i)) 28 | (stream-empty? (range-pullback-in-sma-50-slope i)) 29 | (stream-empty? (range-pullback-in-satr-50 i)) 30 | (stream-empty? (range-pullback-in-dc-25-high i)) 31 | (stream-empty? (range-pullback-in-dc-25-low i)) 32 | (stream-empty? (range-pullback-in-dc-50-high i)) 33 | (stream-empty? (range-pullback-in-dc-50-low i)) 34 | (stream-empty? (range-pullback-in-csr-3 i))) 35 | h 36 | 37 | (let ([date (dohlc-date (stream-first (range-pullback-in-dohlc i)))] 38 | [open (dohlc-open (stream-first (range-pullback-in-dohlc i)))] 39 | [high (dohlc-high (stream-first (range-pullback-in-dohlc i)))] 40 | [low (dohlc-low (stream-first (range-pullback-in-dohlc i)))] 41 | [close (dohlc-close (stream-first (range-pullback-in-dohlc i)))] 42 | [sma-50 (dv-value (stream-first (range-pullback-in-sma-50 i)))] 43 | [sma-50-slope (dv-value (stream-first (range-pullback-in-sma-50-slope i)))] 44 | [satr (dv-value (stream-first (range-pullback-in-satr-50 i)))] 45 | [dc-25-high (dv-value (stream-first (range-pullback-in-dc-25-high i)))] 46 | [dc-25-low (dv-value (stream-first (range-pullback-in-dc-25-low i)))] 47 | [dc-50-high (dv-value (stream-first (range-pullback-in-dc-50-high i)))] 48 | [dc-50-low (dv-value (stream-first (range-pullback-in-dc-50-low i)))] 49 | [csr-3 (dv-value (stream-first (range-pullback-in-csr-3 i)))]) 50 | ; (displayln t) 51 | ; (displayln p) 52 | ; (displayln h) 53 | ; (printf "~a ~a ~a ~a ~a ~a ~a ~a ~a ~a\n" date open high low close sma-20 sma-50 satr dc-high dc-low) 54 | (cond 55 | ; found satisfactory conditions for entry for the first time 56 | [(and (null? t) 57 | (null? p) 58 | (< satr (* close 4/100)) 59 | (> sma-50 dc-50-low) ; (+ dc-25-low satr)) 60 | (< sma-50 dc-50-high) ; (- dc-25-high satr)) 61 | (> sma-50-slope 0) 62 | (> (- dc-25-high dc-25-low) (* satr 3)) 63 | (< (- dc-25-high dc-25-low) (* satr 6)) 64 | (> dc-25-low (* dc-50-low 101/100)) 65 | (< dc-25-high (* dc-50-high 99/100)) 66 | (> (- dc-25-high (/ (- dc-25-high dc-25-low) 2)) high) 67 | (<= csr-3 -2)) 68 | (let ([new-test (test 20 69 | (+ high 5/100) 70 | (- high (* satr 1)) 71 | (+ high (* satr 2)))]) 72 | (range-pullback new-test 73 | p 74 | (history (append (history-test h) 75 | (list (dv date new-test))) 76 | (history-trade h)) 77 | (range-pullback-in-drop-1 i)))] 78 | ; satisfactory conditions no longer exist for entry 79 | [(and (not (null? t)) 80 | (null? p) 81 | (or (<= open (test-stop t)) 82 | (<= high (test-stop t)) 83 | (<= low (test-stop t)) 84 | (<= close (test-stop t)))) 85 | (range-pullback null p h (range-pullback-in-drop-1 i))] 86 | ; satisfactory conditions exist for entry and open price leads to execution 87 | [(and (not (null? t)) 88 | (null? p) 89 | (>= open (test-entry t))) 90 | (range-pullback t (position open 1) 91 | (history (history-test h) 92 | (append (history-trade h) (list (trade date open 1 t)))) 93 | (range-pullback-in-drop-1 i))] 94 | ; satisfactory conditions exist for entry and price range leads to execution 95 | [(and (not (null? t)) 96 | (null? p) 97 | (<= open (test-entry t)) 98 | (>= high (test-entry t)) 99 | (<= low (test-entry t))) 100 | (range-pullback t 101 | (position (test-entry t) 1) 102 | (history (history-test h) 103 | (append (history-trade h) (list (trade date (test-entry t) 1 t)))) 104 | (range-pullback-in-drop-1 i))] 105 | ; have position and open below stop 106 | [(and (not (null? p)) 107 | (<= open (test-stop t))) 108 | (range-pullback null null 109 | (history (history-test h) 110 | (append (history-trade h) (list (trade date open -1 t)))) 111 | (range-pullback-in-drop-1 i))] 112 | ; have position and price range above stop 113 | [(and (not (null? p)) 114 | (> open (test-stop t)) 115 | (>= high (test-stop t)) 116 | (<= low (test-stop t))) 117 | (range-pullback null null 118 | (history (history-test h) 119 | (append (history-trade h) (list (trade date (test-stop t) -1 t)))) 120 | (range-pullback-in-drop-1 i))] 121 | ; have position and both parts of open/close above target and stop 122 | [(and (not (null? p)) 123 | (> open (test-target t)) 124 | (> close (test-target t)) 125 | (> open (test-stop t)) 126 | (> close (test-stop t))) 127 | (let ([new-test (test (test-timeframe t) 128 | (test-entry t) 129 | (min open close) 130 | (test-target t))]) 131 | (range-pullback new-test 132 | p 133 | (history (append (history-test h) 134 | (list (dv date new-test))) 135 | (history-trade h)) 136 | (range-pullback-in-drop-1 i)))] 137 | ; have position and timeframe has ended 138 | [(and (not (null? p)) 139 | (= 0 (test-timeframe t))) 140 | (range-pullback null null 141 | (history (history-test h) 142 | (append (history-trade h) (list (trade date close -1 t)))) 143 | (range-pullback-in-drop-1 i))] 144 | ; have position and should move stop closer to close 145 | [(and (not (null? p)) 146 | (< (* 3 satr) (- low (test-stop t)))) 147 | (let ([new-test (test (- (test-timeframe t) 1) 148 | (test-entry t) 149 | (+ (test-stop t) satr) 150 | (test-target t))]) 151 | (range-pullback new-test 152 | p 153 | (history (append (history-test h) 154 | (list (dv date new-test))) 155 | (history-trade h)) 156 | (range-pullback-in-drop-1 i)))] 157 | ; have position and can do nothing 158 | [(not (null? p)) 159 | (range-pullback (test-timeframe-minus-1 t) p h (range-pullback-in-drop-1 i))] 160 | ; have no position and can do nothing 161 | [else (range-pullback t p h (range-pullback-in-drop-1 i))])))) 162 | 163 | (define (range-pullback-in-drop-1 rpi) 164 | (range-pullback-in (stream-rest (range-pullback-in-dohlc rpi)) 165 | (stream-rest (range-pullback-in-sma-50 rpi)) 166 | (stream-rest (range-pullback-in-sma-50-slope rpi)) 167 | (stream-rest (range-pullback-in-satr-50 rpi)) 168 | (stream-rest (range-pullback-in-dc-25-high rpi)) 169 | (stream-rest (range-pullback-in-dc-25-low rpi)) 170 | (stream-rest (range-pullback-in-dc-50-high rpi)) 171 | (stream-rest (range-pullback-in-dc-50-low rpi)) 172 | (stream-rest (range-pullback-in-csr-3 rpi)))) 173 | 174 | (define (range-pullback-execution dohlc-list) 175 | (let*-values ([(dohlc-vector) (list->vector dohlc-list)] 176 | [(sma-50) (simple-moving-average dohlc-vector 50)] 177 | [(sma-50-slope) (delta sma-50 50)] 178 | [(satr-50) (simple-average-true-range dohlc-vector 50)] 179 | [(dc-25-high dc-25-low) (donchian-channel dohlc-vector 25)] 180 | [(dc-50-high dc-50-low) (donchian-channel dohlc-vector 50)] 181 | [(csr-3) (crow-soldier-reversal dohlc-vector 3)] 182 | [(min-length) (min (vector-length dohlc-vector) 183 | (vector-length sma-50) 184 | (vector-length sma-50-slope) 185 | (vector-length satr-50) 186 | (vector-length dc-25-high) 187 | (vector-length dc-25-low) 188 | (vector-length dc-50-high) 189 | (vector-length dc-50-low) 190 | (vector-length csr-3))]) 191 | (range-pullback null null 192 | (history (list) (list)) 193 | (range-pullback-in (sequence->stream (vector-take-right dohlc-vector min-length)) 194 | (sequence->stream (vector-take-right sma-50 min-length)) 195 | (sequence->stream (vector-take-right sma-50-slope min-length)) 196 | (sequence->stream (vector-take-right satr-50 min-length)) 197 | (sequence->stream (vector-take-right dc-25-high min-length)) 198 | (sequence->stream (vector-take-right dc-25-low min-length)) 199 | (sequence->stream (vector-take-right dc-50-high min-length)) 200 | (sequence->stream (vector-take-right dc-50-low min-length)) 201 | (sequence->stream (vector-take-right csr-3 min-length)))))) 202 | -------------------------------------------------------------------------------- /strategy/range-rally.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require racket/stream 4 | racket/vector 5 | "../structs.rkt" 6 | "../technical-indicators.rkt") 7 | 8 | (provide range-rally-execution) 9 | 10 | (struct range-rally-in 11 | (dohlc 12 | sma-50 13 | sma-50-slope 14 | satr-50 15 | dc-25-high 16 | dc-25-low 17 | dc-50-high 18 | dc-50-low 19 | csr-3) 20 | #:transparent) 21 | 22 | (define (range-rally t ; timeframe entry stop target 23 | p ; position 24 | h ; history 25 | i) ; market data inputs 26 | (if (or (stream-empty? (range-rally-in-dohlc i)) 27 | (stream-empty? (range-rally-in-sma-50 i)) 28 | (stream-empty? (range-rally-in-sma-50-slope i)) 29 | (stream-empty? (range-rally-in-satr-50 i)) 30 | (stream-empty? (range-rally-in-dc-25-high i)) 31 | (stream-empty? (range-rally-in-dc-25-low i)) 32 | (stream-empty? (range-rally-in-dc-50-high i)) 33 | (stream-empty? (range-rally-in-dc-50-low i)) 34 | (stream-empty? (range-rally-in-csr-3 i))) 35 | h 36 | 37 | (let ([date (dohlc-date (stream-first (range-rally-in-dohlc i)))] 38 | [open (dohlc-open (stream-first (range-rally-in-dohlc i)))] 39 | [high (dohlc-high (stream-first (range-rally-in-dohlc i)))] 40 | [low (dohlc-low (stream-first (range-rally-in-dohlc i)))] 41 | [close (dohlc-close (stream-first (range-rally-in-dohlc i)))] 42 | [sma-50 (dv-value (stream-first (range-rally-in-sma-50 i)))] 43 | [sma-50-slope (dv-value (stream-first (range-rally-in-sma-50-slope i)))] 44 | [satr (dv-value (stream-first (range-rally-in-satr-50 i)))] 45 | [dc-25-high (dv-value (stream-first (range-rally-in-dc-25-high i)))] 46 | [dc-25-low (dv-value (stream-first (range-rally-in-dc-25-low i)))] 47 | [dc-50-high (dv-value (stream-first (range-rally-in-dc-50-high i)))] 48 | [dc-50-low (dv-value (stream-first (range-rally-in-dc-50-low i)))] 49 | [csr-3 (dv-value (stream-first (range-rally-in-csr-3 i)))]) 50 | ; (displayln t) 51 | ; (displayln p) 52 | ; (displayln h) 53 | ; (printf "~a ~a ~a ~a ~a ~a ~a ~a ~a ~a\n" date open high low close sma-20 sma-50 satr dc-high dc-low) 54 | (cond 55 | ; found satisfactory conditions for entry for the first time 56 | [(and (null? t) 57 | (null? p) 58 | (< satr (* close 4/100)) 59 | (> sma-50 dc-50-low) ; (+ dc-25-low satr)) 60 | (< sma-50 dc-50-high) ; (- dc-25-high satr)) 61 | (< sma-50-slope 0) 62 | (> (- dc-50-high dc-50-low) (* satr 3)) 63 | (< (- dc-50-high dc-50-low) (* satr 6)) 64 | (> dc-25-low (* dc-50-low 101/100)) 65 | (< dc-25-high (* dc-50-high 99/100)) 66 | (< (+ dc-25-low (/ (- dc-25-high dc-25-low) 2)) low) 67 | (>= csr-3 2)) 68 | (let ([new-test (test 20 69 | (- low 5/100) 70 | (+ low (* satr 1)) 71 | (- low (* satr 2)))]) 72 | (range-rally new-test 73 | p 74 | (history (append (history-test h) 75 | (list (dv date new-test))) 76 | (history-trade h)) 77 | (range-rally-in-drop-1 i)))] 78 | ; satisfactory conditions no longer exist for entry 79 | [(and (not (null? t)) 80 | (null? p) 81 | (or (>= open (test-stop t)) 82 | (>= high (test-stop t)) 83 | (>= low (test-stop t)) 84 | (>= close (test-stop t)))) 85 | (range-rally null p h (range-rally-in-drop-1 i))] 86 | ; satisfactory conditions exist for entry and open price leads to execution 87 | [(and (not (null? t)) 88 | (null? p) 89 | (< open (test-entry t))) 90 | (range-rally t (position open -1) 91 | (history (history-test h) 92 | (append (history-trade h) (list (trade date open -1 t)))) 93 | (range-rally-in-drop-1 i))] 94 | ; satisfactory conditions exist for entry and price range leads to execution 95 | [(and (not (null? t)) 96 | (null? p) 97 | (>= open (test-entry t)) 98 | (>= high (test-entry t)) 99 | (<= low (test-entry t))) 100 | (range-rally t 101 | (position (test-entry t) -1) 102 | (history (history-test h) 103 | (append (history-trade h) (list (trade date (test-entry t) -1 t)))) 104 | (range-rally-in-drop-1 i))] 105 | ; have position and open above stop 106 | [(and (not (null? p)) 107 | (>= open (test-stop t))) 108 | (range-rally null null 109 | (history (history-test h) 110 | (append (history-trade h) (list (trade date open 1 t)))) 111 | (range-rally-in-drop-1 i))] 112 | ; have position and price range above stop 113 | [(and (not (null? p)) 114 | (< open (test-stop t)) 115 | (>= high (test-stop t)) 116 | (<= low (test-stop t))) 117 | (range-rally null null 118 | (history (history-test h) 119 | (append (history-trade h) (list (trade date (test-stop t) 1 t)))) 120 | (range-rally-in-drop-1 i))] 121 | ; have position and both parts of open/close below target and stop 122 | [(and (not (null? p)) 123 | (< open (test-target t)) 124 | (< close (test-target t)) 125 | (< open (test-stop t)) 126 | (< close (test-stop t))) 127 | (let ([new-test (test (test-timeframe t) 128 | (test-entry t) 129 | (max open close) 130 | (test-target t))]) 131 | (range-rally new-test 132 | p 133 | (history (append (history-test h) 134 | (list (dv date new-test))) 135 | (history-trade h)) 136 | (range-rally-in-drop-1 i)))] 137 | ; have position and timeframe has ended 138 | [(and (not (null? p)) 139 | (= 0 (test-timeframe t))) 140 | (range-rally null null 141 | (history (history-test h) 142 | (append (history-trade h) (list (trade date close 1 t)))) 143 | (range-rally-in-drop-1 i))] 144 | ; have position and should move stop closer to close 145 | [(and (not (null? p)) 146 | (< (* 3 satr) (- (test-stop t) high))) 147 | (let ([new-test (test (- (test-timeframe t) 1) 148 | (test-entry t) 149 | (- (test-stop t) satr) ; (+ close (* 2 satr)) 150 | (test-target t))]) 151 | (range-rally new-test 152 | p 153 | (history (append (history-test h) 154 | (list (dv date new-test))) 155 | (history-trade h)) 156 | (range-rally-in-drop-1 i)))] 157 | ; have position and can do nothing 158 | [(not (null? p)) 159 | (range-rally (test-timeframe-minus-1 t) p h (range-rally-in-drop-1 i))] 160 | ; have no position and can do nothing 161 | [else (range-rally t p h (range-rally-in-drop-1 i))])))) 162 | 163 | (define (range-rally-in-drop-1 rri) 164 | (range-rally-in (stream-rest (range-rally-in-dohlc rri)) 165 | (stream-rest (range-rally-in-sma-50 rri)) 166 | (stream-rest (range-rally-in-sma-50-slope rri)) 167 | (stream-rest (range-rally-in-satr-50 rri)) 168 | (stream-rest (range-rally-in-dc-25-high rri)) 169 | (stream-rest (range-rally-in-dc-25-low rri)) 170 | (stream-rest (range-rally-in-dc-50-high rri)) 171 | (stream-rest (range-rally-in-dc-50-low rri)) 172 | (stream-rest (range-rally-in-csr-3 rri)))) 173 | 174 | (define (range-rally-execution dohlc-list) 175 | (let*-values ([(dohlc-vector) (list->vector dohlc-list)] 176 | [(sma-50) (simple-moving-average dohlc-vector 50)] 177 | [(sma-50-slope) (delta sma-50 50)] 178 | [(satr-50) (simple-average-true-range dohlc-vector 50)] 179 | [(dc-25-high dc-25-low) (donchian-channel dohlc-vector 25)] 180 | [(dc-50-high dc-50-low) (donchian-channel dohlc-vector 50)] 181 | [(csr-3) (crow-soldier-reversal dohlc-vector 3)] 182 | [(min-length) (min (vector-length dohlc-vector) 183 | (vector-length sma-50) 184 | (vector-length sma-50-slope) 185 | (vector-length satr-50) 186 | (vector-length dc-25-high) 187 | (vector-length dc-25-low) 188 | (vector-length dc-50-high) 189 | (vector-length dc-50-low) 190 | (vector-length csr-3))]) 191 | (range-rally null null 192 | (history (list) (list)) 193 | (range-rally-in (sequence->stream (vector-take-right dohlc-vector min-length)) 194 | (sequence->stream (vector-take-right sma-50 min-length)) 195 | (sequence->stream (vector-take-right sma-50-slope min-length)) 196 | (sequence->stream (vector-take-right satr-50 min-length)) 197 | (sequence->stream (vector-take-right dc-25-high min-length)) 198 | (sequence->stream (vector-take-right dc-25-low min-length)) 199 | (sequence->stream (vector-take-right dc-50-high min-length)) 200 | (sequence->stream (vector-take-right dc-50-low min-length)) 201 | (sequence->stream (vector-take-right csr-3 min-length)))))) 202 | -------------------------------------------------------------------------------- /structs.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require racket/list 4 | racket/stream) ; needed for gen:stream 5 | 6 | (provide (struct-out dv) 7 | (struct-out dohlc) 8 | (struct-out test) 9 | test-timeframe-minus-1 10 | (struct-out trade) 11 | (struct-out position) 12 | (struct-out history)) 13 | 14 | (struct dv (date value) 15 | #:transparent 16 | #:methods gen:stream 17 | [(define (stream-empty? stream) 18 | (cond 19 | [(dv? stream) #f] 20 | [else (empty? stream)])) 21 | (define (stream-first stream) 22 | (cond 23 | [(dv? stream) (dv-date stream)] 24 | [else (first stream)])) 25 | (define (stream-rest stream) 26 | (cond 27 | [(dv? stream) (list (dv-value stream))] 28 | [else (rest stream)]))]) 29 | 30 | (struct dohlc (date open high low close) 31 | #:transparent 32 | #:methods gen:stream 33 | [(define (stream-empty? stream) 34 | (cond 35 | [(dohlc? stream) #f] 36 | [else (empty? stream)])) 37 | (define (stream-first stream) 38 | (cond 39 | [(dohlc? stream) (dohlc-date stream)] 40 | [else (first stream)])) 41 | (define (stream-rest stream) 42 | (cond 43 | [(dohlc? stream) (list (dohlc-open stream) 44 | (dohlc-high stream) 45 | (dohlc-low stream) 46 | (dohlc-close stream))] 47 | [else (rest stream)]))]) 48 | 49 | (struct test (timeframe entry stop target) 50 | #:transparent) 51 | 52 | (define (test-timeframe-minus-1 t) 53 | (test (- (test-timeframe t) 1) 54 | (test-entry t) 55 | (test-stop t) 56 | (test-target t))) 57 | 58 | (struct trade (date price amount test) 59 | #:transparent) 60 | 61 | (struct position (price amount) 62 | #:transparent) 63 | 64 | (struct history (test trade) 65 | #:transparent) 66 | -------------------------------------------------------------------------------- /technical-indicators.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require racket/sequence 4 | racket/vector 5 | "structs.rkt") 6 | 7 | (provide simple-moving-average 8 | simple-average-true-range 9 | donchian-channel 10 | delta 11 | shift 12 | crow-soldier-reversal) 13 | 14 | (define (vector-partition v period step) 15 | (if (> period (vector-length v)) (vector) 16 | (vector-append (vector (vector-take v period)) 17 | (vector-partition (vector-drop v step) period step)))) 18 | 19 | (define (simple-moving-average date-ohlc-vector period) 20 | (vector-map (λ (v) (dv (dohlc-date (vector-ref v (- period 1))) 21 | (/ (sequence-fold (λ (acc el) (+ acc (dohlc-close el))) 0 22 | (vector-take v period)) period))) 23 | (vector-partition date-ohlc-vector period 1))) 24 | 25 | (define (true-range high low previous-close) 26 | (max (- high low) 27 | (abs (- high previous-close)) 28 | (abs (- low previous-close)))) 29 | 30 | (define (simple-average-true-range date-ohlc-vector period) 31 | (let ([true-ranges (vector-map (λ (v) (dv (dohlc-date (vector-ref v 1)) 32 | (true-range (dohlc-high (vector-ref v 1)) 33 | (dohlc-low (vector-ref v 1)) 34 | (dohlc-close (vector-ref v 0))))) 35 | (vector-partition date-ohlc-vector 2 1))]) 36 | (vector-map (λ (v) (dv (dv-date (vector-ref v (- period 1))) 37 | (/ (sequence-fold (λ (acc el) (+ acc (dv-value el))) 0 38 | (vector-take v period)) period))) 39 | (vector-partition true-ranges period 1)))) 40 | 41 | (define (donchian-channel date-ohlc-vector period) 42 | (values (vector-map (λ (v) (dv (dohlc-date (vector-ref v (- period 1))) 43 | (sequence-fold (λ (acc el) (max acc (dohlc-high el))) 44 | (dohlc-high (vector-ref v 0)) v))) 45 | (vector-partition date-ohlc-vector period 1)) 46 | (vector-map (λ (v) (dv (dohlc-date (vector-ref v (- period 1))) 47 | (sequence-fold (λ (acc el) (min acc (dohlc-low el))) 48 | (dohlc-low (vector-ref v 0)) v))) 49 | (vector-partition date-ohlc-vector period 1)))) 50 | 51 | (define (delta dv-vector period) 52 | (vector-map (λ (v) (dv (dv-date (vector-ref v (- period 1))) 53 | (- (dv-value (vector-ref v (- period 1))) (dv-value (vector-ref v 0))))) 54 | (vector-partition dv-vector period 1))) 55 | 56 | (define (shift dv-vector period) 57 | (vector-map (λ (v) (dv (dv-date (vector-ref v (- period 1))) 58 | (dv-value (vector-ref v 0)))) 59 | (vector-partition dv-vector period 1))) 60 | 61 | ; Technical indicator to count the number of consecutive crows or soldiers before a reversal. 62 | ; There is probably a better name for this. 63 | ; 64 | ; https://en.wikipedia.org/wiki/Three_black_crows 65 | ; https://en.wikipedia.org/wiki/Three_white_soldiers 66 | (define (crow-soldier-reversal date-ohlc-vector period) 67 | (let ([ud (vector-map (λ (v) (cond [(and (> (dohlc-high (vector-ref v 1)) 68 | (dohlc-high (vector-ref v 0))) 69 | (> (dohlc-low (vector-ref v 1)) 70 | (dohlc-low (vector-ref v 0)))) 71 | (dv (dohlc-date (vector-ref v 1)) 1)] 72 | [(and (< (dohlc-high (vector-ref v 1)) 73 | (dohlc-high (vector-ref v 0))) 74 | (< (dohlc-low (vector-ref v 1)) 75 | (dohlc-low (vector-ref v 0)))) 76 | (dv (dohlc-date (vector-ref v 1)) -1)] 77 | [else (dv (dohlc-date (vector-ref v 1)) 0)])) 78 | (vector-partition date-ohlc-vector 2 1))]) 79 | (vector-map (λ (v) (let ([sum (sequence-fold (λ (acc el) (+ (dv-value el) acc)) 0 80 | (vector-take v (- (vector-length v) 1)))]) 81 | (cond [(and (= -1 (dv-value (vector-ref v (- (vector-length v) 1)))) 82 | (= sum (- (vector-length v) 1))) 83 | (dv (dv-date (vector-ref v (- (vector-length v) 1))) 84 | sum)] 85 | [(and (= 1 (dv-value (vector-ref v (- (vector-length v) 1)))) 86 | (= (* sum -1) (- (vector-length v) 1))) 87 | (dv (dv-date (vector-ref v (- (vector-length v) 1))) 88 | sum)] 89 | [else (dv (dv-date (vector-ref v (- (vector-length v) 1))) 90 | 0)]))) 91 | (vector-partition ud period 1)))) 92 | --------------------------------------------------------------------------------