[Deprecated] Rigetti Forest in Common Lisp

forest.lisp

; DEPRECATED, see https://github.com/tarballs-are-good/cl-forest


;;;; forest.lisp
;;;;
;;;; By Robert Smith
;;;;
;;;; Licensed under Apache 2.0: https://www.apache.org/licenses/LICENSE-2.0

;;; This file demonstrates how to use the Rigetti Forest API
;;; (http://forest.rigetti.com) by exposing the two most important
;;; functions: RUN and WAVEFUNCTION. Other, more advanced functions
;;; are supported by the API as well, but are not implemented
;;; here. This file is intended to be pedagogical and not production
;;; quality.
;;;
;;; The logic mostly follows the `forest` module of the open source
;;; library pyQuil, officially supported by Rigetti.
;;;
;;;     https://github.com/rigetticomputing/pyquil/blob/master/pyquil/forest.py


;;; Quickload :DRAKA for HTTP support, YASON for JSON support, and
;;; ALEXANDRIA for utilities, and IEEE-FLOATS for float decoding.
(ql:quickload '(:drakma :yason :alexandria :ieee-floats))

;;; Set up our parameters.
(defparameter *endpoint* "https://api.rigetti.com/qvm")
(defparameter *api-key* "<<<YOUR API KEY HERE>>>")


;;; Helper function for JSON dictionaries.
(defun dict (&rest key-vals)
  (alexandria:plist-hash-table key-vals))


(defun post-json (json)
  "POST the JSON data structure (as interpreted by YASON) to Rigetti Forest.

Return two values:

    1. The response payload, either as a string, an octet vector, or a
       stream.

    2. The content length or NIL.
"
  (multiple-value-bind (body status headers)
      (drakma:http-request
       *endpoint*
       :method ':post
       ;; Required for wavefunction output. See
       ;;
       ;;    https://github.com/rigetticomputing/pyquil/blob/master/pyquil/forest.py#L234
       :accept "application/octet-stream"
       :additional-headers `(("X-API-KEY" . ,*api-key*))
       :content (with-output-to-string (s)
                  (yason:encode json s)))

    ;; Check status.
    (unless (= 200 status)
      (error "Got a status that wasn't 200."))
    
    ;; Give the return value. The caller should handle what to do with
    ;; this value, which is either a string or a stream, as well as
    ;; the content length.
    (values body
            (ignore-errors
             (parse-integer (cdr (assoc ':content-length headers)))))))


;;; Corresponds to https://github.com/rigetticomputing/pyquil/blob/master/pyquil/forest.py#L293
(defun ping ()
  "Ping the server."
  (values (post-json (dict "type" "ping"))))

;;; Helper function write write small snippets of raw Quil.
(defun quil (&rest instructions)
  "A helper function to make Quil program strings."
  (with-output-to-string (s)
    (loop :for instr :in instructions
          :do (write-line instr s))))


;;; Corresponds to https://github.com/rigetticomputing/pyquil/blob/master/pyquil/forest.py#L391
(defun run (program addresses &optional (num-trials 1))
  "Run the Quil program PROGRAM (as a string) a total number of
NUM-TRIALS (default: 1) times, reading the classical bits addressed by
the list of addresses ADDRESSES.

Return a list of lists of sampled bits corresponding to the requested
ADDRESSES.
"
  (yason:parse
   (post-json
    (dict "type" "multishot"
          "addresses" addresses
          "trials" num-trials
          "quil-instructions" program))))

;;; Example: Bell State Measurement
;;;
;;; CL-USER> (run (quil "H 0"
;;;                     "CNOT 0 1"
;;;                     "MEASURE 0 [0]"
;;;                     "MEASURE 1 [1]")
;;;               '(0 1)
;;;               10)
;;; ((0 0) (1 1) (1 1) (1 1) (1 1) (0 0) (0 0) (1 1) (0 0) (0 0))


(defconstant +octets-per-double+ 8)
(defconstant +octets-per-complex-double+ (* 2 +octets-per-double+))

;;; Corresponds to https://github.com/rigetticomputing/pyquil/blob/master/pyquil/forest.py#L311
(defun wavefunction (program &optional (addresses '()))
  "Get the wavefunctions for the program PROGRAM. Optionally, provide
a list of addresses of bits that should be returned as a second value.

Return two values:

    1. The wavefunction as an array of complex numbers.

    2. The requested memory addresses."
  (labels ((round-to-next (n m)
               (if (zerop (mod n m))
                   n
                   (- (+ n m)
                      (mod n m))))
           
           (octet-bits (octet)
             (loop :for i :below 8 :collect (ldb (byte 1 i) octet)))
           
           (decode-double (octets)
             (ieee-floats:decode-float64
              (reduce (lambda (bits octet)
                        (logior octet (ash bits 8)))
                      octets
                      :initial-value 0)))
             
           (recover-complexes (octets num-octets)
             (let* ((num-addresses (length addresses))
                    (num-mem-octets (floor (round-to-next num-addresses 8) 8))
                    (num-wf-octets (- num-octets num-mem-octets))
                    ;; Variables we calculate:
                    mem
                    (wf (make-array (/ num-wf-octets +octets-per-complex-double+))))
               ;; Get the classical memory.
               (loop :for i :below num-mem-octets
                     :append (octet-bits (aref octets i)) :into all-bits
                     :finally (setf mem (subseq all-bits 0 num-addresses)))
               
               ;; Get the wavefunction
               (loop :for i :from 0
                     :for p :from num-mem-octets :below num-octets :by +octets-per-complex-double+
                     :for re := (decode-double
                                 (subseq octets p (+ p +octets-per-double+)))
                     :for im := (decode-double
                                 (subseq octets
                                         (+ p +octets-per-double+)
                                         (+ p +octets-per-complex-double+)))
                     :do (setf (aref wf i) (complex re im)))
               
               ;; Return the wavefunction and memory..
               (values wf mem))))
    (multiple-value-bind (octets num-octets)
        (post-json
         (dict "type" "wavefunction"
               "quil-instructions" program
               "addresses" addresses))
      ;; Have to do a bit of decoding, since we got binary data
      ;; back. Wavefunctions can be huge!
      (recover-complexes octets num-octets))))

;;; Example: Bell State Wavefunction
;;;
;;; CL-USER> (wavefunction (quil "H 0" "CNOT 0 1"))
;;; #(#C(0.7071067811865475d0 0.0d0) #C(0.0d0 0.0d0) #C(0.0d0 0.0d0)
;;;   #C(0.7071067811865475d0 0.0d0))
;;;
;;; This corresponds to (|00> + |11>) / sqrt(2).