├── LICENSE.txt ├── README.md ├── examples.lisp └── qsim.lisp /LICENSE.txt: -------------------------------------------------------------------------------- 1 | BSD 3-Clause License 2 | 3 | Copyright (c) 2018-2023, Robert Smith 4 | All rights reserved. 5 | 6 | Redistribution and use in source and binary forms, with or without 7 | modification, are permitted provided that the following conditions are met: 8 | 9 | * Redistributions of source code must retain the above copyright notice, this 10 | list of conditions and the following disclaimer. 11 | 12 | * Redistributions in binary form must reproduce the above copyright notice, 13 | this list of conditions and the following disclaimer in the documentation 14 | and/or other materials provided with the distribution. 15 | 16 | * Neither the name of the copyright holder nor the names of its 17 | contributors may be used to endorse or promote products derived from 18 | this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 21 | AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 22 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 23 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 24 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 25 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 26 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 27 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 28 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 29 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 30 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # A Tutorial Quantum Interpreter 2 | 3 | A tiny, self-contained, general-purpose quantum interpreter written in 4 | Common Lisp. It does not have any dependencies and can be loaded with 5 | `(load "qsim")` in your favorite Lisp. 6 | 7 | This is code that accompanies [this blog post](https://www.stylewarning.com/posts/quantum-interpreter/). 8 | 9 | ## License 10 | 11 | The code is licensed under a BSD 3-clause license. See 12 | [`LICENSE.txt`](license.txt). 13 | -------------------------------------------------------------------------------- /examples.lisp: -------------------------------------------------------------------------------- 1 | ;;;; examples.lisp - examples using qsim.lisp 2 | ;;;; Copyright (c) 2018 Robert Smith; see LICENSE.txt for terms. 3 | 4 | (defglobal +H+ (make-array '(2 2) :initial-contents (let ((s (/ (sqrt 2.0d0)))) 5 | (list (list s s) 6 | (list s (- s)))))) 7 | 8 | (defglobal +CNOT+ #2A((1 0 0 0) 9 | (0 1 0 0) 10 | (0 0 0 1) 11 | (0 0 1 0))) 12 | 13 | (defun cphase (angle) 14 | (make-array '(4 4) :initial-contents `((1 0 0 0) 15 | (0 1 0 0) 16 | (0 0 1 0) 17 | (0 0 0 ,(cis (coerce angle 'double-float)))))) 18 | 19 | (defun bell (p q) 20 | `((gate ,+H+ ,p) 21 | (gate ,+CNOT+ ,p ,q))) 22 | 23 | (defun ghz (n) 24 | (cons `(gate ,+H+ 0) 25 | (loop :for q :below (1- n) 26 | :collect `(gate ,+CNOT+ ,q ,(1+ q))))) 27 | 28 | (defun qft (qubits) 29 | (labels ((bit-reversal (qubits) 30 | (let ((n (length qubits))) 31 | (if (< n 2) 32 | nil 33 | (loop :repeat (floor n 2) 34 | :for qs :in qubits 35 | :for qe :in (reverse qubits) 36 | :collect `(GATE ,+swap+ ,qs ,qe))))) 37 | (%qft (qubits) 38 | (destructuring-bind (q . qs) qubits 39 | (if (null qs) 40 | (list `(GATE ,+H+ ,q)) 41 | (let ((cR (loop :with n := (1+ (length qs)) 42 | :for i :from 1 43 | :for qi :in qs 44 | :for angle := (/ pi (expt 2 (- n i))) 45 | :collect `(GATE ,(cphase angle) ,q ,qi)))) 46 | (append 47 | (qft qs) 48 | cR 49 | (list `(GATE ,+H+ ,q)))))))) 50 | (append (%qft qubits) (bit-reversal qubits)))) 51 | -------------------------------------------------------------------------------- /qsim.lisp: -------------------------------------------------------------------------------- 1 | ;;;; qsim.lisp - a fully general quantum interpreter 2 | ;;;; Copyright (c) 2018-2022 Robert Smith; see LICENSE.txt for terms. 3 | 4 | (defglobal +I+ #2A((1 0) 5 | (0 1))) 6 | 7 | (defglobal +SWAP+ #2A((1 0 0 0) 8 | (0 0 1 0) 9 | (0 1 0 0) 10 | (0 0 0 1))) 11 | 12 | (defun apply-operator (matrix column) 13 | (let* ((matrix-size (array-dimension matrix 0)) 14 | (result (make-array matrix-size :initial-element 0.0d0))) 15 | (dotimes (i matrix-size) 16 | (let ((element 0)) 17 | (dotimes (j matrix-size) 18 | (incf element (* (aref matrix i j) (aref column j)))) 19 | (setf (aref result i) element))) 20 | (replace column result))) 21 | 22 | (defun compose-operators (A B) 23 | (destructuring-bind (m n) (array-dimensions A) 24 | (let* ((l (array-dimension B 1)) 25 | (result (make-array (list m l) :initial-element 0))) 26 | (dotimes (i m result) 27 | (dotimes (k l) 28 | (dotimes (j n) 29 | (incf (aref result i k) 30 | (* (aref A i j) 31 | (aref B j k))))))))) 32 | 33 | (defun kronecker-multiply (A B) 34 | (destructuring-bind (m n) (array-dimensions A) 35 | (destructuring-bind (p q) (array-dimensions B) 36 | (let ((result (make-array (list (* m p) (* n q))))) 37 | (dotimes (i m result) 38 | (dotimes (j n) 39 | (let ((Aij (aref A i j)) 40 | (y (* i p)) 41 | (x (* j q))) 42 | (dotimes (u p) 43 | (dotimes (v q) 44 | (setf (aref result (+ y u) (+ x v)) 45 | (* Aij (aref B u v)))))))))))) 46 | 47 | (defun kronecker-expt (U n) 48 | (cond 49 | ((< n 1) #2A((1))) 50 | ((= n 1) U) 51 | (t (kronecker-multiply (kronecker-expt U (1- n)) U)))) 52 | 53 | (defstruct machine 54 | quantum-state 55 | measurement-register) 56 | 57 | (defun dimension-qubits (d) 58 | (1- (integer-length d))) 59 | 60 | (defun make-quantum-state (n) 61 | (let ((s (make-array (expt 2 n) :initial-element 0.0d0))) 62 | (setf (aref s 0) 1.0d0) 63 | s)) 64 | 65 | (defun lift (U i n) 66 | (let ((left (kronecker-expt +I+ (- n i (dimension-qubits 67 | (array-dimension U 0))))) 68 | (right (kronecker-expt +I+ i))) 69 | (kronecker-multiply left (kronecker-multiply U right)))) 70 | 71 | (defun %apply-1Q-gate (state U q) 72 | (apply-operator (lift U q (dimension-qubits (length state))) 73 | state)) 74 | 75 | (defun permutation-to-transpositions (permutation) 76 | (let ((swaps nil)) 77 | (dotimes (dest (length permutation) (nreverse swaps)) 78 | (let ((src (elt permutation dest))) 79 | (loop :while (< src dest) :do 80 | (setf src (elt permutation src))) 81 | (cond 82 | ((< src dest) (push (cons src dest) swaps)) 83 | ((> src dest) (push (cons dest src) swaps))))))) 84 | 85 | (defun transpositions-to-adjacent-transpositions (transpositions) 86 | (flet ((expand-cons (c) 87 | (if (= 1 (- (cdr c) (car c))) 88 | (list (car c)) 89 | (let ((trans (loop :for i :from (car c) :below (cdr c) 90 | :collect i))) 91 | (append trans (reverse (butlast trans))))))) 92 | (mapcan #'expand-cons transpositions))) 93 | 94 | (defun %apply-nQ-gate (state U qubits) 95 | (let ((n (dimension-qubits (length state)))) 96 | (labels ((swap (i) 97 | (lift +swap+ i n)) 98 | (transpositions-to-operator (trans) 99 | (reduce #'compose-operators trans 100 | :key #'swap 101 | :initial-value (kronecker-expt +I+ n)))) 102 | (let* ((U01 (lift U 0 n)) 103 | (from-space (append (reverse qubits) 104 | (loop :for i :below n 105 | :when (not (member i qubits)) 106 | :collect i))) 107 | (trans (transpositions-to-adjacent-transpositions 108 | (permutation-to-transpositions 109 | from-space))) 110 | (to->from (transpositions-to-operator trans)) 111 | (from->to (transpositions-to-operator (reverse trans))) 112 | (Upq (compose-operators to->from 113 | (compose-operators U01 114 | from->to)))) 115 | (apply-operator Upq state))))) 116 | 117 | (defun apply-gate (state U qubits) 118 | (assert (= (length qubits) (dimension-qubits (array-dimension U 0)))) 119 | (if (= 1 (length qubits)) 120 | (%apply-1Q-gate state U (first qubits)) 121 | (%apply-nQ-gate state U qubits))) 122 | 123 | (defun sample (state) 124 | (let ((r (random 1.0d0))) 125 | (dotimes (i (length state)) 126 | (decf r (expt (abs (aref state i)) 2)) ; P(bitstring i) = |ψᵢ|² 127 | (when (minusp r) (return i))))) 128 | 129 | (defun collapse (state basis-element) 130 | (fill state 0.0d0) 131 | (setf (aref state basis-element) 1.0d0)) 132 | 133 | (defun observe (machine) 134 | (let ((b (sample (machine-quantum-state machine)))) 135 | (collapse (machine-quantum-state machine) b) 136 | (setf (machine-measurement-register machine) b) 137 | machine)) 138 | 139 | (defun run-quantum-program (qprog machine) 140 | (loop :for (instruction . payload) :in qprog 141 | :do (ecase instruction 142 | ((GATE) 143 | (destructuring-bind (gate &rest qubits) payload 144 | (apply-gate (machine-quantum-state machine) gate qubits))) 145 | ((MEASURE) 146 | (observe machine))) 147 | :finally (return machine))) 148 | --------------------------------------------------------------------------------