A Simple CDA Implementation in Clojure http://qwtel.com/a-simple-cda-implementation-in-clojure

cda.clj

(ns interact.cda
  (:require [clojure.test :refer :all]))

(defn insert-by [f c e]
  (let [[lt gt] (split-with #(f % e) c)]
    (concat lt [e] gt)))

(def insert (partial insert-by <))

(testing "insert"
  (is (= (insert [1 2 4] 3)
         (list 1 2 3 4)))

  (is (= (insert [1 2 4] 0)
         (list 0 1 2 4)))

  (is (= (insert [1 2 4] -1)
         (list -1 1 2 4)))

  (is (= (insert [1 2 4] 5)
         (list 1 2 4 5))))

(defn add-to-queues
  "Insertes an order into the matching queue, sorted by its price
   and returns a new pair of queues."
  [{:keys [quantity] :as order} [bids asks :as queues]]
  (cond
    (> quantity 0) [(insert-by #(> (:price %1) (:price %2)) bids order)
                    asks]
    (< quantity 0) [bids
                    (insert-by #(< (:price %1) (:price %2)) asks order)]
    :else queues))

(testing "add to queues"
  (testing "pre condition"
    ; order MUST NOT be nil
    (is (thrown? NullPointerException (add-to-queues nil [() ()]))))

  (testing "insertion"
    (is (= (add-to-queues {:quantity 1 :price 0.1} [() ()])
           [(list {:quantity 1 :price 0.1})
            ()]))

    (is (= (add-to-queues {:quantity -1 :price 0.1} [() ()])
           [()
            (list {:quantity -1 :price 0.1})]))

    (is (= (add-to-queues {:quantity 0 :price 0.1} [() ()])
           [() ()])))

  (testing "correct insertion order"
    (is (= (add-to-queues {:quantity 1 :price 0.1} [(list {:quantity 1 :price 0.2})
                                                    ()])
           [(list {:quantity 1 :price 0.2} {:quantity 1 :price 0.1})
            ()]))

    (is (= (add-to-queues {:quantity -1 :price 0.1} [()
                                                     (list {:quantity -1 :price 0.2})])
           [()
            (list {:quantity -1 :price 0.1} {:quantity -1 :price 0.2})]))))

(defn- add-to-front
  "Adds a new order to the front of the appropriate queue."
  [order [bids asks :as queues]]
  (cond
    (> (:quantity order) 0) [(cons order bids) asks]
    (< (:quantity order) 0) [bids (cons order asks)]
    :else queues))

(testing "add to front"
  (is (= (add-to-front {:quantity 1 :price 0.1}
                       [() ()])
         [(list {:quantity 1 :price 0.1}) ()]))

  (is (= (add-to-front {:quantity 1 :price 0.1}
                       [(list {:quantity 1 :price 0.2})
                        ()])
         [(list {:quantity 1 :price 0.1} {:quantity 1 :price 0.2})
          ()])))

(defn trade-possible?
  "Checks if a trade is possible based on the prices of two orders.
   The bid price has to be higher than or equal to the ask price."
  [bid ask]
  (and
    (some? bid)
    (some? ask)
    (>= (:price bid) (:price ask))))

(testing "trade possible?"
  (testing "dealing with nil"
    (is (= (trade-possible? nil nil)
           false))

    (is (= (trade-possible? {:price 0.1} nil)
           false))

    (is (= (trade-possible? nil {:price 0.1})
           false)))

  (testing "price comparison"
    (is (= (trade-possible? {:price 0.1} {:price 0.1})
           true))

    (is (= (trade-possible? {:price 0.2} {:price 0.1})
           true))

    (is (= (trade-possible? {:price 0.1} {:price 0.2})
           false))))

(defn diff-order
  "Returns the 'difference' between two orders."
  [bid ask]
  ; using the fact that asks are modeled with a negative quantity:
  (let [diff (+ (:quantity bid) (:quantity ask))]
    (cond
      (> diff 0) (assoc bid :quantity diff)
      (< diff 0) (assoc ask :quantity diff)
      :else nil)))

(testing "diff order"
  (is (= (diff-order {:quantity 5} {:quantity -5})
         nil))

  (is (= (diff-order {:quantity 10 :price 0.2} {:quantity -5 :price 0.1})
         {:quantity 5 :price 0.2}))

  (is (= (diff-order {:quantity 5 :price 0.2} {:quantity -10 :price 0.1})
         {:quantity -5 :price 0.1})))

(defn place-order
  "Place a limit order using Continuous Double Auction."
  [order queues]
  (loop [[bids asks :as queues] (add-to-queues order queues)]
    (let [[first-bid] bids
          [first-ask] asks]
      (if (not (trade-possible? first-bid first-ask))
        queues
        (let [rest-queues  [(rest bids) (rest asks)]
              diffed-order (diff-order first-bid first-ask)]
          (if (nil? diffed-order)
            rest-queues
            (recur (add-to-front diffed-order rest-queues))))))))

(testing "place order"
  (is (= (->> [() ()]
              (place-order {:quantity 1 :price 0.5}))
         [(list {:quantity 1 :price 0.5}) ()]))

  (is (= (->> [() ()]
              (place-order {:quantity 1 :price 0.5})
              (place-order {:quantity 2 :price 0.4})
              (place-order {:quantity 3 :price 0.3}))
         [(list {:quantity 1 :price 0.5}
                {:quantity 2 :price 0.4}
                {:quantity 3 :price 0.3})
          ()]))

  (is (= (->> [() ()]
              (place-order {:quantity 1 :price 0.5})
              (place-order {:quantity -1 :price 0.5}))
         [() ()]))

  (is (= (->> [() ()]
              (place-order {:quantity 1 :price 0.5})
              (place-order {:quantity -1 :price 0.5})
              (place-order {:quantity 2 :price 0.4})
              (place-order {:quantity -2 :price 0.4})
              (place-order {:quantity 3 :price 0.3})
              (place-order {:quantity -3 :price 0.3}))
         [() ()])))