DrRacketで仮想通貨の自動売買してみたい

bitFlyerのAPIを使って、自動売買のプログラミングに挑戦しました。
なぜRacket(Scheme)なの？と思わるかもしれませんが、理由は好きだからです。
金融云々は、素人です。
好きなように書いてます。


```diff_racket
#lang racket

;;; -------------------------------------------------------------------------------

(define-syntax (if-it stx)
  (syntax-case stx ()
    [(if-it pred expr then else)
     (with-syntax [(it (datum->syntax #'if-it 'it))]
       #'(let ([it expr])
           (if (pred it)
               then
               else) ) ) ] ) )


(define-syntax (loop stx)
  (syntax-case stx ()
    [(loop expr ...)
     (with-syntax ([exit (datum->syntax #'loop 'exit)])
       #'(let/cc exit
           (let loop ()
             expr
             ...
             (loop) ) ) ) ] ) )

;;; -------------------------------------------------------------------------------

(module CryptoWatch racket

  (provide get-cryptowatch
           collect-price)
 
  (require net/http-easy)  ; raco pkg install http-easy


  (define (get-cryptowatch url)
    (let ([response (response-json (get url))])
    
      (if (eq? 'error (cadr (hash-keys response)))
          '()
          (hash-ref (hash-ref response 'result) '|300|)) ) )

  
  (define (collect-price-ohlc menu data)
    (match menu
      ['open  (map second data)]
      ['high  (map third  data)]
      ['low   (map fourth data)]
      ['close (map fifth  data)] ) )


  (define (collect-price menu data [term 0])
    (let ([prices (collect-price-ohlc menu data)])
      (if (zero? term)
          prices
          (take-right prices term) ) ) )
  
  )  ; module

;;; -------------------------------------------------------------------------------

(module Send-bitFlyer racket

  (provide send-order)

  (require gregor
           json
           net/http-easy  ; raco pkg install http-easy
           rnrs/bytevectors-6
           sha      ; raco pkg install sha
           timable  ; raco pkg install timable
           )

  
  (define (create-header method
                         endpoint
                         body
                         api-key
                         api-secret
                         [content-type "application/json"])
    
    (let* ([timestamp (datetime->iso8601 (current-datetime))]

           [message   (string-append timestamp method endpoint body)]

           [signature (bytes->hex-string
                       (hmac-sha256 (string->utf8 api-secret)
                                    (string->utf8 message) ) )] )

      (hasheq 'ACCESS-KEY       api-key
              'ACCESS-TIMESTAMP timestamp
              'ACCESS-SIGN      signature
              'Content-Type     content-type) ) )


  (define (send-order base-url
                      endpoint
                      currency-pair
                      api-key
                      api-secret
                      [child_order_type "MARKET"]
                      [minute_to_expire "10000"]
                      [time_in_force    "GTC"] )

    (λ (side size)    
      (let* ([body (jsexpr->string
                    (hasheq 'product_code     currency-pair
                            'child_order_type child_order_type
                            'side             side
                            'size             size
                            'minute_to_expire minute_to_expire
                            'time_in_force    time_in_force) ) ]

             [headers (create-header "POST" endpoint body api-key api-secret)] )

        (response-json
         (post (string-append base-url endpoint)
               #:headers headers
               #:data    body) ) ) ) )

  )  ; module

;;; -------------------------------------------------------------------------------

(module MA racket

  (provide sma
           ema
           macd)
           
  
  (define-syntax sum
    (syntax-rules ()
      [(_ lst)
       (for/sum ([x lst]) x) ]

      [(_ proc lst)
       (for/sum ([x lst])
         (proc x) ) ] ) )


  (define (ave lst)
    (/ (sum lst)
       (length lst) ) )


  (define (sma lst)
    (ave lst) )


  ;; 前日の指数平滑移動平均 + α × (当日終値-前日の指数平滑移動平均)
  ;; α(平滑定数) = 2 ÷ (n + 1)
  (define (ema lst p)
    (let ([alpha (/ 2 (add1 (length lst)))])
      (+ (car lst)
         (* alpha
            (- p (car lst) ) ) ) ) )
  
  
  ;; 意味が分かっていません
  ;; 勝手な解釈です
  (define (macd lst0 lst1)
    (- (sma lst0)
       (sma lst1) ) )
      
  )  ; module

;;; -------------------------------------------------------------------------------

(require 2htdp/batch-io
         json
         racket/generic)

(require 'CryptoWatch
         'Send-bitFlyer
         'MA)

;;; -------------------------------------------------------------------------------

(define-generics traded-status
  (buy?    traded-status)
  (sell?   traded-status)
  (update! traded-status) )


(struct Traded-Status (flag)
  #:mutable
  #:transparent
  #:methods gen:traded-status

  [(define (buy? ts)
     (eq? 'BUY (Traded-Status-flag ts)) )

   (define (sell? ts)
     (eq? 'SELL (Traded-Status-flag ts)) )

   (define (update! ts)
     (let ([_ts (Traded-Status-flag ts)])

       (when (eq? 'SELL _ts)
         (set-Traded-Status-flag! ts 'BUY) )

       (when (eq? 'BUY _ts)
         (set-Traded-Status-flag! ts 'SELL) ) ) )
   
   ]  ; methods
  )  ; struct

;;; ------------------------------------------------------------------------------

(define-generics stack-ema
  (stack-null?   stack-ema)  
  (init-stack!   stack-ema close-prices)  
  (push-stack!   stack-ema most-recent-price)
  (update-stack! stack-ema leng)
  (calc-macd     stack-ema) )
  

(struct Stack-EMA (value)
  #:mutable
  #:transparent
  #:methods gen:stack-ema

  [(define (stack-null? stck)
     (null? (Stack-EMA-value stck)) )


   (define (init-stack! stck prices)
     (set-Stack-EMA-value!
      stck
      (cons (sma prices)
            (Stack-EMA-value stck)) ) )

   
   (define (push-stack! stck most-recent)
     (set-Stack-EMA-value!
      stck
      (cons (ema (Stack-EMA-value stck)
                 most-recent)
            (Stack-EMA-value stck)) ) )


   (define (update-stack! stck leng)
     (let ([lst (Stack-EMA-value stck)])
       
       (when (> (length lst) leng)
         (set-Stack-EMA-value!
          stck
          (take lst leng) ) ) ) )


   (define (calc-macd stck)
     (let* ([lst  (Stack-EMA-value stck)]
            [leng (length lst)] )
       
       (if (>= leng 10)
           (begin
             (when (odd? leng)
               (set! lst  (drop-right lst 1))
               (set! leng (length lst)) )
  
             (macd (take lst (/ leng 2))  ; short
                   lst) )  ; long
           0) ) )
     
   ]  ; methods
  )  ; struct
     
;;; -------------------------------------------------------------------------------

(define *key-settings*
  (with-input-from-string
      (read-file "./settings/key-settings.json")
    (λ () (read-json)) ) )


(define *url-cryptowatch*
  "https://api.cryptowat.ch/markets/bitflyer/xrpjpy/ohlc?periods=300")


(define *send-order*
  (send-order "https://api.bitflyer.com"
              "/v1/me/sendchildorder"
              "XRP_JPY"
              (hash-ref *key-settings* 'api-key)
              (hash-ref *key-settings* 'api-secret) ) )


(define *traded-status* (Traded-Status 'BUY))

(define *stack-ema* (Stack-EMA '()))

;;; -------------------------------------------------------------------------------

(define (main)
  (loop 
   (let* ([data-cryptowatch
           (if-it null? (get-cryptowatch *url-cryptowatch*)
                  (exit 'Abort)
                  it) ]

          [most-recent-price
           (fifth (last data-cryptowatch)) ]
       
          [macd   null]
          [result null] )
  
     ;; スタックの操作 判断
     (if (stack-null? *stack-ema*)
         ;; 初回のみ
         (init-stack! *stack-ema*
                      (drop-right (collect-price 'close data-cryptowatch 21)
                                  1) )

         ;; 2 回目以降
         (push-stack! *stack-ema* most-recent-price) )


     ;; 更新
     (set! macd (calc-macd *stack-ema*))


     ;; 売買
     (cond
       [(and (sell? *traded-status*) (negative? macd))

        (*send-order* "SELL" "1.0")
        (update! *traded-status*)
        (set! result "売った") ]

       [(and (buy? *traded-status*) (positive? macd))

        (*send-order* "BUY" "2.0")
        (update! *traded-status*)
        (set! result "買った") ]

       [else
        (set! result "待機") ] )


     ;; 表示
     (displayln (format "
MOST RECENT  :  ~s
MACD         :  ~s
~s

~s
"
                        most-recent-price
                        macd
                        *traded-status*
                        result) )

     (displayln (make-string 60 #\-))


     ;; 更新
     (update-stack! *stack-ema* 20) )


   ;; 待機
   (sleep 900) ) )  ; 15 分
```