Skip to content

Instantly share code, notes, and snippets.

@takagi

takagi/tsuru.lisp

Last active August 29, 2015 14:17
Show Gist options
  • Save takagi/90d36e7e160e9c3edf80 to your computer and use it in GitHub Desktop.
Save takagi/90d36e7e160e9c3edf80 to your computer and use it in GitHub Desktop.
Download ZIP
Tsuru Capital recruiting test code sample.
Raw
tsuru.lisp
;;;
;;; Fundamental WORD/INT types and readers
;;;
(deftype word8 ()
`(unsigned-byte 8))
(deftype word16 ()
`(unsigned-byte 16))
(deftype word32 ()
`(unsigned-byte 32))
(deftype int8 ()
`(signed-byte 8))
(deftype int16 ()
`(signed-byte 16))
(deftype int32 ()
`(signed-byte 32))
(defun read-word8 (stream)
(read-byte stream))
(defun read-word16-le (stream)
(+ (read-byte stream)
(ash (read-byte stream) 8)))
(defun read-word32-le (stream)
(+ (read-byte stream)
(ash (read-byte stream) 8)
(ash (read-byte stream) 16)
(ash (read-byte stream) 24)))
(defun read-int8 (stream)
(declare (ignore stream))
(error "undefined"))
(defun read-int16-le (stream)
(declare (ignore stream))
(error "undefined"))
(defun word32->int32 (x)
(declare (type (unsigned-byte 32) x))
(if (< x #x80000000)
x
(- x (ash 2 31))))
(defun read-int32-le (stream)
(word32->int32 (read-word32-le stream)))
;;;
;;; Pcap Global Header
;;;
(defstruct (pcap-hdr (:constructor %make-pcap-hdr))
(magic-number 0 :type (unsigned-byte 32) :read-only t)
(version-major :version-major :read-only t)
(version-minor :version-minor :read-only t)
(thiszone 0 :type (signed-byte 32) :read-only t)
(sigfigs :sigfigs :read-only t)
(snaplen :snaplen :read-only t)
(network :network :read-only t))
(defun make-pcap-hdr (magic-number version-major version-minor thiszone sigfigs snaplen network)
(%make-pcap-hdr :magic-number magic-number
:version-major version-major
:version-minor version-minor
:thiszone thiszone
:sigfigs sigfigs
:snaplen snaplen
:network network))
(defun read-pcap-hdr (stream)
(make-pcap-hdr (read-word32-le stream)
(read-word16-le stream)
(read-word16-le stream)
(read-int32-le stream)
(read-word32-le stream)
(read-word32-le stream)
(read-word32-le stream)))
;;;
;;; Pcap Packet Header
;;;
(defstruct (pcap-rec-hdr (:constructor make-pcap-rec-hdr (ts-sec ts-usec incl-len orig-len)))
(ts-sec 0 :type word32 :read-only t)
(ts-usec 0 :type word32 :read-only t)
(incl-len 0 :type word32 :read-only t)
(orig-len 0 :type word32 :read-only t))
(defun read-pcap-rec-hdr (stream)
(make-pcap-rec-hdr (read-word32-le stream)
(read-word32-le stream)
(read-word32-le stream)
(read-word32-le stream)))
(defun pcap-rec-hdr-timestamp (hdr)
(local-time:unix-to-timestamp (pcap-rec-hdr-ts-sec hdr)
:nsec (* (pcap-rec-hdr-ts-usec hdr) 1000)))
;;;
;;; Pcap Packet Data
;;;
(defun read-pcap-rec-data (hdr stream)
(let ((incl-len (pcap-rec-hdr-incl-len hdr)))
(loop for i from 0 below incl-len
collect (read-byte stream))))
;;;
;;; Quote Packet
;;;
(defstruct (quote-packet (:constructor %make-quote-packet))
(packet-timestamp nil :read-only t)
(quote-accept-timestamp nil :read-only t)
(data-type nil :read-only t)
(information-type nil :read-only t)
(market-type nil :read-only t)
(issue-code nil :read-only t)
(issue-seq-no nil :read-only t)
(market-status-type nil :read-only t)
(total-bid-quote-volume nil :read-only t)
(best-bid-price-1st nil :read-only t)
(best-bid-quantity-1st nil :read-only t)
(best-bid-price-2nd nil :read-only t)
(best-bid-quantity-2nd nil :read-only t)
(best-bid-price-3rd nil :read-only t)
(best-bid-quantity-3rd nil :read-only t)
(best-bid-price-4th nil :read-only t)
(best-bid-quantity-4th nil :read-only t)
(best-bid-price-5th nil :read-only t)
(best-bid-quantity-5th nil :read-only t)
(total-ask-quote-volume nil :read-only t)
(best-ask-price-1st nil :read-only t)
(best-ask-quantity-1st nil :read-only t)
(best-ask-price-2nd nil :read-only t)
(best-ask-quantity-2nd nil :read-only t)
(best-ask-price-3rd nil :read-only t)
(best-ask-quantity-3rd nil :read-only t)
(best-ask-price-4th nil :read-only t)
(best-ask-quantity-4th nil :read-only t)
(best-ask-price-5th nil :read-only t)
(best-ask-quantity-5th nil :read-only t)
(no-of-best-bid-valid-quote nil :read-only t)
(no-of-best-bid-quote-1st nil :read-only t)
(no-of-best-bid-quote-2nd nil :read-only t)
(no-of-best-bid-quote-3rd nil :read-only t)
(no-of-best-bid-quote-4th nil :read-only t)
(no-of-best-bid-quote-5th nil :read-only t)
(no-of-best-ask-valid-quote nil :read-only t)
(no-of-best-ask-quote-1st nil :read-only t)
(no-of-best-ask-quote-2nd nil :read-only t)
(no-of-best-ask-quote-3rd nil :read-only t)
(no-of-best-ask-quote-4th nil :read-only t)
(no-of-best-ask-quote-5th nil :read-only t)
(quote-accept-time nil :read-only t)
(end-of-message nil :read-only t))
(defun make-quote-packet (hdr data)
(let ((quote-packet-data (quote-packet-data data)))
(if quote-packet-data
(let ((data1 (mapcar #'code-char quote-packet-data)))
(let ((accept-timestamp (foo (pcap-rec-hdr-timestamp hdr)
(coerce (subseq data1 206 214) 'string))))
(%make-quote-packet :packet-timestamp (pcap-rec-hdr-timestamp hdr)
:quote-accept-timestamp accept-timestamp
:data-type (coerce (subseq data1 0 2) 'string)
:information-type (coerce (subseq data1 2 4) 'string)
:market-type (coerce (subseq data1 4 5) 'string)
:issue-code (coerce (subseq data1 5 17) 'string)
:issue-seq-no (coerce (subseq data1 17 20) 'string)
:market-status-type (coerce (subseq data1 20 22) 'string)
:total-bid-quote-volume (coerce (subseq data1 22 29) 'string)
:best-bid-price-1st (coerce (subseq data1 29 34) 'string)
:best-bid-quantity-1st (coerce (subseq data1 34 41) 'string)
:best-bid-price-2nd (coerce (subseq data1 41 46) 'string)
:best-bid-quantity-2nd (coerce (subseq data1 46 53) 'string)
:best-bid-price-3rd (coerce (subseq data1 53 58) 'string)
:best-bid-quantity-3rd (coerce (subseq data1 58 65) 'string)
:best-bid-price-4th (coerce (subseq data1 65 70) 'string)
:best-bid-quantity-4th (coerce (subseq data1 70 77) 'string)
:best-bid-price-5th (coerce (subseq data1 77 82) 'string)
:best-bid-quantity-5th (coerce (subseq data1 82 89) 'string)
:total-ask-quote-volume (coerce (subseq data1 89 96) 'string)
:best-ask-price-1st (coerce (subseq data1 96 101) 'string)
:best-ask-quantity-1st (coerce (subseq data1 101 108) 'string)
:best-ask-price-2nd (coerce (subseq data1 108 113) 'string)
:best-ask-quantity-2nd (coerce (subseq data1 113 120) 'string)
:best-ask-price-3rd (coerce (subseq data1 120 125) 'string)
:best-ask-quantity-3rd (coerce (subseq data1 125 132) 'string)
:best-ask-price-4th (coerce (subseq data1 132 137) 'string)
:best-ask-quantity-4th (coerce (subseq data1 137 144) 'string)
:best-ask-price-5th (coerce (subseq data1 144 149) 'string)
:best-ask-quantity-5th (coerce (subseq data1 149 156) 'string)
:no-of-best-bid-valid-quote (coerce (subseq data1 156 161) 'string)
:no-of-best-bid-quote-1st (coerce (subseq data1 161 165) 'string)
:no-of-best-bid-quote-2nd (coerce (subseq data1 165 169) 'string)
:no-of-best-bid-quote-3rd (coerce (subseq data1 169 173) 'string)
:no-of-best-bid-quote-4th (coerce (subseq data1 173 177) 'string)
:no-of-best-bid-quote-5th (coerce (subseq data1 177 181) 'string)
:no-of-best-ask-valid-quote (coerce (subseq data1 181 186) 'string)
:no-of-best-ask-quote-1st (coerce (subseq data1 186 190) 'string)
:no-of-best-ask-quote-2nd (coerce (subseq data1 190 194) 'string)
:no-of-best-ask-quote-3rd (coerce (subseq data1 194 198) 'string)
:no-of-best-ask-quote-4th (coerce (subseq data1 198 202) 'string)
:no-of-best-ask-quote-5th (coerce (subseq data1 202 206) 'string)
:quote-accept-time (coerce (subseq data1 206 214) 'string)
:end-of-message (char-code (nth 214 data1)))))
nil)))
(defun foo (bar baz)
(let* ((accept-time baz)
(hour (read-from-string (subseq accept-time 0 2)))
(minute (read-from-string (subseq accept-time 2 4)))
(second (read-from-string (subseq accept-time 4 6)))
(msecond (* (read-from-string (subseq accept-time 6 8)) 10)))
(let ((packet-timestamp bar))
(local-time:encode-timestamp (* msecond 1000000)
second
minute
hour
(local-time:timestamp-day packet-timestamp)
(local-time:timestamp-month packet-timestamp)
(local-time:timestamp-year packet-timestamp)))))
;; (defun quote-packet-quote-accept-timestamp (quote-packet)
;; (let* ((accept-time (quote-packet-quote-accept-time quote-packet))
;; (hour (read-from-string (subseq accept-time 0 2)))
;; (minute (read-from-string (subseq accept-time 2 4)))
;; (second (read-from-string (subseq accept-time 4 6)))
;; (msecond (* (read-from-string (subseq accept-time 6 8)) 10)))
;; (let ((packet-timestamp (quote-packet-packet-timestamp quote-packet)))
;; (local-time:encode-timestamp (* msecond 1000000)
;; second
;; minute
;; hour
;; (local-time:timestamp-day packet-timestamp)
;; (local-time:timestamp-month packet-timestamp)
;; (local-time:timestamp-year packet-timestamp)))))
(defun quote-packet-data (data)
(labels ((aux (data)
(if (< (length data) 5)
nil
(destructuring-bind (x0 x1 x2 x3 x4 . _) data
(declare (ignore _))
(if (and (= x0 66) (= x1 54) (= x2 48) (= x3 51) (= x4 52))
data
(aux (cdr data)))))))
(aux data)))
;;;
;;; Ordering Buffer
;;;
(defstruct (ordering-buffer (:constructor %make-ordering-buffer))
packets
current-packet-timestamp)
(defun make-ordering-buffer ()
(%make-ordering-buffer))
(defun ordering-buffer-count (buffer)
(length (ordering-buffer-packets buffer)))
(defun timestamp-difference (time-a time-b)
(let ((nsec (- (local-time:nsec-of time-a) (local-time:nsec-of time-b)))
(second (- (local-time:sec-of time-a) (local-time:sec-of time-b)))
(day (- (local-time:day-of time-a) (local-time:day-of time-b))))
(declare (type (signed-byte 32) second nsec)
(type (unsigned-byte 32) day))
(when (minusp nsec)
(decf second)
(incf nsec 1000000000))
(when (minusp second)
(decf day)
(incf second local-time:+seconds-per-day+))
(+ (* day local-time:+seconds-per-day+)
second)))
(defun passed-three-seconds-p (buffer quote-packet)
(let ((packet-timestamp (ordering-buffer-current-packet-timestamp buffer))
(accept-timestamp (quote-packet-quote-accept-timestamp quote-packet)))
(> (timestamp-difference packet-timestamp accept-timestamp)
3)))
(defun insert-quote-packet (packets packet)
(labels ((aux (packets packet)
(if (null packets)
(cons packet nil)
(destructuring-bind (packet0 . rest) packets
(if (or (string> (quote-packet-quote-accept-time packet)
(quote-packet-quote-accept-time packet0))
(and (string= (quote-packet-quote-accept-time packet)
(quote-packet-quote-accept-time packet0))
(local-time:timestamp>
(quote-packet-packet-timestamp packet)
(quote-packet-packet-timestamp packet0))))
(cons packet packets)
(cons packet0 (aux rest packet)))))))
(aux packets packet)))
(defun ordering-buffer-insert (buffer hdr quote-packet)
;; Insert the quote packet to the ordering buffer, sorting by the quote
;; accept time order.
(setf (ordering-buffer-packets buffer)
(insert-quote-packet (ordering-buffer-packets buffer) quote-packet))
;; Keep the packet timestamp.
(setf (ordering-buffer-current-packet-timestamp buffer)
(pcap-rec-hdr-timestamp hdr))
buffer)
(defun ordering-buffer-pop (buffer)
;; Return quote packets whose quote accept times exceed more than three
;; seconds after the packet time in the quote accept time order.
(labels ((aux (packets in-packets)
(if (null packets)
(values in-packets nil)
(destructuring-bind (packet . rest) packets
(if (passed-three-seconds-p buffer packet)
(values in-packets packets)
(aux rest (cons packet in-packets)))))))
(multiple-value-bind (in-packets out-packets)
(aux (ordering-buffer-packets buffer) nil)
(setf (ordering-buffer-packets buffer) (nreverse in-packets))
(nreverse out-packets))))
(defun ordering-buffer-pop-all (buffer)
;; Return all quote packets left in the ordering buffer.
(prog1 (nreverse (ordering-buffer-packets buffer))
(setf (ordering-buffer-packets buffer) nil
(ordering-buffer-current-packet-timestamp buffer) nil)))
;;;
;;; Main
;;;
(defun print-feed (quote-packet)
(local-time:format-timestring t (quote-packet-packet-timestamp quote-packet))
(format t " ")
(format t "~A " (quote-packet-quote-accept-timestamp quote-packet))
(format t "~A " (quote-packet-issue-code quote-packet))
(format t "~A@~A " (quote-packet-best-bid-quantity-5th quote-packet)
(quote-packet-best-bid-price-5th quote-packet))
(format t "~A@~A " (quote-packet-best-bid-quantity-4th quote-packet)
(quote-packet-best-bid-price-4th quote-packet))
(format t "~A@~A " (quote-packet-best-bid-quantity-3rd quote-packet)
(quote-packet-best-bid-price-3rd quote-packet))
(format t "~A@~A " (quote-packet-best-bid-quantity-2nd quote-packet)
(quote-packet-best-bid-price-2nd quote-packet))
(format t "~A@~A " (quote-packet-best-bid-quantity-1st quote-packet)
(quote-packet-best-bid-price-1st quote-packet))
(format t "~A@~A " (quote-packet-best-ask-quantity-1st quote-packet)
(quote-packet-best-ask-price-1st quote-packet))
(format t "~A@~A " (quote-packet-best-ask-quantity-2nd quote-packet)
(quote-packet-best-ask-price-2nd quote-packet))
(format t "~A@~A " (quote-packet-best-ask-quantity-3rd quote-packet)
(quote-packet-best-ask-price-3rd quote-packet))
(format t "~A@~A " (quote-packet-best-ask-quantity-4th quote-packet)
(quote-packet-best-ask-price-4th quote-packet))
(format t "~A@~A~%" (quote-packet-best-ask-quantity-5th quote-packet)
(quote-packet-best-ask-price-5th quote-packet))
(fresh-line))
(defun main ()
(with-open-file (out "out" :direction :output :if-exists :supersede)
(let ((buffer (make-ordering-buffer)))
(let ((*standard-output* out))
(with-open-file (in "data" :direction :input
:element-type '(unsigned-byte 8))
(read-pcap-hdr in)
(handler-case
(loop
(let* ((hdr (read-pcap-rec-hdr in))
(data (read-pcap-rec-data hdr in)))
(let ((quote-packet (make-quote-packet hdr data)))
(when quote-packet
(ordering-buffer-insert buffer hdr quote-packet)
(loop for packet in (ordering-buffer-pop buffer)
do (print-feed packet))))))
(end-of-file ()))
(loop for packet in (ordering-buffer-pop-all buffer)
do (print-feed packet)))))))
;;;
;;; Profile
;;;
(require :sb-sprof)
(defun do-profile ()
(sb-sprof:with-profiling (:max-samples 100
:report :graph
:loop nil)
(main)))
Raw
tsuru2.lisp
;;;
;;; INCOMPLETE
;;;
;;;
;;; Fundamental WORD/INT types and readers
;;;
(deftype word8 ()
`(unsigned-byte 8))
(deftype word16 ()
`(unsigned-byte 16))
(deftype word32 ()
`(unsigned-byte 32))
(deftype int8 ()
`(signed-byte 8))
(deftype int16 ()
`(signed-byte 16))
(deftype int32 ()
`(signed-byte 32))
(defun read-word8 (stream)
(read-byte stream))
(defun read-word16-le (stream)
(+ (read-byte stream)
(ash (read-byte stream) 8)))
(defun read-word32-le (stream)
(+ (read-byte stream)
(ash (read-byte stream) 8)
(ash (read-byte stream) 16)
(ash (read-byte stream) 24)))
(defun read-int8 (stream)
(declare (ignore stream))
(error "undefined"))
(defun read-int16-le (stream)
(declare (ignore stream))
(error "undefined"))
(defun word32->int32 (x)
(declare (type (unsigned-byte 32) x))
(if (< x #x80000000)
x
(- x (ash 2 31))))
(defun read-int32-le (stream)
(word32->int32 (read-word32-le stream)))
;;;
;;; Ordering Buffer
;;;
(defparameter +quote-packet-data-size+ 214)
(defparameter +quote-packet-size+ (+ +quote-packet-size+ 4))
(defparameter +max-quote-packets+ 1024)
(defstruct (ordering-buffer (:constructor %make-ordering-buffer))
buffer
newest
oldest)
(defun make-ordering-buffer ()
(let ((buffer (make-array (* +max-quote-packets+ +quote-packet-size+)
:element-type '(unsigned-byte 8)
:initial-element #x00)))
(%make-ordering-buffer :buffer buffer :newest 0 :oldest 0)))
(defun ordering-buffer-index (i)
(unless (and (<= 0 i)
(< i +max-quote-packets+))
(error "The value ~S is out of boundary of the ordering buffer." i))
(* i +quote-packet-size+))
(defun ordering-buffer-newest-index (buffer)
(ordering-buffer-index (ordering-buffer-newest buffer)))
(defun ordering-buffer-oldest-index (buffer)
(ordering-buffer-index (ordering-buffer-oldest buffer)))
(defun ordering-buffer-empty-p (buffer)
(= (ordering-buffer-newest buffer)
(ordering-buffer-oldest buffer)))
(defun ordering-buffer-full-p (buffer)
(let ((newest (ordering-buffer-newest buffer))
(oldest (ordering-buffer-oldest buffer)))
(when (< newest oldest)
(incf newest +max-quote-packets+))
(= (- newest oldest) (- +max-quote-packets+ 1))))
(defun ordering-buffer-increment-newest (buffer)
(unless (not (ordering-buffer-full-p buffer))
(error "The ordering buffer is full."))
(incf (ordering-buffer-newest buffer))
(if (= +max-quote-packets+ (ordering-buffer-newest buffer))
(setf (ordering-buffer-newest buffer) 0))
buffer)
(defun ordering-buffer-increment-oldest (buffer)
(unless (not (ordering-buffer-empty-p buffer))
(error "The ordering buffer is empty."))
(incf (ordering-buffer-oldest buffer))
(if (= +max-quote-packets+ (ordering-buffer-oldest buffer))
(setf (ordering-buffer-oldest buffer) 0))
buffer)
(defun ordering-buffer-oldest-passed-four-seconds-p (buffer)
(unless (not (ordering-buffer-empty-p buffer))
(error "The ordering buffer is empty."))
nil)
(defun ordering-buffer-get-string (buffer i length)
(coerce
(loop repeat length
for i0 from (ordering-buffer-index i)
collect (code-char (aref (ordering-buffer-buffer buffer) i0)))
'string))
(defun ordering-buffer-get-int8 (buffer i)
nil)
(defun ordering-buffer-get-int16-le (buffer i)
nil)
(defun ordering-buffer-get-int32-le (buffer i)
nil)
(defun ordering-buffer-get-word8 (buffer i)
nil)
(defun ordering-buffer-get-word16-le (buffer i)
nil)
(defun ordering-buffer-get-word32-le (buffer i)
(let ((buffer% (ordering-buffer-buffer buffer))
(i0 (ordering-buffer-index i)))
(+ (ash (aref buffer% (+ i0 3)) 24)
(ash (aref buffer% (+ i0 2)) 16)
(ash (aref buffer% (+ i0 1)) 8)
(aref buffer% i0))))
(defun ordering-buffer-data-type (buffer i)
(ordering-buffer-get-string buffer i 2))
(defun ordering-buffer-read-quote-packet (buffer stream)
(unless (not (ordering-buffer-full-p buffer))
(error "The ordering buffer is full."))
;; read packet header
;; read packet data with searching quote packet from stream
(read-sequence (ordering-buffer-buffer buffer) stream
:start (ordering-buffer-newest-index buffer)
:end (+ (ordering-buffer-newest-index buffer)
+quote-packet-data-size+))
;; order by quote accept time
;; update the newest pointer
(ordering-buffer-increment-newest buffer))
(defmacro ordering-buffer-do-quote-packet ((var buffer) &body body)
;; TODO: once only buffer
`(loop
while (and (not (ordering-buffer-empty-p ,buffer))
(ordering-buffer-oldest-passed-four-seconds-p ,buffer))
do (let ((,var (ordering-buffer-oldest ,buffer)))
,@body)
(ordering-buffer-increment-oldest ,buffer)))
(defun read-pcap-hdr (stream)
(read-word32-le stream)
(read-word16-le stream)
(read-word16-le stream)
(read-int32-le stream)
(read-word32-le stream)
(read-word32-le stream)
(read-word32-le stream))
(defun main ()
(let ((buffer (make-ordering-buffer)))
(with-open-file (in "data" :direction :input
:element-type '(unsigned-byte 8))
(read-pcap-hdr in)
;; TODO: handling EOF?
(handler-case
(loop
(ordering-buffer-read-quote-packet buffer in)
(do-ordering-buffer-quote-packet (i buffer)
(print-feed buffer i)))
(end-of-file ()))
(do-ordering-buffer-quote-packet-all (i buffer)
(print-feed buffer i)))))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment