├── LICENSE ├── README.md ├── docs └── index.md ├── gate-compression.lisp ├── gui.lisp ├── packages.lisp ├── qgame.asd └── qgame.lisp /LICENSE: -------------------------------------------------------------------------------- 1 | The MIT License (MIT) 2 | 3 | Copyright (c) 2013 "the Phoeron" Colin J.E. Lupton 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy of 6 | this software and associated documentation files (the "Software"), to deal in 7 | the Software without restriction, including without limitation the rights to 8 | use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of 9 | the Software, and to permit persons to whom the Software is furnished to do so, 10 | subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS 17 | FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR 18 | COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER 19 | IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN 20 | CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 21 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # QGAME 2 | 3 | [![DOI](https://zenodo.org/badge/15455903.svg)](https://zenodo.org/badge/latestdoi/15455903) 4 | [![Quicklisp](http://quickdocs.org/badge/qgame.svg)](http://quickdocs.org/qgame/) 5 | [![MIT License](https://img.shields.io/badge/license-MIT-blue.svg)](./LICENSE) 6 | 7 | Lee Spector's QGAME: Quantum Gate and Measurement Emulator, a quantum computer simulator 8 | 9 | Unofficial Fork from http://faculty.hampshire.edu/lspector/qgame.html 10 | 11 | Updated for SBCL and ASDF/Quicklisp. Port of GUI to Qtools/CommonQt for next release. 12 | 13 | ## Introduction 14 | 15 | *From the original documentation*: 16 | 17 | QGAME (Quantum Gate And Measurement Emulator) is a system, that allows a user to run quantum computing algorithms on an ordinary digital computer. Because quantum computers have complexity advantages over classical computers, any classical emulator will necessarily be less efficient than the quantum computer that it is emulating. QGAME nonetheless allows the user to find out what outputs the quantum program would produce, and with what probabilities (since quantum computation is in general not deterministic). 18 | 19 | QGAME is based on the "quantum gate array" model of quantum computation, in which quantum "gates" (represented as square matrices) are applied to a register of qubits (via tensor product formation and matrix multiplication). QGAME always starts with all qubits having the value zero (in the state `|00...0>`), applies a sequence of gates, and returns values about the resulting state. Measurement gates cause the system to branch, following one execution path (with the appropriate quantum state collapse) for each possible value. Final measurements are made across the end-states of all of the resulting branches. 20 | 21 | ## Documentation 22 | 23 | Documentation is available at: http://thephoeron.viewdocs.io/qgame 24 | 25 | ## Usage 26 | 27 | Clone this project into `~/quicklisp/local-projects/`. 28 | 29 | ## System Requirements 30 | 31 | * SBCL 1.1.7+ 32 | * Quicklisp 33 | * Qtools 34 | 35 | ## License 36 | 37 | Copyright © 2000–2017, the Authors and contributors. Released under the MIT License. See `qgame/LICENSE` for more information. 38 | -------------------------------------------------------------------------------- /docs/index.md: -------------------------------------------------------------------------------- 1 | QGAME 2 | ===== 3 | 4 | DESCRIPTION 5 | ----------- 6 | 7 | QGAME (Quantum Gate And Measurement Emulator) is a system, written in 8 | Common Lisp, that allows a user to run quantum computing algorithms 9 | on an ordinary digital computer. Because quantum computers have complexity 10 | advantages over classical computers, any classical emulator will necessarily 11 | be less efficient than the quantum computer that it is emulating. 12 | QGAME nonetheless allows the user to find out what outputs the quantum 13 | program would produce, and with what probabilities (since quantum 14 | computation is in general not deterministic). 15 | 16 | QGAME was developed for use in conjunction with a genetic programming 17 | system, to allow for the evolution of new quantum algorithms, but 18 | it can be useful for testing quantum algorithms regardless of their 19 | origin. 20 | 21 | QGAME is based on the "quantum gate array" model of quantum computation, 22 | in which quantum "gates" (represented as square matrices) are applied 23 | to a register of qubits (via tensor product formation and matrix 24 | multiplication). QGAME always starts with all qubits having the 25 | value zero (in the state |00...0>), applies a sequence of gates, 26 | and returns values about the resulting state. Measurement gates 27 | cause the system to branch, following one execution path (with the 28 | appropriate quantum state collapse) for each possible value. Final 29 | measurements are made across the end-states of all of the resulting 30 | branches. 31 | 32 | Most interesting quantum algorithms involve calling an "oracle" or 33 | "black box" function of which one is trying to determine some 34 | property. QGAME supports only boolean oracles (that is, with single 35 | qubit output), but it allows the user to specify any such oracle 36 | and to indicate the desired system output for each specified 37 | oracle. Oracles are implemented in the standard way, by applying 38 | a (unitary) quantum "NOT" gate on the output qubit wherever the 39 | oracle's truth table indicates a "1". 40 | 41 | The primary user-level function is TEST-QUANTUM-PROGRAM which takes 42 | a quantum program (described below) and the following keyword 43 | arguments: 44 | 45 | :num-qubits 46 | -- the number of qubits in the system 47 | :cases 48 | -- a list of (oracle-truth-table output) pairs, where each 49 | oracle-truth-table is a list of 0s and 1s specifying the 50 | right-hand (output) column of the oracle's output (where 51 | the rows are listed in binary order for the input qubits), 52 | and where the output is the integer that one would like 53 | to be measured across the final measurement qubits at 54 | the end of the computation 55 | :final-measurement-qubits 56 | -- a list of the qubits upon which final measurements will be 57 | performed, with the most significant qubit listed first 58 | and the least significant qubit listed last 59 | :threshold 60 | -- the probability of error below which a run is considered 61 | successful for the sake of the "hits" component of the 62 | return value (see below) 63 | :debug 64 | -- 0 for no debugging info, 1 for some debugging info, 65 | 2 for more debugging info 66 | :inspect 67 | -- if non-nil, causes the inspector to be invoked on all 68 | resulting quantum states 69 | 70 | TEST-QUANTUM-PROGRAM returns a list containing the following 71 | values: 72 | 73 | - the number of "misses" -- that is, cases in which the measured 74 | value will, with probability greater than the specified threshold, 75 | fail to equal the desired output 76 | - the maximum error for any provided case 77 | - the average error for all provided cases 78 | - the maximum number of expected oracle calls across all cases 79 | - the number of expected oracle calls averaged across all cases 80 | 81 | A quantum program is specified as a list of the forms listed below. See 82 | the documentation forms within function definitions and the function 83 | definitions themselves for more information on the quantum gates, including 84 | their matrix expressions. 85 | 86 | (QNOT ) 87 | -- applies a quantum NOT gate to the specified qubit 88 | 89 | (CNOT ) 90 | -- applies a quantum controlled NOT gate to the specified control 91 | and target qubits 92 | 93 | (SRN ) 94 | -- applies a quantum square-root-of-NOT gate to the specified qubit 95 | 96 | (NAND ) 97 | -- applies a quantum NAND gate to the specified input and output qubits 98 | 99 | (HADAMARD ) 100 | -- applies a Hadamard gate to the specified qubit 101 | 102 | (U-THETA ) 103 | -- applies a rotation gate with the specified (real-valued) angle theta 104 | to the specified qubit 105 | 106 | (CPHASE-OLD ) 107 | -- one version of a controlled phase gate -- see the definition for the 108 | matrix 109 | 110 | (CPHASE ) 111 | -- another (probably preferable) version of a controlled phase gate -- 112 | see the definition for the matrix 113 | 114 | (U2 ) 115 | -- a general rotation gate for a single qubit with 4 real-valued 116 | parameters -- see the definition for the matrix 117 | 118 | (SWAP ) 119 | -- applies a gate that swaps the amplitudes of the two specified qubits 120 | 121 | (ORACLE ORACLE-TT ... ) 122 | -- calls the oracle on the specified input qubits (specified as "q"s 123 | above) and the specified output qubit. The input qubits are listed 124 | most significant first. Note that "ORACLE-TT" must appear as 125 | a literal symbol in the call -- this will be replaced with the 126 | oracle's truth table before execution. 127 | 128 | (LIMITED-ORACLE ORACLE-TT ... ) 129 | -- like ORACLE but with one additional argument, max-calls, which should 130 | be a positive integer. If the provided number of oracle calls has 131 | already been made by the time this instruction is executed then it 132 | will have no effect. 133 | 134 | (MEASURE ) <1-branch> (END) <0-branch> (END) 135 | -- causes a measurement-based branch in the execution of the quantum 136 | program. In one branch the state will be collapsed as if "1" was 137 | read from the specified qubit, the 1-branch code will be executed 138 | and the 0-branch code will be skipped. In the other branch the 139 | state will be collapsed as if "0" was read from the specified qubit, 140 | the 0-branch code will be executed and the 1-branch code will be 141 | skipped. Measurement structures can be nested within the branches 142 | of other measurement structures. If there is no second END then 143 | execution in the 1 case terminates after execution of the 1-branch. 144 | If there is no first END then there is no 0-branch. Unmatched ENDs 145 | are ignored. 146 | 147 | (HALT) 148 | -- causes the executing quantum system to halt execution (to execute 149 | no further instructions) 150 | 151 | (PRINTAMPS) 152 | -- causes the amplitudes of the executing quantum system to be printed 153 | 154 | (INSP) 155 | -- causes the inspector to be invoked on the executing quantum system 156 | 157 | See the comment at the bottom of this file for some examples. 158 | 159 | 160 | VERSION HISTORY 161 | --------------- 162 | 163 | Version 1 was adapted from "qc-sim", a simulator that only allowed "measure 164 | and stop or continue" measurements, in late November 1999. The slowdown from 165 | non-branching (measure and stop/continue) simulator appears to be ~30% for a 166 | 2-intermediate-measurement 2-bit and-or algorithm (one of the examples below). 167 | 168 | May 30, 2000: Added more explicit 'long float' declarations to minimize 169 | roundoff errors under Allegro. NOTE: It is also necessary to ensure that 170 | float args to gates are longs to avoid these roundoff errors. 171 | 172 | November 13, 2000: Fixed bug in calculation of prior probabilities upon 173 | branching (was multiplying by parent's prior probability, which shouldn't 174 | be done). Impact should only have been for calculating expected number of oracle 175 | calls. 176 | 177 | July 24, 2002: Cosmetic improvements for distribution. 178 | 179 | December 26, 2003: Fixed documentation of LIMITED-ORACLE 180 | 181 | EXAMPLES 182 | -------- 183 | 184 | To run each example evaluate the relevant definition and then call the function 185 | with or without a debugging argument (which should be 0 for no debugging info, 186 | 1 for a little debugging info, and 1 for a lot of debugging info). For example, 187 | after evaluating the test-herbs-grover function definition you could try the 188 | following calls: 189 | 190 | ```lisp 191 | (test-herbs-grover) ;; for no debugging info 192 | (test-herbs-grover 1) ;; for some debugging info (just results) 193 | (test-herbs-grover 2) ;; for more debugging info 194 | ``` 195 | 196 | ```lisp 197 | (defun test-branching (&optional (debug 0)) 198 | "Creates 4 final quantum systems and invokes the inspector on each." 199 | (test-quantum-program 200 | `((hadamard 0) 201 | (measure 0) 202 | (hadamard 1) 203 | (measure 1) 204 | (end) 205 | (end) 206 | (end) 207 | (hadamard 2) 208 | (measure 2) 209 | (end) 210 | (end) 211 | (end) 212 | ) 213 | :num-qubits 3 214 | :cases '(((1 0) 0)) ;; an arbitrary case, just so it'll run 215 | :final-measurement-qubits (list 0) 216 | :threshold 0.48 217 | :debug debug 218 | :inspect t)) 219 | 220 | (test-branching) 221 | ``` 222 | 223 | ```lisp 224 | (defun test-herbs-grover (&optional (debug 0)) 225 | "Tests Herb Bernstein's version of Grover's quantum database search 226 | algorithm for a 4 item database on all four 'single marked item' test 227 | cases." 228 | (test-quantum-program 229 | `((hadamard 2) 230 | (hadamard 1) 231 | (u-theta 0 ,(/ pi 4)) 232 | (oracle ORACLE-TT 2 1 0) 233 | (hadamard 2) 234 | (cnot 2 1) 235 | (hadamard 2) 236 | (u-theta 2 ,(/ pi 2)) 237 | (u-theta 1 ,(/ pi 2)) 238 | ) 239 | :num-qubits 3 240 | :cases '(((1 0 0 0) 0) 241 | ((0 1 0 0) 1) 242 | ((0 0 1 0) 2) 243 | ((0 0 0 1) 3)) 244 | :final-measurement-qubits (list 2 1) 245 | :threshold 0.48 246 | :debug debug 247 | :inspect nil)) 248 | 249 | (test-herbs-grover 1) 250 | (test-herbs-grover 2) 251 | ``` 252 | 253 | ```lisp 254 | (defun test-evolved-grover (&optional (debug 0)) 255 | "Tests an evolved version of Grover's quantum database search 256 | algorithm (evolved with lgp2) for a 4 item database on all four 257 | 'single marked item' test cases." 258 | (test-quantum-program 259 | `((U-THETA 0 3.926990816987241) 260 | (HADAMARD 1) 261 | (U-THETA 2 -8.63937979737193) 262 | (ORACLE ORACLE-TT 2 1 0) 263 | (CPHASE 1 2 3.141592653589793) 264 | (CNOT 0 2) 265 | (HADAMARD 0) 266 | (U2 0 0.0 2.356194490192345 -3.4033920413889427 0) 267 | (HADAMARD 0) 268 | (U-THETA 1 2.356194490192345)) 269 | :num-qubits 3 270 | :cases '(((1 0 0 0) 0) 271 | ((0 1 0 0) 1) 272 | ((0 0 1 0) 2) 273 | ((0 0 0 1) 3)) 274 | :final-measurement-qubits (list 1 0) 275 | :threshold 0.48 276 | :debug debug 277 | :inspect nil)) 278 | 279 | (test-evolved-grover 1) 280 | (test-evolved-grover 2) 281 | ``` 282 | 283 | ```lisp 284 | (defun test-evolved-and-or (&optional (debug 0)) 285 | (test-quantum-program 286 | '((U2 2 -6.088543013651391 -34.36116964863836 -7.682902920850156 0.0013517818812377553) 287 | (U-THETA 2 94.46204015939107) 288 | (HADAMARD 0) 289 | (HADAMARD 1) 290 | (ORACLE ORACLE-TT 1 0 2) 291 | (U-THETA 2 -54.494324298211346) 292 | (HADAMARD 0) 293 | (MEASURE 0) 294 | (swap 2 0) 295 | (halt) 296 | (end) 297 | (U2 2 -0.20450950372104815 -34.76200757140856 -7.856634973508906 -0.04960986541249215) 298 | (U-THETA 2 190.24766604570047) 299 | (MEASURE 2) 300 | (HADAMARD 2) 301 | (CNOT 2 1) 302 | (U-THETA 2 3.9269907773297987) 303 | ) 304 | :num-qubits 3 305 | :cases '(((0 0 0 0) 0) 306 | ((0 0 0 1) 0) 307 | ((0 0 1 0) 0) 308 | ((0 0 1 1) 0) 309 | ((0 1 0 0) 0) ((0 1 0 1) 1) ((0 1 1 0) 1) ((0 1 1 1) 1) 310 | ((1 0 0 0) 0) ((1 0 0 1) 1) ((1 0 1 0) 1) ((1 0 1 1) 1) 311 | ((1 1 0 0) 0) ((1 1 0 1) 1) ((1 1 1 0) 1) ((1 1 1 1) 1) 312 | ) 313 | :final-measurement-qubits (list 2) 314 | :threshold 0.48 315 | :debug debug 316 | :inspect nil)) 317 | 318 | (test-evolved-and-or 1) 319 | (test-evolved-and-or 2) 320 | ``` 321 | -------------------------------------------------------------------------------- /gate-compression.lisp: -------------------------------------------------------------------------------- 1 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2 | ;; gate-compression.lisp 3 | ; #| 4 | 5 | ; c) 1999-2004, Lee Spector (lspector@hampshire.edu) 6 | 7 | ; This code augments the Common Lisp version of the QGAME (Quantum Gate And 8 | ; Measurement Emulator) with the MATRIX-GATE gate form and functions for 9 | ; compressing a sequence of gates into single MATRIX-GATE form that applies 10 | ; the unitary matrix built from the elements of the sequence. Also included 11 | ; is a function for checking the unitarity of a matrix -- this is used to 12 | ; ensure that round-off errors during compression do not produce physicially 13 | ; impossible results. 14 | 15 | ; Example calls are provided at the end of this file. 16 | 17 | ; QGAME and related documentation is distributed from: 18 | 19 | ; http://hampshire.edu/lspector/qgame.html 20 | 21 | ; See also: 22 | 23 | ; Spector, Lee. 2004. Automatic Quantum Computer Programming: A Genetic 24 | ; Programming Approach. Boston/Dordrecht/New York/London: Kluwer Academic 25 | ; Publishers. 26 | 27 | ; Version history: 28 | ; Original sources from qc-matrices/matrices.lisp 29 | ; Oct 5 1999, made compatible with limited-oracle 30 | ; Nov 12 2003, many updates, disentangled from LGP 31 | ; May 26 2004, cosmetic changes for distribution 32 | 33 | ; |# 34 | 35 | (in-package :qgame) 36 | 37 | ;; compiler optimization settings 38 | 39 | ; for debugging 40 | ; (eval-when (compile) 41 | ; (declaim (optimize (speed 2) (safety 1) (space 1) (debug 3)))) 42 | 43 | ; for maximum reasonably safe speed 44 | (eval-when (compile) 45 | (declaim (optimize (speed 3) (safety 1) (space 0) (debug 0)))) 46 | 47 | (defparameter *max-depth-for-compression* 5) 48 | (defparameter *max-depth-for-history* 5) 49 | (defparameter *uncompressible* (list 'oracle 'limited-oracle 'measure 'end 'halt)) 50 | (defvar *NUMBER-OF-QUBITS*) 51 | (defvar *ALL-QUBITS*) 52 | 53 | (defun matrix-matrix-multiply (matrix1 matrix2) 54 | "Returns the result of multiplying (matrix1 X matrix2), where all 55 | matrices are implemented as square arrays." 56 | (let* ((matrix-size (car (array-dimensions matrix1))) 57 | (result (make-array (list matrix-size matrix-size)))) 58 | (dotimes (i matrix-size) 59 | (dotimes (j matrix-size) 60 | (setf (aref result i j) 61 | (let ((element 0)) 62 | (dotimes (k matrix-size) 63 | (incf element 64 | (* (aref matrix1 i k) 65 | (aref matrix2 k j)))) 66 | element)))) 67 | result)) 68 | 69 | (defun expand-matrix (gate targets) 70 | "Expands the operator matrix gate to a full matrix for operating 71 | on a system of *number-of-qubits* qubits, with the operator being applied 72 | to the qubits specified in targets. Written by Lee Spector, 1999. 73 | Targets reversal added Sept 8, 1999." 74 | (let* ((targets (reverse targets)) 75 | (m-size (expt 2 *number-of-qubits*)) 76 | (m (make-array (list m-size m-size))) 77 | (non-targets (loop for i from 0 to (- *number-of-qubits* 1) 78 | unless (member i targets) 79 | collect i))) 80 | (dotimes (i m-size) 81 | (dotimes (j m-size) 82 | (setf (aref m i j) 83 | (if (=in-positions non-targets i j) 84 | (aref gate 85 | (extract@positions targets i) 86 | (extract@positions targets j)) 87 | 0)))) 88 | m)) 89 | 90 | (defun =in-positions (positions int1 int2) 91 | "Returns non-nil if int1 and int2 are have the same bits at all 92 | positions in positions. Written by Lee Spector, 1999." 93 | (every #'(lambda (index) 94 | (eq (logbitp index int1) 95 | (logbitp index int2))) 96 | positions)) 97 | 98 | (defun extract@positions (positions int) 99 | "Returns the number formed by extracting and concatenating 100 | the bits of int indexed by the positions in positions. 101 | Written by Lee Spector, 1999." 102 | (let ((exponent -1)) 103 | (loop for index in positions 104 | do (incf exponent) 105 | when (logbitp index int) 106 | sum (expt 2 exponent)))) 107 | 108 | (defun coerce-to-long-float (n) 109 | "Returns the number n coerced to a long float." 110 | (coerce n 'long-float)) 111 | 112 | (defun expand-gate-form (gate-form) 113 | "Returns the expanded matrix corresponding to the provided 114 | gate-form, which should conform to the QGAME interface syntax." 115 | (case (first gate-form) 116 | (qnot (expand-matrix #2A((0 1) (1 0)) (cdr gate-form))) 117 | (cnot (expand-matrix #2A((1 0 0 0) 118 | (0 1 0 0) 119 | (0 0 0 1) 120 | (0 0 1 0)) 121 | (cdr gate-form))) 122 | (swap (expand-matrix #2A((1 0 0 0) 123 | (0 0 1 0) 124 | (0 1 0 0) 125 | (0 0 0 1)) 126 | (cdr gate-form))) 127 | (hadamard (expand-matrix (make-array 128 | '(2 2) 129 | :initial-contents 130 | (list (list (/ 1 (sqrt 2.0L0)) (/ 1 (sqrt 2.0L0))) 131 | (list (/ 1 (sqrt 2.0L0)) (- (/ 1 (sqrt 2.0L0)))))) 132 | (cdr gate-form))) 133 | (srn (expand-matrix (make-array 134 | '(2 2) 135 | :initial-contents 136 | (list (list (/ 1 (sqrt 2.0L0)) (- (/ 1 (sqrt 2.0L0)))) 137 | (list (/ 1 (sqrt 2.0L0)) (/ 1 (sqrt 2.0L0))) 138 | )) 139 | (cdr gate-form))) 140 | (u-theta (expand-matrix (let ((theta (coerce-to-long-float (third gate-form)))) 141 | (make-array '(2 2) 142 | :initial-contents 143 | (list (list (cos theta) (sin theta)) 144 | (list (- (sin theta)) (cos theta))))) 145 | (list (second gate-form)))) 146 | (cphase (expand-matrix (let ((alpha (coerce-to-long-float (fourth gate-form)))) 147 | (make-array '(4 4) 148 | :initial-contents 149 | (list (list 1 0 0 0) 150 | (list 0 1 0 0) 151 | (list 0 0 1 0) 152 | (list 0 0 0 (exp (* (sqrt -1) alpha)))))) 153 | (list (second gate-form) (third gate-form)))) 154 | (u2 (expand-matrix (let ((phi (coerce-to-long-float (third gate-form))) 155 | (theta (coerce-to-long-float (fourth gate-form))) 156 | (psi (coerce-to-long-float (fifth gate-form))) 157 | (alpha (coerce-to-long-float (sixth gate-form))) 158 | (i (sqrt -1))) 159 | (make-array 160 | '(2 2) 161 | :initial-contents 162 | (list (list (* (exp (* i (+ (- phi) (- psi) alpha))) (cos theta)) 163 | (* (exp (* i (+ (- phi) psi alpha))) (sin (- theta)))) 164 | (list (* (exp (* i (+ phi (- psi) alpha))) (sin theta)) 165 | (* (exp (* i (+ phi psi alpha))) (cos theta)))))) 166 | (list (second gate-form)))) 167 | (matrix-gate (second gate-form)))) 168 | 169 | (defun matrix-gate (qsys matrix history) 170 | "Implements the MATRIX-GATE gate form; applies the given matrix to 171 | the given quantum system." 172 | (declare (ignore history)) 173 | (apply-operator qsys 174 | matrix 175 | (reverse *All-Qubits*))) 176 | 177 | (defun max-depth (tree) 178 | "Returns the maximum depth of the given tree." 179 | (if (not (listp tree)) 180 | 0 181 | (1+ (apply #'max (mapcar #'max-depth tree))))) 182 | 183 | (defun process-for-history (gate-sequence) 184 | "Removes actual matrices from histories containing matrix-gate forms, 185 | substituting a COMPRESSED form with only the prior history. Punts and 186 | returns TOO-DEEP if the depth is greater than *max-depth-for-history*." 187 | (if (> (max-depth gate-sequence) *max-depth-for-history*) 188 | 'too-deep 189 | (mapcar #'(lambda (gate-form) 190 | (if (eq (car gate-form) 'matrix-gate) 191 | (list 'compressed (third gate-form)) 192 | gate-form)) 193 | gate-sequence))) 194 | 195 | (defun compress-compressible-gate-sequence (seq) 196 | "Compresses a sequence of gate forms into a single MATRIX-GATE form. 197 | Assumes all gates can be expanded. Returns seq if the check for unitarity 198 | fails for the compression result." 199 | (cond ((<= (length seq) 1) ;; don't compress a single gate 200 | seq) 201 | ((> (max-depth seq) *max-depth-for-compression*) 202 | seq) 203 | (t (let ((composite-matrix (expand-matrix #2A((1 0)(0 1)) nil))) 204 | ;; start with identity 205 | (dolist (gate-form seq) 206 | (setq composite-matrix 207 | (matrix-matrix-multiply (expand-gate-form gate-form) 208 | composite-matrix))) 209 | (if (> (check-unitarity composite-matrix) 1.0E-10) 210 | ;; errors too high 211 | seq 212 | ;; errors OK 213 | (list (list 'matrix-gate 214 | composite-matrix 215 | (process-for-history seq)))))))) 216 | 217 | (defun thoroughly-compress-compressible-gate-sequence (seq) 218 | "Just like compress-compressible-gate-sequence except compresses even 219 | single gates into matrix-gates." 220 | (cond ((> (max-depth seq) *max-depth-for-compression*) 221 | seq) 222 | (t (let ((composite-matrix (expand-matrix #2A((1 0)(0 1)) nil))) 223 | ;; start with identity 224 | (dolist (gate-form seq) 225 | (setq composite-matrix 226 | (matrix-matrix-multiply (expand-gate-form gate-form) 227 | composite-matrix))) 228 | (if (> (check-unitarity composite-matrix) 1.0E-10) 229 | ;; errors too high 230 | seq 231 | ;; errors OK 232 | (list (list 'matrix-gate 233 | composite-matrix 234 | (process-for-history seq)))))))) 235 | 236 | (defun compress-gates (program &optional (pending nil)) 237 | "Returns a version of the given program in which all compressible 238 | sequences of gates are compressed into MATRIX-GATE forms. Leaves 239 | single-gate sequences unchanged." 240 | (cond ((null program) 241 | (if pending 242 | (compress-compressible-gate-sequence pending) 243 | nil)) 244 | ((member (caar program) *uncompressible*) 245 | (if pending 246 | (append (compress-compressible-gate-sequence pending) 247 | (cons (car program) (compress-gates (cdr program)))) 248 | (cons (car program) (compress-gates (cdr program))))) 249 | (t (compress-gates (cdr program) 250 | (append pending (list (car program))))))) 251 | 252 | (defun thoroughly-compress-gates (program &optional (pending nil)) 253 | "Returns a version of the given program in which all compressible 254 | sequences of gates are compressed into MATRIX-GATE forms. Unlike 255 | COMPRESS-GATES, this function converts even single-gate sequences 256 | into MATRIX-GATE forms." 257 | (cond ((null program) 258 | (if pending 259 | (thoroughly-compress-compressible-gate-sequence pending) 260 | nil)) 261 | ((member (caar program) *uncompressible*) 262 | (if pending 263 | (append (thoroughly-compress-compressible-gate-sequence pending) 264 | (cons (car program) (thoroughly-compress-gates (cdr program)))) 265 | (cons (car program) (thoroughly-compress-gates (cdr program))))) 266 | (t (thoroughly-compress-gates (cdr program) 267 | (append pending (list (car program))))))) 268 | 269 | (defun check-unitarity (m) 270 | "Returns the cumulative difference of each element of (m times m*) (where 271 | m* is the conjugate transpose of m) from the corresponding element of the 272 | identity matrix. This will be 0 for a unitary matrix." 273 | (let* ((dim (car (array-dimensions m))) 274 | (m* (make-array (list dim dim))) ;; conjugate transpose of m 275 | (identity (make-array (list dim dim))) 276 | (product nil) 277 | (cumulative-error 0)) 278 | ;; set up identity matrix 279 | (dotimes (i dim) 280 | (dotimes (j dim) 281 | (setf (aref identity i j) (if (= i j) 1 0)))) 282 | ;; set up m* 283 | (dotimes (i dim) 284 | (dotimes (j dim) 285 | (setf (aref m* i j) 286 | (conjugate (aref m j i))))) 287 | ;; multiply 288 | (setq product (matrix-matrix-multiply m m*)) 289 | ;(print product) 290 | ;; sum error 291 | (dotimes (i dim) 292 | (dotimes (j dim) 293 | (incf cumulative-error 294 | (abs (- (aref product i j) 295 | (aref identity i j)))))) 296 | cumulative-error)) 297 | 298 | 299 | #| 300 | 301 | EXAMPLES 302 | 303 | ;; this must be set prior to any actual compressions 304 | (setq *NUMBER-OF-QUBITS* 3) 305 | 306 | ;; this will do nothing because no compression of a single gate is possible 307 | (compress-gates '((hadamard 0))) 308 | 309 | ;; this will "compress" the single gate into a matrix gate form anyway 310 | (thoroughly-compress-gates '((hadamard 0))) 311 | 312 | ;; compression of two hadamards 313 | (compress-gates '((hadamard 0) (hadamard 1))) 314 | 315 | ;; something more complex 316 | (compress-gates 317 | '((hadamard 0) (hadamard 1) (cnot 1 2) (u-theta 1 0.12345))) 318 | 319 | ;; Check the unitarity of the matrix from the above call (which is 320 | ;; the second item in the first form in the resulting sequence); 321 | ;; this will be close to zero for a unitary matrix. 322 | (check-unitarity 323 | (second (first 324 | (compress-gates 325 | '((hadamard 0) (hadamard 1) (cnot 1 2) (u-theta 1 0.12345)))))) 326 | 327 | |# 328 | 329 | ;; EOF 330 | -------------------------------------------------------------------------------- /gui.lisp: -------------------------------------------------------------------------------- 1 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2 | ;; qgame-gui.lisp 3 | ;; c) 2000-2002, Lee Spector, lspector@hampshire.edu 4 | ;; 5 | ;; This file contains some quick hacks to make a GUI for QGAME, a quantum 6 | ;; computer simulator. This will work only under Macintosh Common Lisp 7 | ;; (see http://www.digitool.com). Warning: this code (for the GUI) was 8 | ;; hastily written and is poorly documented (although some usage notes 9 | ;; follow below). 10 | 11 | ;; Revised December 2002: Now works under MCL 5.0/MacOS X 12 | 13 | ;; December 26, 2013: Need to rewrite GUI code for LTK --the Phoeron 14 | #| 15 | 16 | QGAME-GUI Notes 17 | 18 | See the comment at the top of qgame.lisp for an introduction to the 19 | QGAME emulator. 20 | 21 | The QGAME graphical user interface (GUI) is a quick hack intended 22 | to allow people with no knowledge of Lisp to experiment with QGAME. 23 | It uses Macintosh Common Lisp (MCL) interface code and will work only 24 | under MacOS with MCL. Not all features of QGAME are available from 25 | the GUI. One uses the GUI by typing (or pasting) a program into the 26 | "QGAME Program" dialog and clicking on the "Run" button. The amplitudes 27 | can be monitored during the run as described below. The probabilities 28 | of reading the system in any given state at the end of the computation 29 | are printed in the "Listener" window at the end of the run -- the 30 | probabilities are listed in the same order that the amplitudes are 31 | listed in the amplitude display windows. 32 | 33 | TO USE: first load qgame.lisp and then load this file. You'll see 34 | a couple of warnings as functions defined in qgame.lisp are re-defined 35 | here -- that's normal; don't worry. Test the system by pasting some 36 | of the examples from the end of these notes into the "QGAME Program" 37 | window and clicking "Run." 38 | 39 | A quantum program is specified as a list of the instructions listed 40 | below. The MATRIX-GATE form allows for the specification of an arbitrary 41 | matrix operator. The documentation for most instructions includes a 42 | description of the corresponding gate's matrix; those in Lisp array 43 | notation (beginning with #2A) can be used directly in calls to MATRIX-GATE 44 | (the others were too messy when expressed in this way so I wrote them more 45 | readably). A line of instructions can be "commented out" with a semicolon 46 | (";") at the beginning of a line. Notations in angle brackets ("<>") are 47 | to be replaced by appropriate values -- the brackets themselves should NOT 48 | be included. Code can be indented for readability -- this has no effect 49 | on execution. 50 | 51 | The GUI is not "bullet proofed" at all -- it will be easy to break it and 52 | end up in a Lisp error loop. If this happens and you don't know how 53 | to fix it your best bet is to quit and restart Lisp. If for some reason 54 | you close the "QGAME Program" window you can re-create it by typing 55 | (make-program-dialog) and hitting "return" in the "Listener" window. 56 | 57 | Programs are not automatically saved. You should cut and paste them from/to 58 | text files which you save independently. 59 | 60 | You can find out the exact amplitude for a component of the quantum state 61 | by clicking on the colored state indicators. Click again on the amplitude 62 | to make it go away. Note that you can click to see the amplitudes while 63 | the program is running -- you may want to increase the delay to give yourself 64 | time to do this. The simulation will pause while you look at an amplitude 65 | and will resume when you click on it to make it go away. When you see an 66 | amplitude that looks something like #c(0.0 1.4142135623730951) you are 67 | seeing a complex number. The first number within the #c(...) is the real 68 | part of the number, while the second number is the imaginary part. So 69 | #c(0.0 1.4142135623730951) has a real part of 0.0 and an imaginary part 70 | of 1.4142135623730951. This particular complex number is the square root 71 | of -2.0. Sometimes you will see #c(0.0 0.0) -- this is just zero, but it 72 | is being expressed in complex form because that amplitude previously had 73 | some non-zero complex value. 74 | 75 | When a program branches (due to a measurement) the title bars of the 76 | resulting amplitude display windows show the probability that the 77 | system will end up in that computational path. 78 | 79 | The GUI was designed to look reasonably good with 2 to 4 qubit systems. 80 | It doesn't scale correctly for 1 qubit systems (you can't really see the 81 | program or measurements), and larger systems will probably go off your 82 | screen (and they can't be scrolled). 83 | 84 | A few examples are presented after the list of instructions. 85 | 86 | 87 | INSTRUCTIONS 88 | ------------ 89 | 90 | (QNOT ) 91 | -- applies a quantum NOT gate to the specified qubit 92 | matrix: #2A((0 1) 93 | (1 0)) 94 | 95 | (CNOT ) 96 | -- applies a quantum controlled NOT gate to the specified control 97 | and target qubits 98 | matrix: #2A((1 0 0 0) 99 | (0 1 0 0) 100 | (0 0 0 1) 101 | (0 0 1 0)) 102 | 103 | (SRN ) 104 | -- applies a quantum square-root-of-NOT gate to the specified qubit 105 | matrix: 1/sqrt(2) -1/sqrt(2) 106 | 1/sqrt(2) 1/sqrt(2) 107 | 108 | (NAND ) 109 | -- applies a quantum NAND gate to the specified input and output qubits 110 | matrix: #2A((0 1 0 0 0 0 0 0) 111 | (1 0 0 0 0 0 0 0) 112 | (0 0 0 1 0 0 0 0) 113 | (0 0 1 0 0 0 0 0) 114 | (0 0 0 0 0 1 0 0) 115 | (0 0 0 0 1 0 0 0) 116 | (0 0 0 0 0 0 1 0) 117 | (0 0 0 0 0 0 0 1)) 118 | 119 | (HADAMARD ) 120 | -- applies a Hadamard gate to the specified qubit 121 | matrix: 1/sqrt(2) 1/sqrt(2) 122 | 1/sqrt(2) -1/sqrt(2) 123 | 124 | (U-THETA ) 125 | -- applies a rotation gate with the specified (real-valued) angle theta 126 | to the specified qubit 127 | matrix: cos(theta) sin(theta) 128 | -sin(theta) cos(theta) 129 | 130 | (CPHASE ) 131 | -- a controlled phase gate 132 | matrix: 1 0 0 0 133 | 0 1 0 0 134 | 0 0 1 0 135 | 0 0 0 e^(i*alpha) 136 | 137 | (U2 ) 138 | -- a general rotation gate for a single qubit with 4 real-valued 139 | parameters 140 | matrix: 141 | e^(i(-phi-psi+alpha))*cos(theta) e^(i(-phi+psi+alpha))*sin(-theta) 142 | e^(i(phi-psi+alpha))*sin(theta) e^(i(phi+psi+alpha))*cos(theta) 143 | 144 | (SWAP ) 145 | -- applies a gate that swaps the amplitudes of the two specified qubits 146 | matrix: #2A((1 0 0 0) 147 | (0 0 1 0) 148 | (0 1 0 0) 149 | (0 0 0 1)) 150 | 151 | (MEASURE ) <1-branch> (END) <0-branch> (END) 152 | -- causes a measurement-based branch in the execution of the quantum 153 | program. In one branch the state will be collapsed as if "1" was 154 | read from the specified qubit, the 1-branch code will be executed 155 | and the 0-branch code will be skipped. In the other branch the 156 | state will be collapsed as if "0" was read from the specified qubit, 157 | the 0-branch code will be executed and the 1-branch code will be 158 | skipped. Measurement structures can be nested within the branches 159 | of other measurement structures. If there is no second END then 160 | execution in the 1 case terminates after execution of the 1-branch. 161 | If there is no first END then there is no 0-branch. Unmatched ENDs 162 | are ignored. 163 | 164 | (HALT) 165 | -- causes the executing quantum system to halt execution (to execute 166 | no further instructions) 167 | 168 | (PRINTAMPS) 169 | -- causes the amplitudes of the executing quantum system to be printed 170 | 171 | (INSP) 172 | -- causes the inspector to be invoked on the executing quantum system 173 | 174 | 175 | 176 | EXAMPLES 177 | -------- 178 | 179 | ;; some simple bit flipping (3 qubit system) 180 | (qnot 0) 181 | (qnot 1) 182 | (qnot 2) 183 | (qnot 1) 184 | (qnot 0) 185 | (qnot 2) 186 | 187 | ;; bit flipping with explicit matrix gates 188 | (matrix-gate #2A((0 1) 189 | (1 0)) 190 | 0) 191 | (matrix-gate #2A((0 1) 192 | (1 0)) 193 | 1) 194 | (matrix-gate #2A((0 1) 195 | (1 0)) 196 | 2) 197 | 198 | ;; with some controlled nots (3 qubit system) 199 | (qnot 0) 200 | (cnot 0 1) 201 | (cnot 1 2) 202 | (qnot 0) 203 | (cnot 0 1) 204 | (cnot 0 2) 205 | 206 | ;; with an initial Hadamard (3 qubit system) 207 | (hadamard 0) 208 | (cnot 0 1) 209 | (cnot 1 2) 210 | (qnot 0) 211 | (cnot 0 1) 212 | (cnot 0 2) 213 | 214 | ;; square-root-of-not test (3 qubit system) 215 | (srn 0) 216 | (srn 1) 217 | (srn 2) 218 | (srn 0) 219 | (srn 1) 220 | (srn 2) 221 | 222 | ;; with a measurement (3 qubit system) 223 | ;; note: the indentation is just for readability 224 | (hadamard 0) 225 | (measure 0) 226 | (cnot 0 1) 227 | (end) 228 | (cnot 0 2) 229 | (end) 230 | 231 | ;; nested measurements (3 qubit system) 232 | ;; note: the indentation is just for readability 233 | (hadamard 0) 234 | (measure 0) 235 | (hadamard 1) 236 | (measure 1) 237 | (end) 238 | (end) 239 | (end) 240 | (hadamard 2) 241 | (measure 2) 242 | (end) 243 | (end) 244 | (end) 245 | 246 | ;; crazy rotations (3 qubit system) 247 | (u-theta 0 3.9) 248 | (hadamard 1) 249 | (u-theta 2 -8.6) 250 | (cnot 0 2) 251 | (hadamard 0) 252 | (u2 0 0.0 2.3 -3.4 0) 253 | (hadamard 0) 254 | (u-theta 1 2.3) 255 | 256 | ;; more colors (3 qubit system) 257 | (u2 2 -6.1 -34.3 -7.68 0.001) 258 | (u-theta 2 94.4) 259 | (hadamard 0) 260 | (hadamard 1) 261 | (u-theta 2 -54.5) 262 | (hadamard 0) 263 | (cphase 1 2 2.123) 264 | (u-theta 2 94.4) 265 | (swap 2 0) 266 | (u2 2 -0.2 -34.76 -7.85 -0.049) 267 | (u-theta 2 190.24) 268 | (hadamard 2) 269 | (cnot 2 1) 270 | (u-theta 2 3.9) 271 | 272 | |# 273 | 274 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 275 | ;; source code for the gui 276 | 277 | 278 | (defclass visible-quantum-system (quantum-system) 279 | ((qsys-view :accessor qsys-view :initarg qsys-view) 280 | (amplitude-items :accessor amplitude-items) 281 | (amplitude-label-item :accessor amplitude-label-item) 282 | (program-item :accessor program-item) 283 | (program-label-item :accessor program-label-item) 284 | (measurements-item :accessor measurements-item) 285 | (measurements-label-item :accessor measurements-label-item))) 286 | 287 | 288 | (defparameter *qgame-gui-qubits* 5) 289 | (defparameter *qgame-gui-num-amps* (expt 2 *qgame-gui-qubits*)) 290 | (defparameter *qgame-font* '("Helvetica" 32 :SRCOR :BOLD (:COLOR-INDEX 0))) 291 | (defparameter *qgame-program-font* '("Monaco" 9 :SRCOR :PLAIN (:COLOR-INDEX 0))) 292 | (defparameter *amplitude-item-height* (second *qgame-font*)) 293 | (defparameter *amplitude-item-width* 294 | (* *qgame-gui-qubits* (- *amplitude-item-height* 12))) 295 | (defparameter *amplitude-column-height* 296 | (* *amplitude-item-height* *qgame-gui-num-amps*)) 297 | (defparameter *program-item-width* 250) 298 | (defparameter *qgame-dialog-width* 299 | (+ *program-item-width* *amplitude-item-width* 50)) 300 | (defparameter *qgame-dialog-height* 301 | (+ 50 ; margins 302 | *amplitude-item-height* ; label 303 | (* *amplitude-item-height* *qgame-gui-num-amps*))) 304 | (defparameter *qgame-display-delay* 0.25) 305 | 306 | (defparameter *qgame-gui-min-x* 30) 307 | (defparameter *qgame-gui-min-y* 70) 308 | (defparameter *qgame-gui-max-x* (- *screen-width* *qgame-dialog-width*)) 309 | (defparameter *qgame-gui-max-y* (- *screen-height* *qgame-dialog-height*)) 310 | 311 | (defparameter *qgame-gui-current-x* *qgame-gui-min-x*) 312 | (defparameter *qgame-gui-current-y* *qgame-gui-min-y*) 313 | (defparameter *qgame-gui-x-delta* *qgame-dialog-width*) 314 | (defparameter *qgame-gui-y-delta* 30) 315 | 316 | (defun resize-qgame-qui (num-qubits) 317 | "An ugly hack if you ever saw one! Resets every parameter, except for 318 | those that are obviously constant, based on the new size." 319 | (setq *qgame-gui-qubits* num-qubits) 320 | (setq *qgame-gui-num-amps* (expt 2 *qgame-gui-qubits*)) 321 | (setq *amplitude-item-height* (second *qgame-font*)) 322 | (setq *amplitude-item-width* 323 | (* *qgame-gui-qubits* (- *amplitude-item-height* 12))) 324 | (setq *amplitude-column-height* 325 | (* *amplitude-item-height* *qgame-gui-num-amps*)) 326 | (setq *program-item-width* 250) 327 | (setq *qgame-dialog-width* 328 | (+ *program-item-width* *amplitude-item-width* 50)) 329 | (setq *qgame-dialog-height* 330 | (+ 50 ; margins 331 | *amplitude-item-height* ; label 332 | (* *amplitude-item-height* *qgame-gui-num-amps*))) 333 | (setq *qgame-gui-max-x* (- *screen-width* *qgame-dialog-width*)) 334 | (setq *qgame-gui-max-y* (- *screen-height* *qgame-dialog-height*)) 335 | (setq *qgame-gui-current-x* *qgame-gui-min-x*) 336 | (setq *qgame-gui-current-y* *qgame-gui-min-y*) 337 | (setq *qgame-gui-x-delta* *qgame-dialog-width*) 338 | ) 339 | 340 | (defun next-qgame-dialog-position () 341 | (let ((result (make-point *qgame-gui-current-x* *qgame-gui-current-y*))) 342 | (setq *qgame-gui-current-x* 343 | (max *qgame-gui-min-x* 344 | (mod (+ *qgame-gui-current-x* *qgame-gui-x-delta*) 345 | *qgame-gui-max-x*))) 346 | (setq *qgame-gui-current-y* 347 | (max *qgame-gui-min-y* 348 | (mod (+ *qgame-gui-current-y* *qgame-gui-y-delta*) 349 | *qgame-gui-max-y*))) 350 | result)) 351 | 352 | (defun phase360 (amplitude) 353 | (* (max 0 (phase amplitude)) 354 | (/ 180 pi))) 355 | 356 | (defun show-amp (qsys ampnum amp) 357 | (let ((h (phase360 amp)) 358 | (s (abs amp #|(expt amp 2)|#)) 359 | (v 1)) 360 | (set-part-color (aref (amplitude-items qsys) ampnum) 361 | :text (apply #'make-color (HSVtoRGB h s v)) 362 | ))) 363 | 364 | (defun show-amps (qsys) 365 | (dotimes (i (expt 2 (number-of-qubits qsys))) 366 | (show-amp qsys i (aref (amplitudes qsys) i))) 367 | (set-dialog-item-text (program-item qsys) 368 | (format nil "~{~A~%~}" (instruction-history qsys))) 369 | (view-draw-contents (program-item qsys)) 370 | (set-dialog-item-text (measurements-item qsys) 371 | (format nil "~{~A~%~}" (measurement-history qsys))) 372 | (view-draw-contents (measurements-item qsys)) 373 | ;(view-draw-contents (qsys-view qsys)) 374 | ;(event-dispatch) 375 | (sleep *qgame-display-delay*)) 376 | 377 | (defun string-down-from (n) 378 | (if (zerop n) 379 | "0" 380 | (concatenate 'string (princ-to-string n) 381 | (string-down-from (- n 1))))) 382 | 383 | (defun amplitude-dialog (amp position) 384 | (modal-dialog 385 | (MAKE-INSTANCE 386 | 'COLOR-DIALOG 387 | :WINDOW-TYPE 388 | :SHADOW-EDGE-BOX 389 | :VIEW-POSITION position 390 | :VIEW-SIZE 391 | #@(300 20) 392 | :CLOSE-BOX-P 393 | NIL 394 | ;:VIEW-FONT 395 | ;'("Times" 18 :SRCOR :PLAIN (:COLOR-INDEX 0)) 396 | :VIEW-SUBVIEWS 397 | (LIST 398 | (let ((new 399 | (MAKE-DIALOG-ITEM 400 | 'STATIC-TEXT-DIALOG-ITEM 401 | #@(5 6) 402 | #@(395 20) 403 | (princ-to-string amp) 404 | #'(lambda (item) 405 | (declare (ignore item)) 406 | (return-from-modal-dialog nil))))) 407 | (SET-VIEW-FONT new *qgame-program-font*) 408 | new))))) 409 | 410 | (defmethod initialize-instance :after ((qsys visible-quantum-system) &rest args) 411 | (declare (ignore args)) 412 | (setf (qsys-view qsys) 413 | (MAKE-INSTANCE 414 | 'COLOR-DIALOG 415 | :WINDOW-TYPE :DOCUMENT ;:MOVABLE-DIALOG 416 | :VIEW-POSITION (next-qgame-dialog-position) 417 | :VIEW-SIZE (make-point *qgame-dialog-width* 418 | *qgame-dialog-height*) 419 | :VIEW-FONT *qgame-font* 420 | :window-title (format nil "qgame, p=~A" (prior-probability qsys)))) 421 | (setf (amplitude-items qsys) (make-array *qgame-gui-num-amps*)) 422 | ;; amplitude label 423 | (setf (amplitude-label-item qsys) 424 | (MAKE-DIALOG-ITEM 'STATIC-TEXT-DIALOG-ITEM 425 | (make-point 20 20) 426 | (make-point *amplitude-item-width* *amplitude-item-height*) 427 | (string-down-from (- *qgame-gui-qubits* 1)) 428 | 'NIL)) 429 | (set-view-font (amplitude-label-item qsys) 430 | *qgame-font*) 431 | (add-subviews (qsys-view qsys) (amplitude-label-item qsys)) 432 | ;; amplitude items 433 | (dotimes (a *qgame-gui-num-amps*) 434 | (setf (aref (amplitude-items qsys) a) 435 | (MAKE-DIALOG-ITEM 436 | 'STATIC-TEXT-DIALOG-ITEM 437 | (make-point 20 (+ 20 *amplitude-item-height* (* *amplitude-item-height* a))) 438 | (make-point *amplitude-item-width* *amplitude-item-height*) 439 | (format 440 | nil 441 | (concatenate 'string 442 | "~" 443 | (princ-to-string *qgame-gui-qubits*) 444 | ",'0B") 445 | a) 446 | ;)) 447 | #'(lambda (item) 448 | (amplitude-dialog (aref (amplitudes qsys) 449 | (let ((*read-base* 2)) 450 | (read-from-string (dialog-item-text item)))) 451 | (add-points (view-position item) 452 | (view-position (qsys-view qsys))) 453 | )))) 454 | (set-view-font (aref (amplitude-items qsys) a) 455 | *qgame-font*) 456 | (set-part-color (aref (amplitude-items qsys) a) 457 | :body CCL::*LIGHTER-GRAY-COLOR*) ;*Light-Gray-Color*) 458 | (set-part-color (aref (amplitude-items qsys) a) 459 | :text *WHITE-COLOR*) 460 | (add-subviews (qsys-view qsys) (aref (amplitude-items qsys) a))) 461 | ;; program label 462 | (setf (program-label-item qsys) 463 | (MAKE-DIALOG-ITEM 'STATIC-TEXT-DIALOG-ITEM 464 | (make-point (+ 30 *amplitude-item-width*) 38) 465 | (make-point *program-item-width* 14) 466 | "Instruction History" 467 | 'NIL)) 468 | (set-view-font (program-label-item qsys) *qgame-program-font*) 469 | (add-subviews (qsys-view qsys) (program-label-item qsys)) 470 | ;; program 471 | (setf (program-item qsys) 472 | (MAKE-INSTANCE 473 | 'SCROLLING-FRED-VIEW 474 | :SAVE-BUFFER-P nil 475 | :H-SCROLLP T 476 | :V-SCROLLP T 477 | :WRAP-P nil 478 | :VIEW-SIZE 479 | (make-point *program-item-width* (truncate *amplitude-column-height* 2)) 480 | :VIEW-POSITION 481 | (make-point (+ 30 *amplitude-item-width*) (+ *amplitude-item-height* 20)))) 482 | (SET-VIEW-FONT (program-item qsys) *qgame-program-font*) 483 | (add-subviews (qsys-view qsys) (program-item qsys)) 484 | ;; measurement history label 485 | (setf (measurements-label-item qsys) 486 | (MAKE-DIALOG-ITEM 'STATIC-TEXT-DIALOG-ITEM 487 | (make-point (+ 30 *amplitude-item-width*) 488 | (+ *amplitude-item-height* 489 | (truncate *amplitude-column-height* 2) 38)) 490 | (make-point *program-item-width* 14) 491 | "Measurement History" 492 | 'NIL)) 493 | (set-view-font (measurements-label-item qsys) *qgame-program-font*) 494 | (add-subviews (qsys-view qsys) (measurements-label-item qsys)) 495 | ;; measurement history 496 | (setf (measurements-item qsys) 497 | (MAKE-INSTANCE 498 | 'SCROLLING-FRED-VIEW 499 | :SAVE-BUFFER-P nil 500 | :H-SCROLLP T 501 | :V-SCROLLP T 502 | :WRAP-P nil 503 | :VIEW-SIZE 504 | (make-point *program-item-width* 505 | (- *amplitude-column-height* 506 | (truncate *amplitude-column-height* 2) 507 | *amplitude-item-height*)) 508 | :VIEW-POSITION 509 | (make-point (+ 30 *amplitude-item-width*) 510 | (+ *amplitude-item-height* *amplitude-item-height* 511 | (truncate *amplitude-column-height* 2) 20)))) 512 | (SET-VIEW-FONT (measurements-item qsys) *qgame-program-font*) 513 | (add-subviews (qsys-view qsys) (measurements-item qsys)) 514 | ;(show-amps qsys) 515 | ) 516 | 517 | #| from http://www.cs.rit.edu/~ncs/color/t_convert.html 518 | 519 | The Hue/Saturation/Value model was created by A. R. Smith in 1978. It is based 520 | on such intuitive color characteristics as tint, shade and tone (or family, 521 | purety and intensity). The coordinate system is cylindrical, and the colors 522 | are defined inside a hexcone. The hue value H runs from 0 to 360¼. The 523 | saturation S is the degree of strength or purity and is from 0 to 1. Purity 524 | is how much white is added to the color, so S=1 makes the purest color (no white). 525 | Brightness V also ranges from 0 to 1, where 0 is the black. 526 | 527 | 528 | void HSVtoRGB( float *r, float *g, float *b, float h, float s, float v ) 529 | { 530 | int i; 531 | float f, p, q, t; 532 | 533 | if( s == 0 ) { 534 | // achromatic (grey) 535 | *r = *g = *b = v; 536 | return; 537 | } 538 | 539 | h /= 60; // sector 0 to 5 540 | i = floor( h ); 541 | f = h - i; // factorial part of h 542 | p = v * ( 1 - s ); 543 | q = v * ( 1 - s * f ); 544 | t = v * ( 1 - s * ( 1 - f ) ); 545 | 546 | switch( i ) { 547 | case 0: 548 | *r = v; 549 | *g = t; 550 | *b = p; 551 | break; 552 | case 1: 553 | *r = q; 554 | *g = v; 555 | *b = p; 556 | break; 557 | case 2 558 | *r = p; 559 | *g = v; 560 | *b = t; 561 | break; 562 | case 3: 563 | *r = p; 564 | *g = q; 565 | *b = v; 566 | break; 567 | case 4: 568 | *r = t; 569 | *g = p; 570 | *b = v; 571 | break; 572 | default: // case 5: 573 | *r = v; 574 | *g = p; 575 | *b = q; 576 | break; 577 | } 578 | |# 579 | 580 | ;; the above translated into Lisp: 581 | 582 | (defun HSVtoRGB (h s v) 583 | (let (r g b i f p q tt) 584 | (when (zerop s) 585 | (setq r v 586 | g v 587 | b v)) 588 | (setq h (/ h 60)) ;// sector 0 to 5 589 | (setq i (floor h)) 590 | (setq f (- h i)) ; // factorial part of h 591 | (setq p (* v (- 1 s))) 592 | (setq q (* v (- 1 (* s f)))) 593 | (setq tt (* v (- 1 (* s (- 1 f))))) 594 | (case i 595 | (0 (setq r v 596 | g tt 597 | b p)) 598 | (1 (setq r q 599 | g v 600 | b p)) 601 | (2 (setq r p 602 | g v 603 | b tt)) 604 | (3 (setq r p 605 | g q 606 | b v)) 607 | (4 (setq r tt 608 | g p 609 | b v)) 610 | (5 (setq r v 611 | g p 612 | b q))) 613 | ;(print (list r g b i f p q tt)) 614 | (mapcar #'(lambda (val) (truncate (* val 65535))) 615 | (list r g b)))) 616 | 617 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 618 | 619 | ;; redefined from qgame.lisp: 620 | (defun run-qsys (qsys) 621 | "Takes a quantum system and returns the list of quantum systems that 622 | results from the execution of its program." 623 | (show-amps qsys) 624 | (if (or (null (program qsys)) 625 | (zerop (prior-probability qsys))) 626 | (list qsys) 627 | (let ((instruction (first (program qsys)))) 628 | (setf (instruction-history qsys) 629 | (append (instruction-history qsys) (list instruction))) 630 | (if (eq (first instruction) 'halt) 631 | (list qsys) 632 | (if (eq (first instruction) 'measure) 633 | ;; it's a measurement so split state and return list of results 634 | (let* ((measurement-qubit (second instruction)) 635 | (probabilities (qc-output-probabilities qsys (list measurement-qubit)))) 636 | (window-close (qsys-view qsys)) ;*** 637 | (append 638 | ;; 1 branch 639 | (run-qsys 640 | (force-to 1 measurement-qubit 641 | (make-instance 'visible-quantum-system ;*** 642 | :number-of-qubits (number-of-qubits qsys) 643 | :amplitudes (copy-seq (amplitudes qsys)) 644 | :prior-probability (second probabilities) 645 | :oracle-count (oracle-count qsys) 646 | :measurement-history (append (measurement-history qsys) 647 | (list (list measurement-qubit 648 | 'is 1))) 649 | :instruction-history (instruction-history qsys) 650 | :program (without-else-branch (rest (program qsys)))))) 651 | ;; 0 branch 652 | (run-qsys 653 | (force-to 0 measurement-qubit 654 | (make-instance 'visible-quantum-system ;*** 655 | :number-of-qubits (number-of-qubits qsys) 656 | :amplitudes (copy-seq (amplitudes qsys)) 657 | :prior-probability (first probabilities) 658 | :oracle-count (oracle-count qsys) 659 | :measurement-history (append (measurement-history qsys) 660 | (list (list measurement-qubit 661 | 'is 0))) 662 | :instruction-history (instruction-history qsys) 663 | :program (without-if-branch (rest (program qsys)))))))) 664 | (let ((resulting-sys 665 | (apply (first instruction) (cons qsys (rest instruction))))) 666 | (setf (program resulting-sys) (rest (program resulting-sys))) 667 | (run-qsys resulting-sys))))))) 668 | 669 | (defun upto (n) 670 | (if (< n 0) 671 | nil 672 | (append (upto (- n 1)) (list n)))) 673 | 674 | ;; redefined from qgame.lisp: 675 | (defun execute-quantum-program (pgm num-qubits &optional (oracle-tt nil)) 676 | "Executes the provide quantum program with the specified number of qubits 677 | and the provided oracle truth table, returning a list of the resulting 678 | quantum systems." 679 | (resize-qgame-qui num-qubits) 680 | (print 681 | (multi-qsys-output-probabilities 682 | (run-qsys (make-instance 'visible-quantum-system ;*** 683 | :number-of-qubits num-qubits 684 | :program (subst oracle-tt 'ORACLE-TT pgm))) 685 | (reverse (upto (- num-qubits 1)))))) 686 | 687 | 688 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 689 | ;; matrix gates 690 | 691 | (defun matrix-gate (qsys matrix &rest qubits) 692 | (apply-operator qsys 693 | matrix 694 | qubits)) 695 | 696 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 697 | ;; program dialog 698 | 699 | (defvar *program-dialog-item*) 700 | (defvar *qubits-dialog-item*) 701 | (defvar *program-to-execute*) 702 | (defvar *qubits-for-program-to-execute*) 703 | (defvar *delay-dialog-item*) 704 | 705 | (defun make-program-dialog () 706 | (MAKE-INSTANCE 707 | 'COLOR-DIALOG 708 | :WINDOW-TYPE 709 | :DOCUMENT ;:MOVABLE-DIALOG 710 | :WINDOW-TITLE 711 | "QGAME Program" 712 | :VIEW-POSITION 713 | '(:TOP 96) 714 | :VIEW-SIZE 715 | #@(301 250) 716 | :VIEW-FONT 717 | '("Charcoal" 12 :SRCOR :PLAIN (:COLOR-INDEX 0)) 718 | ;:CLOSE-BOX-P 719 | ;NIL ; t 720 | :VIEW-SUBVIEWS 721 | (LIST (LET ((NEW 722 | (MAKE-INSTANCE 723 | 'SCROLLING-FRED-VIEW 724 | :SAVE-BUFFER-P 725 | T 726 | :H-SCROLLP 727 | T 728 | :V-SCROLLP 729 | T 730 | :WRAP-P 731 | T 732 | :VIEW-SIZE 733 | #@(291 207) 734 | :VIEW-POSITION 735 | #@(5 5)))) 736 | (SET-VIEW-FONT NEW '("Monaco" 9 :SRCOR :PLAIN (:COLOR-INDEX 0))) 737 | (setq *program-dialog-item* new) 738 | NEW) 739 | (MAKE-DIALOG-ITEM 740 | 'STATIC-TEXT-DIALOG-ITEM 741 | #@(5 224) 742 | #@(48 16) 743 | "Qubits:" 744 | 'NIL) 745 | (setq *qubits-dialog-item* 746 | (MAKE-DIALOG-ITEM 747 | 'EDITABLE-TEXT-DIALOG-ITEM 748 | #@(58 224) 749 | #@(30 16) 750 | "3" 751 | 'NIL 752 | :ALLOW-RETURNS 753 | NIL 754 | :DRAW-OUTLINE 755 | T)) 756 | (MAKE-DIALOG-ITEM 757 | 'STATIC-TEXT-DIALOG-ITEM 758 | #@(104 224) 759 | #@(48 16) 760 | "Delay:" 761 | 'NIL) 762 | (setq *delay-dialog-item* 763 | (MAKE-DIALOG-ITEM 764 | 'EDITABLE-TEXT-DIALOG-ITEM 765 | #@(150 224) 766 | #@(40 16) 767 | "0.5" 768 | 'NIL 769 | :ALLOW-RETURNS 770 | NIL 771 | :DRAW-OUTLINE 772 | T)) 773 | (MAKE-DIALOG-ITEM 774 | 'BUTTON-DIALOG-ITEM 775 | #@(220 223) 776 | #@(64 18) 777 | "Run" 778 | #'(LAMBDA (ITEM) ITEM 779 | (setq *program-to-execute* 780 | (read-from-string 781 | (format nil "(~A)" 782 | (dialog-item-text *program-dialog-item*)))) 783 | (setq *qubits-for-program-to-execute* 784 | (read-from-string 785 | (dialog-item-text *qubits-dialog-item*))) 786 | (setq *qgame-display-delay* 787 | (read-from-string 788 | (dialog-item-text *delay-dialog-item*))) 789 | (eval-enqueue '(run-program-globally))) 790 | :DEFAULT-BUTTON 791 | NIL))) 792 | ) 793 | 794 | (make-program-dialog) 795 | 796 | (defun run-program-globally () 797 | (execute-quantum-program *program-to-execute* *qubits-for-program-to-execute*)) 798 | 799 | ;; EOF 800 | -------------------------------------------------------------------------------- /packages.lisp: -------------------------------------------------------------------------------- 1 | ;;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: QGAME; Base: 10 -*- file: packages.lisp 2 | 3 | ;;;; Copyright (c) 2013 "the Phoeron" Colin J.E. Lupton 4 | ;;;; See LICENSE for additional information. 5 | 6 | (in-package :cl-user) 7 | 8 | (defpackage #:qgame 9 | (:use :cl) 10 | (:export #:*qgame-version* 11 | #:quantum-system 12 | #:run-qsys 13 | #:execute-quantum-program 14 | #:test-quantum-program)) 15 | 16 | ;; see asdf system definition 17 | (defvar qgame:*qgame-version* 18 | #.qgame-asd::*qgame-version*) 19 | 20 | ;; EOF 21 | -------------------------------------------------------------------------------- /qgame.asd: -------------------------------------------------------------------------------- 1 | ;;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: QGAME; Base: 10 -*- file: qgame.asd 2 | 3 | ;;;; Copyright (c) 2013 "the Phoeron" Colin J.E. Lupton 4 | ;;;; See LICENSE for additional information. 5 | 6 | (in-package :cl-user) 7 | 8 | (defpackage qgame-asd 9 | (:use :cl :asdf) 10 | (:export #:*qgame-version*)) 11 | 12 | (in-package :qgame-asd) 13 | 14 | (defparameter *qgame-version* "1.3.0") 15 | 16 | (defsystem qgame 17 | :version #.*qgame-version* 18 | :author "Lee Spector " 19 | :maintainer "\"the Phoeron\" Colin J.E. Lupton " 20 | :license "MIT" 21 | :description "QGAME: Quantum Gate and Measurement Emulator, a quantum computer simulator in Common Lisp" 22 | :serial t 23 | :depends-on (:gsll 24 | :cl-ppcre 25 | :cl-fad 26 | :ltk) 27 | :components ((:file "packages") 28 | (:file "qgame") 29 | (:file "gate-compression"))) 30 | 31 | ;; EOF 32 | -------------------------------------------------------------------------------- /qgame.lisp: -------------------------------------------------------------------------------- 1 | 2 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 3 | ;; qgame.lisp 4 | ;; c) 1999-2004, Lee Spector (lspector@hampshire.edu) 5 | ;; version 1.20031226 (major version number.yyyymmdd) 6 | ;; version history below 7 | 8 | (in-package :qgame) 9 | 10 | ; for maximum reasonably safe speed 11 | (eval-when (compile) 12 | (declaim (optimize (speed 3) (safety 1) (space 0) (debug 0)))) 13 | 14 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 15 | ;; class definition for a quantum system 16 | 17 | (defclass quantum-system () 18 | (;; the number of qubits in the system 19 | (number-of-qubits :accessor number-of-qubits :initarg :number-of-qubits) 20 | ;; an array of amplitudes 21 | (amplitudes :accessor amplitudes :initarg :amplitudes :initform nil) 22 | ;; the probability for having reached this system in the first place 23 | (prior-probability :accessor prior-probability :initarg :prior-probability 24 | :initform 1) 25 | ;; the number of oracle calls that have been made in the history of this system 26 | (oracle-count :accessor oracle-count :initarg :oracle-count :initform 0) 27 | ;; a list of measurements and their results in the history of this system 28 | (measurement-history :accessor measurement-history :initarg :measurement-history 29 | :initform nil) 30 | ;; a list of all instructions executed in the history of this system 31 | (instruction-history :accessor instruction-history :initarg :instruction-history 32 | :initform nil) 33 | ;; the program yet to be executed by this system (if it hasn't yet terminated) 34 | (program :accessor program :initarg :program :initform nil) 35 | ;; the following are just for convenience 36 | (qubit-numbers :accessor qubit-numbers) ;; all valid qubit indices 37 | (amplitude-address :accessor amplitude-address) ;; used for looping through qubits 38 | )) 39 | 40 | (defmethod initialize-instance :after ((qsys quantum-system) &rest args) 41 | "An initializer for quantum systems." 42 | (declare (ignore args)) 43 | (let ((num-qubits (number-of-qubits qsys))) 44 | ;; if there are no amplitudes yet then initialize to |00...0> 45 | (unless (amplitudes qsys) 46 | (setf (amplitudes qsys) 47 | (let ((amps (make-array (expt 2 num-qubits) 48 | :initial-element 0.0L0))) 49 | (setf (aref amps 0) 1.0L0) ;; start in zero state 50 | amps))) 51 | ;; initilize list of valid qubit indices 52 | (setf (qubit-numbers qsys) 53 | (let ((all nil)) 54 | (dotimes (i num-qubits) (push i all)) 55 | (reverse all))) 56 | ;; initialize address register for amplitudes 57 | (setf (amplitude-address qsys) 58 | (make-array num-qubits :initial-element 0)))) 59 | 60 | 61 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 62 | ;; quantum computer manipulation utilities 63 | 64 | (defun set-address-components (qsys count qubits) 65 | "Sets (amplitude-address qsys) to refer to a particular amplitude, as 66 | indicated by the bits in the integer count." 67 | (dotimes (i (length qubits)) 68 | (setf (aref (amplitude-address qsys) (nth i qubits)) 69 | (if (logbitp i count) 1 0)))) 70 | 71 | (defun map-qubit-combinations (qsys function qubits) 72 | "Calls function once for each of the 1/0 combinations of the provided 73 | qubits, with the right-most qubit varying the fastest." 74 | (setq qubits (reverse qubits)) 75 | (let ((number-of-iterations (expt 2 (length qubits)))) 76 | (dotimes (i number-of-iterations) 77 | (set-address-components qsys i qubits) 78 | (funcall function)))) 79 | 80 | (defun get-addressed-amplitude (qsys) 81 | "Returns the amplitude currently addressed by (amplitude-address qsys)" 82 | (let ((numerical-address 0)) 83 | (dotimes (i (number-of-qubits qsys)) 84 | (unless (zerop (aref (amplitude-address qsys) i)) 85 | (incf numerical-address (expt 2 i)))) 86 | (aref (amplitudes qsys) numerical-address))) 87 | 88 | (defun set-addressed-amplitude (qsys new-value) 89 | "Sets the amplitude currently addressed by (amplitude-address qsys) 90 | to new-value." 91 | (let ((numerical-address 0)) 92 | (dotimes (i (number-of-qubits qsys)) 93 | (unless (zerop (aref (amplitude-address qsys) i)) 94 | (incf numerical-address (expt 2 i)))) 95 | (setf (aref (amplitudes qsys) numerical-address) new-value))) 96 | 97 | (defun matrix-multiply (matrix column) 98 | "Multiplies the given square matrix by the given column (assumed 99 | to be the right length) and returns the resulting column." 100 | (let ((matrix-size (car (array-dimensions matrix))) 101 | (result nil)) 102 | (dotimes (i matrix-size) 103 | (push (let ((element 0)) 104 | (dotimes (j matrix-size) 105 | (incf element (* (aref matrix i j) (nth j column)))) 106 | element) 107 | result)) 108 | (reverse result))) 109 | 110 | (defun extract-column (qsys qubits-to-vary) 111 | "Returns a column from the amplitudes obtained by varying the listed 112 | qubits, with the right-most qubit varying the fastest." 113 | (let ((col nil)) 114 | (map-qubit-combinations 115 | qsys 116 | #'(lambda () 117 | (push (get-addressed-amplitude qsys) col)) 118 | qubits-to-vary) 119 | (reverse col))) 120 | 121 | (defun install-column (qsys column qubits-to-vary) 122 | "Installs the given column in the amplitude positions obtained by 123 | varying the listed qubits, with the right-most qubit varying the fastest." 124 | (map-qubit-combinations 125 | qsys 126 | #'(lambda () 127 | (set-addressed-amplitude qsys (car column)) 128 | (setq column (cdr column))) 129 | qubits-to-vary)) 130 | 131 | (defun apply-operator (qsys operator qubits) 132 | "Applies the given matrix-form operator to the given qubits." 133 | (map-qubit-combinations 134 | qsys 135 | #'(lambda () 136 | ;(format t "~%address:~A" (amplitude-address qsys)) 137 | (let* ((pre-column (extract-column qsys qubits)) 138 | (post-column (matrix-multiply operator pre-column))) 139 | (install-column qsys post-column qubits))) 140 | (set-difference (qubit-numbers qsys) qubits)) 141 | qsys) 142 | 143 | (defun qc-output-probabilities (qsys qubits) 144 | "Returns a list of the probabilities for all combinations for the 145 | given qubits, in binary order with the rightmost qubit varying fastest." 146 | (let ((probabilities nil) 147 | (other-qubits (set-difference (qubit-numbers qsys) qubits))) 148 | (map-qubit-combinations 149 | qsys 150 | #'(lambda () 151 | (push (let ((probability 0)) 152 | (map-qubit-combinations 153 | qsys 154 | #'(lambda () 155 | (incf probability 156 | (expt (abs (get-addressed-amplitude qsys)) 2))) 157 | other-qubits) 158 | probability) 159 | probabilities)) 160 | qubits) 161 | (reverse probabilities))) 162 | 163 | (defun multi-qsys-output-probabilities (qsys-list qubits) 164 | "Returns a list of the probabilities for all combinations for the 165 | given qubits, in binary order with the rightmost qubit varying fastest. 166 | This function takes a LIST of quantum systems as input and sums the 167 | results across all systems." 168 | (let ((probabilities 169 | (mapcar #'(lambda (qsys) 170 | (qc-output-probabilities qsys qubits)) 171 | qsys-list))) 172 | (labels ((add-lists (l1 l2) 173 | (if (null l1) 174 | nil 175 | (cons (+ (first l1) (first l2)) 176 | (add-lists (rest l1) (rest l2)))))) 177 | (reduce #'add-lists probabilities)))) 178 | 179 | 180 | (defun expected-oracles (qsys-list) 181 | "Returns the expected number of oracle calls for the given 182 | set of quantum systems." 183 | (reduce #'+ 184 | (mapcar #'(lambda (qsys) 185 | (* (prior-probability qsys) 186 | (oracle-count qsys))) 187 | qsys-list))) 188 | 189 | 190 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 191 | ;; oracle gates 192 | 193 | (defun binary-operator-matrix (tt-right-column) 194 | "Returns a matrix operator for a binary function with the 195 | given tt-right-column as the right column of its truth table." 196 | (let* ((column-length (length tt-right-column)) 197 | (operator-size (* 2 column-length)) 198 | (matrix (make-array (list operator-size operator-size) 199 | :initial-element 0))) 200 | (dotimes (i column-length) 201 | (let ((offset (* i 2))) 202 | (if (zerop (nth i tt-right-column)) 203 | (setf (aref matrix offset offset) 1 204 | (aref matrix (1+ offset) (1+ offset)) 1) 205 | (setf (aref matrix offset (1+ offset)) 1 206 | (aref matrix (1+ offset) offset) 1)))) 207 | matrix)) 208 | 209 | (defun oracle (qsys tt-right-column &rest qubits) 210 | "Applies the oracle operator built from tt-right-column, which 211 | is the right column of the corresponding truth table." 212 | (incf (oracle-count qsys)) 213 | (apply-operator 214 | qsys 215 | (binary-operator-matrix tt-right-column) 216 | qubits)) 217 | 218 | (defun limited-oracle (qsys max-calls tt-right-column &rest qubits) 219 | "If (oracle-count qsys) is less than max-calls then this applies 220 | the oracle operator built from tt-right-column, which is the right 221 | column of the corresponding truth table. Otherwise this does nothing." 222 | (if (< (oracle-count qsys) max-calls) 223 | (progn (incf (oracle-count qsys)) 224 | (apply-operator 225 | qsys 226 | (binary-operator-matrix tt-right-column) 227 | qubits)) 228 | qsys)) 229 | 230 | 231 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 232 | ;; other quantum gates 233 | 234 | (defun qnot (qsys q) 235 | "Quantum NOT gate" 236 | (apply-operator qsys 237 | #2A((0 1) 238 | (1 0)) 239 | (list q))) 240 | 241 | 242 | (defun cnot (qsys q1 q2) 243 | "Quantum Controlled NOT gate" 244 | (apply-operator qsys 245 | #2A((1 0 0 0) 246 | (0 1 0 0) 247 | (0 0 0 1) 248 | (0 0 1 0)) 249 | (list q1 q2))) 250 | 251 | (defun srn (qsys q) 252 | "Quantum Square-Root-of-NOT gate" 253 | (apply-operator 254 | qsys 255 | (make-array '(2 2) 256 | :initial-contents 257 | (list (list (/ 1 (sqrt 2.0L0)) (- (/ 1 (sqrt 2.0L0)))) 258 | (list (/ 1 (sqrt 2.0L0)) (/ 1 (sqrt 2.0L0))) 259 | )) 260 | (list q))) 261 | 262 | (defun nand (qsys q1 q2 q3) 263 | "Quantum NAND gate" 264 | (apply-operator 265 | qsys 266 | (binary-operator-matrix '(1 1 1 0)) 267 | (list q1 q2 q3))) 268 | 269 | (defun hadamard (qsys q) 270 | "Quantum Hadamard gate" 271 | (apply-operator 272 | qsys 273 | (make-array '(2 2) 274 | :initial-contents 275 | (list (list (/ 1 (sqrt 2.0L0)) (/ 1 (sqrt 2.0L0))) 276 | (list (/ 1 (sqrt 2.0L0)) (- (/ 1 (sqrt 2.0L0)))) 277 | )) 278 | (list q))) 279 | 280 | (defun u-theta (qsys q theta) 281 | "Quantum U-theta (rotation) gate" 282 | (apply-operator 283 | qsys 284 | (make-array '(2 2) 285 | :initial-contents 286 | (list (list (cos theta) (sin theta)) 287 | (list (- (sin theta)) (cos theta)) 288 | )) 289 | (list q))) 290 | 291 | (defun cphase-old (qsys q1 q2 alpha) 292 | "Quantum conditional phase gate, OLD VERSION" 293 | (apply-operator 294 | qsys 295 | (make-array '(4 4) 296 | :initial-contents 297 | (list (list 1 0 0 0) 298 | (list 0 1 0 0) 299 | (list 0 0 0 (exp (* (sqrt -1.0L0) alpha))) 300 | (list 0 0 (exp (- (* (sqrt -1.0L0) alpha))) 0) 301 | )) 302 | (list q1 q2))) 303 | 304 | (defun cphase (qsys q1 q2 alpha) 305 | "Quantum conditional phase gate" 306 | (apply-operator 307 | qsys 308 | (make-array '(4 4) 309 | :initial-contents 310 | (list (list 1 0 0 0) 311 | (list 0 1 0 0) 312 | (list 0 0 1 0) 313 | (list 0 0 0 (exp (* (sqrt -1.0L0) alpha))) 314 | )) 315 | (list q1 q2))) 316 | 317 | 318 | ;; U(2) = U(phi) * R(theta) * U(psi) * exp(i alpha)I 319 | ;; where U(a) = e^(-ia) 0 320 | ;; 0 e^(ia) 321 | ;; and R(a) = cos(a) sin(-a) 322 | ;; sin(a) cos(a) 323 | ;; This is all pre-multiplied in the following code 324 | 325 | (defun u2 (qsys q phi theta psi alpha) 326 | "Quantum U2 gate, implemented as: 327 | e^(i(-phi-psi+alpha))*cos(theta) e^(i(-phi+psi+alpha))*sin(-theta) 328 | e^(i(phi-psi+alpha))*sin(theta) e^(i(phi+psi+alpha))*cos(theta) " 329 | (apply-operator 330 | qsys 331 | (let ((i (sqrt -1.0L0))) 332 | (make-array 333 | '(2 2) 334 | :initial-contents 335 | (list (list (* (exp (* i (+ (- phi) (- psi) alpha))) (cos theta)) 336 | (* (exp (* i (+ (- phi) psi alpha))) (sin (- theta)))) 337 | (list (* (exp (* i (+ phi (- psi) alpha))) (sin theta)) 338 | (* (exp (* i (+ phi psi alpha))) (cos theta))) 339 | ))) 340 | (list q))) 341 | 342 | 343 | (defun swap (qsys q1 q2) 344 | "A quantum gate that swaps the amplitudes for the two specified qubits." 345 | (apply-operator 346 | qsys 347 | (make-array '(4 4) 348 | :initial-contents 349 | (list (list 1 0 0 0) 350 | (list 0 0 1 0) 351 | (list 0 1 0 0) 352 | (list 0 0 0 1) 353 | )) 354 | (list q1 q2))) 355 | 356 | (defun printamps (qsys) 357 | "For use in quantum programs; causes the amplitudes of the executing 358 | quantum system to be printed." 359 | (print (amplitudes qsys)) 360 | qsys) 361 | 362 | (defun insp (qsys) 363 | "For use in quantum programs; causes the inspector to be invoked on 364 | the executing quantum system." 365 | (inspect qsys) 366 | qsys) 367 | 368 | 369 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 370 | ;; utilities for measurement and branching 371 | 372 | (defun end (qsys) 373 | "Marks the end of a measurement branch; has no effect when used 374 | in a quantum program in any other context." 375 | qsys) 376 | 377 | (defun distance-to-next-unmatched-end (list &optional 378 | (num-measures 0) (num-ends 0) 379 | (distance-so-far 0)) 380 | "Returns 0 if there is no unmatched (end) in list; otherwise returns 381 | the number of instructions to the next unmatched (end) (counting the (end))." 382 | (if (null list) 383 | 0 384 | (if (eq (caar list) 'end) 385 | (if (zerop num-measures) 386 | (+ 1 distance-so-far) 387 | (if (oddp num-ends) ;; then this one closes a measure 388 | (distance-to-next-unmatched-end (cdr list) 389 | (- num-measures 1) (- num-ends 1) 390 | (+ 1 distance-so-far)) 391 | (distance-to-next-unmatched-end (cdr list) 392 | num-measures (+ num-ends 1) 393 | (+ 1 distance-so-far)))) 394 | (if (eq (caar list) 'measure) 395 | (distance-to-next-unmatched-end (cdr list) 396 | (+ num-measures 1) num-ends 397 | (+ 1 distance-so-far)) 398 | (distance-to-next-unmatched-end (cdr list) 399 | num-measures num-ends 400 | (+ 1 distance-so-far)))))) 401 | 402 | (defun without-if-branch (program) 403 | "Assuming that a MEASURE form has just been removed from the given 404 | program, returns the remainder of the program without the IF (measure-1) 405 | branch." 406 | (let* ((distance-to-first-unmatched-end 407 | (distance-to-next-unmatched-end program)) 408 | (distance-from-first-to-second-unmatched-end 409 | (distance-to-next-unmatched-end 410 | (nthcdr distance-to-first-unmatched-end program)))) 411 | (if (zerop distance-to-first-unmatched-end) 412 | ;; it's all the if part 413 | nil 414 | ;; there is some else part 415 | (if (zerop distance-from-first-to-second-unmatched-end) 416 | ;; the else never ends 417 | (subseq program distance-to-first-unmatched-end) 418 | ;; the else does end 419 | (append (subseq program 420 | distance-to-first-unmatched-end 421 | (+ distance-to-first-unmatched-end 422 | distance-from-first-to-second-unmatched-end 423 | -1)) 424 | (subseq program (+ distance-to-first-unmatched-end 425 | distance-from-first-to-second-unmatched-end 426 | ))))))) 427 | 428 | (defun without-else-branch (program) 429 | "Assuming that a MEASURE form has just been removed from the given 430 | program, returns the remainder of the program without the ELSE (measure-0) 431 | branch." 432 | (let* ((distance-to-first-unmatched-end 433 | (distance-to-next-unmatched-end program)) 434 | (distance-from-first-to-second-unmatched-end 435 | (distance-to-next-unmatched-end 436 | (nthcdr distance-to-first-unmatched-end program)))) 437 | (if (zerop distance-to-first-unmatched-end) 438 | ;; it's all the if part 439 | program 440 | ;; there is some else part 441 | (if (zerop distance-from-first-to-second-unmatched-end) 442 | ;; the else never ends 443 | (subseq program 0 (- distance-to-first-unmatched-end 1)) 444 | ;; the else does end 445 | (append (subseq program 0 (- distance-to-first-unmatched-end 1)) 446 | (subseq program (+ distance-to-first-unmatched-end 447 | distance-from-first-to-second-unmatched-end 448 | ))))))) 449 | 450 | ; #| 451 | ; Test code for without-if-branch and without-else-branch: 452 | 453 | ; (setq p1 '((foo) (bar) (end) (baz) (bingo) (end) (biff) (boff))) 454 | ; (setq p2 '( (foo) (bar) 455 | ; (measure 0) (blink) (end) (blank) (end) 456 | ; (end) 457 | ; (baz) (bingo) 458 | ; (measure 1) (plonk) (end) (plank) (end) 459 | ; (end) 460 | ; (biff) (boff))) 461 | ; (setq p3 '( (foo) (bar) 462 | ; (measure 0) (blink) (measure 0)(end)(end)(end) (blank) (end) 463 | ; (end) 464 | ; (baz) (bingo) 465 | ; (measure 1) (plonk) (end) (plank) (measure 0)(end)(end)(end) 466 | ; (end) 467 | ; (biff) (boff))) 468 | 469 | ; (without-if-branch p1) 470 | ; (without-if-branch p2) 471 | ; (without-if-branch p3) 472 | ; (without-else-branch p1) 473 | ; (without-else-branch p2) 474 | ; (without-else-branch p3) 475 | 476 | 477 | ; (setq p4 '((end) (measure 1) (end) (end) (measure 1) (end))) 478 | ; (without-if-branch p4) 479 | ; (without-else-branch p4) 480 | ; |# 481 | 482 | (defun force-to (measured-value qubit qsys) 483 | "Collapses a quantum system to the provided measured-value for the provided 484 | qubit." 485 | (map-qubit-combinations 486 | qsys 487 | #'(lambda () 488 | (let* ((pre-column (extract-column qsys (list qubit))) 489 | (new-column (case measured-value 490 | (0 (list (first pre-column) 0)) 491 | (1 (list 0 (second pre-column)))))) 492 | (install-column qsys new-column (list qubit)))) 493 | (remove qubit (qubit-numbers qsys))) 494 | qsys) 495 | 496 | 497 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 498 | ;; top level functions 499 | 500 | (defvar *post-oracle-measurements*) ;*T* 501 | 502 | (defun run-qsys (qsys) 503 | "Takes a quantum system and returns the list of quantum systems that 504 | results from the execution of its program." 505 | (if (or (null (program qsys)) 506 | (zerop (prior-probability qsys))) 507 | (list qsys) 508 | (let ((instruction (first (program qsys)))) 509 | (setf (instruction-history qsys) 510 | (append (instruction-history qsys) (list instruction))) 511 | (if (eq (first instruction) 'halt) 512 | (list qsys) 513 | (if (eq (first instruction) 'measure) 514 | ;; it's a measurement so split state and return list of results 515 | (let* ((measurement-qubit (second instruction)) 516 | (probabilities (qc-output-probabilities qsys (list measurement-qubit)))) 517 | (append 518 | ;; 1 branch 519 | (run-qsys 520 | (force-to 1 measurement-qubit 521 | (make-instance 'quantum-system 522 | :number-of-qubits (number-of-qubits qsys) 523 | :amplitudes (copy-seq (amplitudes qsys)) 524 | :prior-probability (second probabilities) 525 | :oracle-count (oracle-count qsys) 526 | :measurement-history (append (measurement-history qsys) 527 | (list (list measurement-qubit 528 | 'is 1))) 529 | :instruction-history (instruction-history qsys) 530 | :program (without-else-branch (rest (program qsys)))))) 531 | ;; 0 branch 532 | (run-qsys 533 | (force-to 0 measurement-qubit 534 | (make-instance 'quantum-system 535 | :number-of-qubits (number-of-qubits qsys) 536 | :amplitudes (copy-seq (amplitudes qsys)) 537 | :prior-probability (first probabilities) 538 | :oracle-count (oracle-count qsys) 539 | :measurement-history (append (measurement-history qsys) 540 | (list (list measurement-qubit 541 | 'is 0))) 542 | :instruction-history (instruction-history qsys) 543 | :program (without-if-branch (rest (program qsys)))))))) 544 | (let ((resulting-sys 545 | (apply (first instruction) (cons qsys (rest instruction))))) 546 | (setf (program resulting-sys) (rest (program resulting-sys))) 547 | (run-qsys resulting-sys))))))) 548 | 549 | 550 | (defun execute-quantum-program (pgm num-qubits &optional (oracle-tt nil)) 551 | "Executes the provide quantum program with the specified number of qubits 552 | and the provided oracle truth table, returning a list of the resulting 553 | quantum systems." 554 | (run-qsys (make-instance 'quantum-system 555 | :number-of-qubits num-qubits 556 | :program (subst oracle-tt 'ORACLE-TT pgm)))) 557 | 558 | 559 | (defun test-quantum-program (pgm &key num-qubits cases final-measurement-qubits 560 | threshold (inspect nil) (debug 0)) 561 | "The top-level function to evaluate a quantum program relative to a list of 562 | a list of (oracle value) cases. Returns a list of: 563 | misses max-error average-error max-expected-oracles average-expected-oracles 564 | See documentation for a more complete explanation of the arguments and 565 | return values." 566 | (let ((misses 0) 567 | (max-error 0) 568 | (total-error 0) 569 | (average-error 0) 570 | (max-expected-oracles 0) 571 | (total-expected-oracles 0) 572 | (average-expected-oracles 0) 573 | (num-cases (length cases))) 574 | (dolist (case cases) 575 | (let* ((resulting-systems (execute-quantum-program 576 | pgm num-qubits (first case))) 577 | (raw-error (- 1.0 (nth (second case) 578 | (multi-qsys-output-probabilities 579 | resulting-systems final-measurement-qubits)))) 580 | (expected-oracles (expected-oracles resulting-systems))) 581 | (if (> raw-error threshold) (incf misses)) 582 | (incf total-error raw-error) 583 | (when (> raw-error max-error) 584 | (setq max-error raw-error)) 585 | (incf total-expected-oracles expected-oracles) 586 | (when (> expected-oracles max-expected-oracles) 587 | (setq max-expected-oracles expected-oracles)) 588 | (when (>= debug 2) 589 | (format t "~%---~%Case:~A, Error:~,5F" case raw-error)) 590 | (when inspect (inspect resulting-systems)))) 591 | (setq average-error (/ total-error num-cases)) 592 | (setq average-expected-oracles (/ total-expected-oracles num-cases)) 593 | (when (>= debug 1) 594 | (format t "~%~%Misses:~A" misses) 595 | (format t "~%Max error:~A" max-error) 596 | (format t "~%Average error:~A" (float average-error)) 597 | (format t "~%Max expected oracles:~A" max-expected-oracles) 598 | (format t "~%Average expected oracles:~A" (float average-expected-oracles))) 599 | (list misses max-error average-error max-expected-oracles average-expected-oracles))) 600 | 601 | 602 | 603 | ; #| 604 | 605 | ; EXAMPLES 606 | 607 | ; To run each example evaluate the relevant definition and then call the function 608 | ; with or without a debugging argument (which should be 0 for no debugging info, 609 | ; 1 for a little debugging info, and 1 for a lot of debugging info). For example, 610 | ; after evaluating the test-herbs-grover function definition you could try the 611 | ; following calls: 612 | 613 | ; (test-herbs-grover) ;; for no debugging info 614 | ; (test-herbs-grover 1) ;; for some debugging info (just results) 615 | ; (test-herbs-grover 2) ;; for more debugging info 616 | 617 | 618 | ;; 619 | 620 | 621 | (defun test-branching (&optional (debug 0)) 622 | "Creates 4 final quantum systems and invokes the inspector on each." 623 | (test-quantum-program 624 | `((hadamard 0) 625 | (measure 0) 626 | (hadamard 1) 627 | (measure 1) 628 | (end) 629 | (end) 630 | (end) 631 | (hadamard 2) 632 | (measure 2) 633 | (end) 634 | (end) 635 | (end) 636 | ) 637 | :num-qubits 3 638 | :cases '(((1 0) 0)) ;; an arbitrary case, just so it'll run 639 | :final-measurement-qubits (list 0) 640 | :threshold 0.48 641 | :debug debug 642 | :inspect t)) 643 | 644 | ; (test-branching) 645 | 646 | 647 | (defun test-herbs-grover (&optional (debug 0)) 648 | "Tests Herb Bernstein's version of Grover's quantum database search 649 | algorithm for a 4 item database on all four 'single marked item' test 650 | cases." 651 | (test-quantum-program 652 | `((hadamard 2) 653 | (hadamard 1) 654 | (u-theta 0 ,(/ pi 4)) 655 | (oracle ORACLE-TT 2 1 0) 656 | (hadamard 2) 657 | (cnot 2 1) 658 | (hadamard 2) 659 | (u-theta 2 ,(/ pi 2)) 660 | (u-theta 1 ,(/ pi 2)) 661 | ) 662 | :num-qubits 3 663 | :cases '(((1 0 0 0) 0) 664 | ((0 1 0 0) 1) 665 | ((0 0 1 0) 2) 666 | ((0 0 0 1) 3)) 667 | :final-measurement-qubits (list 2 1) 668 | :threshold 0.48 669 | :debug debug 670 | :inspect nil)) 671 | 672 | ; (test-herbs-grover 1) 673 | ; (test-herbs-grover 2) 674 | 675 | 676 | (defun test-evolved-grover (&optional (debug 0)) 677 | "Tests an evolved version of Grover's quantum database search 678 | algorithm (evolved with lgp2) for a 4 item database on all four 679 | 'single marked item' test cases." 680 | (test-quantum-program 681 | `((U-THETA 0 3.926990816987241) 682 | (HADAMARD 1) 683 | (U-THETA 2 -8.63937979737193) 684 | (ORACLE ORACLE-TT 2 1 0) 685 | (CPHASE 1 2 3.141592653589793) 686 | (CNOT 0 2) 687 | (HADAMARD 0) 688 | (U2 0 0.0 2.356194490192345 -3.4033920413889427 0) 689 | (HADAMARD 0) 690 | (U-THETA 1 2.356194490192345)) 691 | :num-qubits 3 692 | :cases '(((1 0 0 0) 0) 693 | ((0 1 0 0) 1) 694 | ((0 0 1 0) 2) 695 | ((0 0 0 1) 3)) 696 | :final-measurement-qubits (list 1 0) 697 | :threshold 0.48 698 | :debug debug 699 | :inspect nil)) 700 | 701 | ; (test-evolved-grover 1) 702 | ; (test-evolved-grover 2) 703 | 704 | 705 | (defun test-evolved-and-or (&optional (debug 0)) 706 | (test-quantum-program 707 | '((U2 2 -6.088543013651391 -34.36116964863836 -7.682902920850156 0.0013517818812377553) 708 | (U-THETA 2 94.46204015939107) 709 | (HADAMARD 0) 710 | (HADAMARD 1) 711 | (ORACLE ORACLE-TT 1 0 2) 712 | (U-THETA 2 -54.494324298211346) 713 | (HADAMARD 0) 714 | (MEASURE 0) 715 | (swap 2 0) 716 | (halt) 717 | (end) 718 | (U2 2 -0.20450950372104815 -34.76200757140856 -7.856634973508906 -0.04960986541249215) 719 | (U-THETA 2 190.24766604570047) 720 | (MEASURE 2) 721 | (HADAMARD 2) 722 | (CNOT 2 1) 723 | (U-THETA 2 3.9269907773297987) 724 | ) 725 | :num-qubits 3 726 | :cases '(((0 0 0 0) 0) 727 | ((0 0 0 1) 0) 728 | ((0 0 1 0) 0) 729 | ((0 0 1 1) 0) 730 | ((0 1 0 0) 0) ((0 1 0 1) 1) ((0 1 1 0) 1) ((0 1 1 1) 1) 731 | ((1 0 0 0) 0) ((1 0 0 1) 1) ((1 0 1 0) 1) ((1 0 1 1) 1) 732 | ((1 1 0 0) 0) ((1 1 0 1) 1) ((1 1 1 0) 1) ((1 1 1 1) 1) 733 | ) 734 | :final-measurement-qubits (list 2) 735 | :threshold 0.48 736 | :debug debug 737 | :inspect nil)) 738 | 739 | ; (test-evolved-and-or 1) 740 | ; (test-evolved-and-or 2) 741 | 742 | 743 | ; |# 744 | 745 | ;; EOF 746 | --------------------------------------------------------------------------------