Add examples and clean up some stuff
This commit is contained in:
parent
5adc755be4
commit
9b8584bd6f
GPG Key ID:
5FD0394ADBD72730
127
circuit.lisp
127
circuit.lisp
@ -1,9 +1,16 @@
|
||||
;;;; High-level interface for building quantum circuits
|
||||
(in-package :cl-quantum/circuit)
|
||||
|
||||
(defparameter *circuit-measure-places* 5
|
||||
"The number of places to use with the :measure instruction in circuits.")
|
||||
|
||||
(defun circuit-matrix-operation (state operator &rest args)
|
||||
(defun circuit-arbitrary-gate (state operator gate target &optional control)
|
||||
(declare (ignorable operator))
|
||||
(if control
|
||||
(napply-controlled-gate state gate target control)
|
||||
(napply-gate state gate target)))
|
||||
|
||||
(defun circuit-matrix-operation (state operator target &optional control)
|
||||
(let ((matrix (case operator
|
||||
(:* +identity-2x2+)
|
||||
(:x +pauli-x-gate+)
|
||||
@ -14,112 +21,114 @@
|
||||
(:t +pi/8-gate+)
|
||||
(:cnot +pauli-x-gate+)
|
||||
(:cz +pauli-z-gate+))))
|
||||
(destructuring-bind (target &optional control) args
|
||||
(if control
|
||||
(napply-controlled-operator state matrix target control)
|
||||
(napply-operator state matrix target)))))
|
||||
(napply-controlled-gate state matrix target control)
|
||||
(napply-gate state matrix target))))
|
||||
|
||||
(defun circuit-n-controlled-gate (state operator target controls)
|
||||
(let ((func (case operator
|
||||
(:ntoff 'make-n-toffoli-operator)
|
||||
(:ncz 'make-n-controlled-z-operator))))
|
||||
(replace-state state (*mv (funcall func (state-bits state)
|
||||
target controls)
|
||||
state))))
|
||||
|
||||
(defparameter *circuit-operators*
|
||||
;; Operator, # args, has output?, function
|
||||
;; Operator, # args, more args?, has output?, function
|
||||
;; The output is always the last argument
|
||||
`((:* 1 nil circuit-matrix-operation)
|
||||
(:x 1 nil circuit-matrix-operation)
|
||||
(:y 1 nil circuit-matrix-operation)
|
||||
(:z 1 nil circuit-matrix-operation)
|
||||
(:h 1 nil circuit-matrix-operation)
|
||||
(:p 1 nil circuit-matrix-operation)
|
||||
(:t 1 nil circuit-matrix-operation)
|
||||
(:cnot 2 nil circuit-matrix-operation)
|
||||
(:cz 2 nil circuit-matrix-operation)
|
||||
(:measure 2 t ,(lambda (state operator &rest args)
|
||||
`((:gate 2 nil nil circuit-arbitrary-gate)
|
||||
(:cgate 3 nil nil circuit-arbitrary-gate)
|
||||
(:* 1 nil nil circuit-matrix-operation)
|
||||
(:x 1 nil nil circuit-matrix-operation)
|
||||
(:y 1 nil nil circuit-matrix-operation)
|
||||
(:z 1 nil nil circuit-matrix-operation)
|
||||
(:h 1 nil nil circuit-matrix-operation)
|
||||
(:p 1 nil nil circuit-matrix-operation)
|
||||
(:t 1 nil nil circuit-matrix-operation)
|
||||
(:cnot 2 nil nil circuit-matrix-operation)
|
||||
(:cz 2 nil nil circuit-matrix-operation)
|
||||
(:measure 2 nil t ,(lambda (state operator &rest args)
|
||||
(declare (ignorable operator))
|
||||
(nmeasure state (car args)
|
||||
:places *circuit-measure-places*)))))
|
||||
:places *circuit-measure-places*)))
|
||||
(:ntoff 2 nil nil circuit-n-controlled-gate)
|
||||
(:ncz 2 nil nil circuit-n-controlled-gate)))
|
||||
|
||||
(defun make-circuit ()
|
||||
"Create a new blank circuit."
|
||||
'(0))
|
||||
'(:circuit))
|
||||
|
||||
(defun add-to-circuit (circuit operator &rest args)
|
||||
"Add OPERATOR to CIRCUIT."
|
||||
(let ((entry (assoc operator *circuit-operators*))
|
||||
(largest-arg (apply 'max (remove-if-not 'integerp args))))
|
||||
(let ((entry (assoc operator *circuit-operators*)))
|
||||
(unless entry
|
||||
(error "Unknown circuit operator: ~s" operator))
|
||||
(destructuring-bind (name arg-count &rest r) entry
|
||||
(destructuring-bind (name arg-count has-rest &rest r) entry
|
||||
(declare (ignorable name r))
|
||||
(unless (= arg-count (length args))
|
||||
(error "Operator ~s expects ~s args, got ~s" operator
|
||||
arg-count (length args)))
|
||||
(when (> (1+ largest-arg) (car circuit))
|
||||
(setf (car circuit) (1+ largest-arg)))
|
||||
(unless (or (and has-rest (>= (length args) arg-count))
|
||||
(= (length args) arg-count))
|
||||
(error "Operator ~s expects ~@[~*exactly ~]~s arg~:p, got ~s" operator
|
||||
(not has-rest) arg-count (length args)))
|
||||
(nconc circuit (list (cons operator args))))
|
||||
circuit))
|
||||
|
||||
(defmacro with-build-circuit (&body body)
|
||||
"Create a circuit using a simple DSL. BODY can be any valid Lisp forms, in
|
||||
addition to function calls to functions named in `*circuit-operators*'."
|
||||
(let ((circuit-var (gensym))
|
||||
(size-var (gensym))
|
||||
(ao-func (gensym))
|
||||
(ao-entry-var (gensym))
|
||||
(ao-i-var (gensym)))
|
||||
`(let ((,circuit-var)
|
||||
(,size-var 0))
|
||||
(flet ((,ao-func (,ao-entry-var)
|
||||
(dolist (,ao-i-var ,ao-entry-var)
|
||||
(when (and (integerp ,ao-i-var)
|
||||
(< ,size-var ,ao-i-var))
|
||||
(setq ,size-var ,ao-i-var)))
|
||||
(push ,ao-entry-var ,circuit-var)))
|
||||
(let ((circuit-var (gensym)))
|
||||
`(let ((,circuit-var))
|
||||
(macrolet
|
||||
(,@(mapcar (lambda (oper)
|
||||
(let ((arg (gensym)))
|
||||
`(,(car oper) (&rest ,arg)
|
||||
(assert (= (length ,arg) ,(second oper))
|
||||
()
|
||||
"~s expects ~s arguments, got ~s"
|
||||
,(car oper) ,(second oper) (length ,arg))
|
||||
`(,',ao-func (list ,',(car oper) ,@,arg)))))
|
||||
(let ((arg (gensym))
|
||||
(arg-list (loop repeat (second oper)
|
||||
collect (gensym)))
|
||||
(whole-arg (when (third oper)
|
||||
(gensym))))
|
||||
`(,(car oper) (&whole ,arg
|
||||
,@arg-list
|
||||
,@(when (third oper)
|
||||
(list '&rest whole-arg)))
|
||||
(declare (ignorable ,@arg-list
|
||||
,@(when (third oper)
|
||||
(list whole-arg))))
|
||||
`(push (list ,@,arg) ,',circuit-var))))
|
||||
*circuit-operators*))
|
||||
,@body))
|
||||
(cons (1+ ,size-var) (nreverse ,circuit-var)))))
|
||||
,@body)
|
||||
(cons :circuit (nreverse ,circuit-var)))))
|
||||
|
||||
(defun apply-circuit-operator-to-state (state operator args)
|
||||
"Apply the circuit operator OPERATOR to STATE by calling its function with
|
||||
ARGS."
|
||||
(destructuring-bind (&optional name arg-count has-output function)
|
||||
(destructuring-bind (&optional name arg-count has-rest has-output function)
|
||||
(assoc operator *circuit-operators*)
|
||||
(declare (ignorable name arg-count))
|
||||
(declare (ignorable name arg-count has-rest))
|
||||
(assert function ()
|
||||
"Invalid circuit operator: ~s" operator)
|
||||
(let ((output (apply function state operator args)))
|
||||
(when has-output
|
||||
(cons (car (last args)) output)))))
|
||||
|
||||
(defun run-circuit (circuit &key bits coefficients probabilities (places 5))
|
||||
(defun run-circuit (circuit &key bits uniform coefficients probabilities (places 5))
|
||||
"Run the circuit CIRCUIT and return the final state. The initial state can be
|
||||
specified in one of three ways:
|
||||
- BITS: the number of qbits
|
||||
- COEFFICIENTS: the initial coefficients
|
||||
- PROBABILITES: the initial probabilities"
|
||||
(assert (= 1 (count-if 'identity (list bits coefficients probabilities)))
|
||||
(assert (= 1 (count-if 'identity (list bits coefficients probabilities uniform)))
|
||||
()
|
||||
"Exactly one of BITS, COEFFICIENTS, and PROBABILITIES can be present")
|
||||
"Exactly one of BITS, UNIFORM, COEFFICIENTS, and PROBABILITIES can ~
|
||||
be present")
|
||||
(let ((state (cond
|
||||
(bits (make-uniform-normal-state bits))
|
||||
(bits (make-zero-state bits))
|
||||
(uniform (make-uniform-normal-state uniform))
|
||||
(coefficients (coerce coefficients 'vector))
|
||||
(probabilities (make-normal-state probabilities)))))
|
||||
(destructuring-bind (circuit-size &rest elements) circuit
|
||||
(when (> circuit-size (state-bits state))
|
||||
(error "Circuit needs at least ~s bits, got ~s" circuit-size
|
||||
(state-bits state)))
|
||||
(values
|
||||
state
|
||||
(loop with *circuit-measure-places* = places
|
||||
for element in elements
|
||||
for element in (cdr circuit)
|
||||
for name = (car element)
|
||||
for args = (cdr element)
|
||||
for result = (apply-circuit-operator-to-state state name args)
|
||||
when result
|
||||
collect result)))))
|
||||
collect result))))
|
||||
|
||||
@ -2,6 +2,8 @@
|
||||
:version "0.0.1"
|
||||
:description "Quantum computing operations in pure Common Lisp."
|
||||
:author "Alexander Rosenberg <zanderpkg@pm.me>"
|
||||
:maintainer "Alexander Rosenberg <zanderpkg@pm.me>"
|
||||
:homepage "https://git.zander.im/Zander671/cl-quantum"
|
||||
:license "GPL3"
|
||||
:depends-on ()
|
||||
:serial t
|
||||
@ -10,11 +12,22 @@
|
||||
(:file "math")
|
||||
(:file "state")
|
||||
(:file "circuit")
|
||||
(:file "pprint")))
|
||||
(:file "pprint"))
|
||||
:long-description
|
||||
#.(uiop:read-file-string
|
||||
(uiop:subpathname *load-pathname* "README.md")))
|
||||
|
||||
(defsystem #:cl-quantum/parse
|
||||
:description "Textual state parsing component for cl-quantum."
|
||||
:depends-on (#:cl-ppcre)
|
||||
:serial t
|
||||
:depends-on (#:cl-quantum #:cl-ppcre)
|
||||
:components
|
||||
((:file "parse")))
|
||||
|
||||
(defsystem #:cl-quantum/examples
|
||||
:description "A collection of examples for ql-quantum."
|
||||
:depends-on (#:cl-quantum)
|
||||
:serial t
|
||||
:components
|
||||
((:file "examples/package")
|
||||
(:file "examples/grover")
|
||||
(:file "examples/bell")))
|
||||
|
||||
30
examples/bell.lisp
Normal file
30
examples/bell.lisp
Normal file
@ -0,0 +1,30 @@
|
||||
;;;; Example Bell state creation circuits
|
||||
(in-package :cl-quantum/examples)
|
||||
|
||||
(defun make-bell-phi+-circuit ()
|
||||
"Return a circuit that makes a Bell phi+ state. That is |00>+|11>."
|
||||
(with-build-circuit
|
||||
(:h 0)
|
||||
(:cnot 1 0)))
|
||||
|
||||
(defun make-bell-phi--circuit ()
|
||||
"Return a circuit that makes a Bell phi- state. That is |00>-|11>."
|
||||
(with-build-circuit
|
||||
(:h 0)
|
||||
(:cnot 1 0)
|
||||
(:z 1)))
|
||||
|
||||
(defun make-bell-psi+-circuit ()
|
||||
"Return a circuit that makes a Bell psi+ state. That is |01>+|10>."
|
||||
(with-build-circuit
|
||||
(:x 1)
|
||||
(:h 0)
|
||||
(:cnot 1 0)))
|
||||
|
||||
(defun make-bell-psi--circuit ()
|
||||
"Return a circuit that makes a Bell psi- state. That is |01>-|10>."
|
||||
(with-build-circuit
|
||||
(:x 1)
|
||||
(:h 0)
|
||||
(:cnot 1 0)
|
||||
(:z 1)))
|
||||
38
examples/grover.lisp
Normal file
38
examples/grover.lisp
Normal file
@ -0,0 +1,38 @@
|
||||
;;;; An example of Grover's algorithm (quantum search)
|
||||
(in-package :cl-quantum/examples)
|
||||
|
||||
(defun count-grover-iterations (bits targets)
|
||||
"Count the number of iterations it takes to have a high probability of finding
|
||||
TARGETS in a search space of 2^BITS."
|
||||
(values (floor (* (/ pi 4) (sqrt (/ (ash 1 bits) targets))))))
|
||||
|
||||
(defun make-grover-circuit (bits target)
|
||||
"Generate a quantum circuit that runs Grover's algorithm over a state of BITS
|
||||
bits and finds when the state is equal to TARGET."
|
||||
(assert (> (ash 1 bits) target)
|
||||
(bits target)
|
||||
"Target bit of ~s out of range for state with ~s bits." target bits)
|
||||
(with-build-circuit
|
||||
;; Setup
|
||||
(loop for i below bits do (:h i))
|
||||
|
||||
;; Oracle
|
||||
(loop
|
||||
repeat (count-grover-iterations bits 1)
|
||||
do
|
||||
(loop for i below bits
|
||||
for cur = (logand (ash target (- i)) 1)
|
||||
when (zerop cur)
|
||||
do (:x i))
|
||||
(:ncz 0 (loop for i from 1 below bits collect i))
|
||||
(loop for i below bits
|
||||
for cur = (logand (ash target (- i)) 1)
|
||||
when (zerop cur)
|
||||
do (:x i))
|
||||
|
||||
;; Diffuser
|
||||
(loop for i below bits do (:h i))
|
||||
(loop for i below bits do (:x i))
|
||||
(:ncz 0 (loop for i from 1 below bits collect i))
|
||||
(loop for i below bits do (:x i))
|
||||
(loop for i below bits do (:h i)))))
|
||||
8
examples/package.lisp
Normal file
8
examples/package.lisp
Normal file
@ -0,0 +1,8 @@
|
||||
(defpackage :cl-quantum/examples
|
||||
(:documentation "A collection of examples for ql-quantum.")
|
||||
(:use :cl :cl-quantum/state :cl-quantum/circuit)
|
||||
(:export #:make-grover-circuit
|
||||
#:make-bell-phi+-circuit
|
||||
#:make-bell-phi--circuit
|
||||
#:make-bell-psi+-circuit
|
||||
#:make-bell-psi--circuit))
|
||||
@ -1,3 +1,4 @@
|
||||
;;;; Basic linear algebra subroutines used to implement the quantum operators
|
||||
(in-package :cl-quantum/math)
|
||||
|
||||
(defmacro domatrix ((var matrix &optional retval) &body body)
|
||||
|
||||
20
package.lisp
20
package.lisp
@ -1,4 +1,6 @@
|
||||
(defpackage :cl-quantum/math
|
||||
(:documentation "Basic linear algebra subroutines used to implement the
|
||||
quantum operators.")
|
||||
(:use :cl)
|
||||
(:export #:domatrix
|
||||
#:mapmatrix
|
||||
@ -47,8 +49,10 @@
|
||||
#:vector=))
|
||||
|
||||
(defpackage :cl-quantum/state
|
||||
(:documentation "Functions for creating and applying quantum gates.")
|
||||
(:use :cl :cl-quantum/math)
|
||||
(:export #:+unset-projector+
|
||||
(:export #:define-constant
|
||||
#:+unset-projector+
|
||||
#:+set-projector+
|
||||
#:+identity-2x2+
|
||||
#:+pauli-x-gate+
|
||||
@ -65,6 +69,7 @@
|
||||
#:normalize-state
|
||||
#:nnormalize-state
|
||||
#:state-bits
|
||||
#:make-zero-state
|
||||
#:make-normal-state
|
||||
#:make-uniform-normal-state
|
||||
#:bit-unset-index
|
||||
@ -76,12 +81,16 @@
|
||||
#:collapse
|
||||
#:make-operator
|
||||
#:make-controlled-operator
|
||||
#:apply-operator
|
||||
#:napply-operator
|
||||
#:apply-controlled-operator
|
||||
#:napply-controlled-operator))
|
||||
#:make-n-toffoli-operator
|
||||
#:make-n-controlled-z-operator
|
||||
#:replace-state
|
||||
#:apply-gate
|
||||
#:napply-gate
|
||||
#:apply-controlled-gate
|
||||
#:napply-controlled-gate))
|
||||
|
||||
(defpackage :cl-quantum/circuit
|
||||
(:documentation "High-level interface for building quantum circuits.")
|
||||
(:use :cl :cl-quantum/math :cl-quantum/state)
|
||||
(:export #:*circuit-measure-places*
|
||||
#:*circuit-operators*
|
||||
@ -91,6 +100,7 @@
|
||||
#:run-circuit))
|
||||
|
||||
(defpackage :cl-quantum/pprint
|
||||
(:documentation "High-level interface for building quantum circuits.")
|
||||
(:use :cl :cl-quantum/math :cl-quantum/state)
|
||||
(:export #:pprint-complex
|
||||
#:pprint-format-bits
|
||||
|
||||
@ -1,5 +1,7 @@
|
||||
;;;; Parse back the states printed by pprint.lisp
|
||||
(defpackage :cl-quantum/parse
|
||||
(:use :cl :cl-quantum/state)
|
||||
(:documentation "Parse back the states printed by pprint.lisp.")
|
||||
(:use :cl :cl-quantum/math :cl-quantum/state)
|
||||
(:export #:parse-real
|
||||
#:parse-complex
|
||||
#:parse-state
|
||||
@ -44,7 +46,7 @@ stopped. That is, the index of the first un-parsed character."
|
||||
(list 0 0)
|
||||
(error "Malformed number: ~s" (subseq string start end))))))
|
||||
|
||||
(define-constatnt +parse-complex-regexp+
|
||||
(define-constant +parse-complex-regexp+
|
||||
(ppcre:create-scanner
|
||||
"^\\s*([-+])?\\s*([-+]?)([0-9/.]+(?:[eE][-+]?[0-9]+)?)?(i)?"
|
||||
:extended-mode t)
|
||||
|
||||
@ -1,3 +1,4 @@
|
||||
;;;; Create nice looking textual representations of quantum states
|
||||
(in-package :cl-quantum/pprint)
|
||||
|
||||
(defun pprint-complex (n &key parens (places 5))
|
||||
|
||||
101
state.lisp
101
state.lisp
@ -1,6 +1,7 @@
|
||||
;;;; Functions for creating and applying quantum gates
|
||||
(in-package :cl-quantum/state)
|
||||
|
||||
;;; Fix SBCL's strict handling of `defconstant'
|
||||
;; Fix SBCL's strict handling of `defconstant'
|
||||
(defmacro define-constant (name value &optional doc)
|
||||
"Define NAME to be a constant with value VALUE. If NAME is already defined, do
|
||||
nothing."
|
||||
@ -12,59 +13,72 @@ nothing."
|
||||
;;; Gates and Operators:
|
||||
(define-constant +unset-projector+
|
||||
#2A((1 0)
|
||||
(0 0)))
|
||||
(0 0))
|
||||
"|0><0| projector matrix.")
|
||||
|
||||
(define-constant +set-projector+
|
||||
#2A((0 0)
|
||||
(0 1)))
|
||||
(0 1))
|
||||
"|1><1| projector matrix.")
|
||||
|
||||
(define-constant +identity-2x2+
|
||||
(make-identity-matrix 2))
|
||||
(make-identity-matrix 2)
|
||||
"A 2 by 2 identity matrix.")
|
||||
|
||||
(define-constant +pauli-x-gate+
|
||||
#2A((0 1)
|
||||
(1 0)))
|
||||
(1 0))
|
||||
"A 2 by 2 Pauli X gate that can be applied to a single qbit.")
|
||||
|
||||
(define-constant +pauli-y-gate+
|
||||
#2A((0 #C(0 -1))
|
||||
(#C(0 -1) 0)))
|
||||
(#C(0 -1) 0))
|
||||
"A 2 by 2 Pauli Y gate that can be applied to a single qbit.")
|
||||
|
||||
(define-constant +pauli-z-gate+
|
||||
#2A((1 0)
|
||||
(0 -1)))
|
||||
(0 -1))
|
||||
"A 2 by 2 Pauli Z gate that can be applied to a single qbit.")
|
||||
|
||||
(define-constant +hadamard-gate+
|
||||
(let ((oort (/ (sqrt 2))))
|
||||
(make-array '(2 2) :initial-contents
|
||||
`((,oort ,oort)
|
||||
(,oort ,(- oort))))))
|
||||
(,oort ,(- oort)))))
|
||||
"A 2 by 2 Hadamard gate that can be applied to a single qbit.")
|
||||
|
||||
(define-constant +phase-gate+
|
||||
#2A((1 0)
|
||||
(0 #C(0 1))))
|
||||
(0 #C(0 1)))
|
||||
"A 2 by 2 phase gate that can be applied to a single qbit.")
|
||||
|
||||
(define-constant +pi/8-gate+
|
||||
(make-array '(2 2) :initial-contents
|
||||
`((1 0)
|
||||
(0 ,(exp (complex 0 (/ pi 4)))))))
|
||||
(0 ,(exp (complex 0 (/ pi 4))))))
|
||||
"A 2 by 2 phase gate that can be applied to a single qbit.")
|
||||
|
||||
(define-constant +cnot-gate+
|
||||
#2A((1 0 0 0)
|
||||
(0 1 0 0)
|
||||
(0 0 0 1)
|
||||
(0 0 1 0)))
|
||||
(0 0 1 0))
|
||||
"A 4 by 4 controlled NOT (Pauli X) gate that applies to a 2 qbit state. The 0
|
||||
indexed qbit is the target and the 1 indexed qbit is the control.")
|
||||
|
||||
(define-constant +cz-gate+
|
||||
#2A((1 0 0 0)
|
||||
(0 1 0 0)
|
||||
(0 0 1 0)
|
||||
(0 0 0 -1)))
|
||||
(0 0 0 -1))
|
||||
"A 4 by 4 controlled Pauli Z gate that applies to a 2 qbit state.")
|
||||
|
||||
(define-constant +swap-gate+
|
||||
#2A((1 0 0 0)
|
||||
(0 0 1 0)
|
||||
(0 1 0 0)
|
||||
(0 0 0 1)))
|
||||
(0 0 0 1))
|
||||
"A 4 by 4 swap gate that applies to a 2 qbit state.")
|
||||
|
||||
(define-constant +ccnot-gate+
|
||||
#2A((1 0 0 0 0 0 0 0)
|
||||
@ -74,7 +88,9 @@ nothing."
|
||||
(0 0 0 0 1 0 0 0)
|
||||
(0 0 0 0 0 1 0 0)
|
||||
(0 0 0 0 0 0 0 1)
|
||||
(0 0 0 0 0 0 1 0)))
|
||||
(0 0 0 0 0 0 1 0))
|
||||
"An 8 by 8 2-controlled NOT (Pauli X) gate that applies to a 3 qbit sate. The
|
||||
0 indexed qbit is the target and the 1 and 2 indexed qbits are the controls.")
|
||||
|
||||
;;; State Functions:
|
||||
(defun normal-state-p (state &key (places 5))
|
||||
@ -96,6 +112,13 @@ round the norm of STATE before checking."
|
||||
"Return the number of bits in STATE."
|
||||
(values (ceiling (log (length state) 2))))
|
||||
|
||||
(defun make-zero-state (bits)
|
||||
"Make a normalized state with a value of zero (probability of 1 in the zero
|
||||
place)."
|
||||
(let ((arr (make-array (ash 1 bits) :initial-element 0)))
|
||||
(setf (aref arr 0) 1)
|
||||
arr))
|
||||
|
||||
(defun make-normal-state (probabilities)
|
||||
"Create a new normalized state with the probability of each state
|
||||
corresponding to an element in PROBABILITIES."
|
||||
@ -116,6 +139,11 @@ corresponding to an element in PROBABILITIES."
|
||||
"Return the Nth index in a state in which BIT is 1."
|
||||
(+ period (bit-unset-index bit n :period period)))
|
||||
|
||||
(defun bit-set-p (bit n)
|
||||
"Return non-nil if BIT would be set at index N."
|
||||
(let ((period (ash 1 bit)))
|
||||
(>= (rem n (* 2 period)) period)))
|
||||
|
||||
(defun bit-probability (state bit)
|
||||
"Return the probability that BIT is set in STATE."
|
||||
(setq state (normalize-state state))
|
||||
@ -215,6 +243,39 @@ apply OPERATOR to TARGET if CONTROL is set."
|
||||
(+mm (tensor-chain +identity-2x2+ +unset-projector+)
|
||||
(tensor-chain operator +set-projector+))))
|
||||
|
||||
(defun make-n-toffoli-operator (bits target controls)
|
||||
"Create an n-Toffoli gate for a state of BITS bits that targets TARGET and is
|
||||
controlled by CONTROLS."
|
||||
(assert (not (member target controls :test '=))
|
||||
(target controls)
|
||||
"Target ~s cannot be in control set ~s" target controls)
|
||||
(let* ((state-size (ash 1 bits))
|
||||
(mat (make-identity-matrix state-size))
|
||||
(offset (ash 1 target)))
|
||||
(loop for i below (/ state-size 2)
|
||||
for index = (bit-unset-index target i)
|
||||
when (every (lambda (elt)
|
||||
(bit-set-p elt index))
|
||||
controls)
|
||||
do (nswap-rows mat index (+ index offset)))
|
||||
mat))
|
||||
|
||||
(defun make-n-controlled-z-operator (bits target controls)
|
||||
"Create an n-controlled z gate for a state of BITS bits that targets TARGET
|
||||
and is controlled by CONTROLS."
|
||||
(assert (not (member target controls :test '=))
|
||||
(target controls)
|
||||
"Target ~s cannot be in control set ~s" target controls)
|
||||
(let* ((state-size (ash 1 bits))
|
||||
(mat (make-identity-matrix state-size)))
|
||||
(loop for i below (/ state-size 2)
|
||||
for index = (bit-set-index target i)
|
||||
when (every (lambda (elt)
|
||||
(bit-set-p elt index))
|
||||
controls)
|
||||
do (setf (aref mat index index) -1))
|
||||
mat))
|
||||
|
||||
(defun replace-state (target template)
|
||||
"Replace each element of TARGET with the corresponding element in TEMPLATE."
|
||||
(assert (= (length target) (length template))
|
||||
@ -223,20 +284,20 @@ apply OPERATOR to TARGET if CONTROL is set."
|
||||
(dotimes (i (length target) target)
|
||||
(setf (aref target i) (aref template i))))
|
||||
|
||||
(defun apply-operator (state operator target)
|
||||
(defun apply-gate (state operator target)
|
||||
"Apply OPERATOR to the bit numbered TARGET in STATE."
|
||||
(*mv (make-operator (state-bits state) operator target) state))
|
||||
|
||||
(defun napply-operator (state operator target)
|
||||
(defun napply-gate (state operator target)
|
||||
"Apply OPERATOR to the bit numbered TARGET in STATE. This modifies state."
|
||||
(replace-state state (apply-operator state operator target)))
|
||||
(replace-state state (apply-gate state operator target)))
|
||||
|
||||
(defun apply-controlled-operator (state operator target control)
|
||||
(defun apply-controlled-gate (state operator target control)
|
||||
"Apply OPERATOR to the bit numbered TARGET in STATE if CONTROL is set."
|
||||
(*mv (make-controlled-operator (state-bits state) operator target control)
|
||||
state))
|
||||
|
||||
(defun napply-controlled-operator (state operator target control)
|
||||
(defun napply-controlled-gate (state operator target control)
|
||||
"Apply OPERATOR to the bit numbered TARGET in STATE if CONTROL is set. This
|
||||
modified STATE."
|
||||
(replace-state state (apply-controlled-operator state operator target control)))
|
||||
(replace-state state (apply-controlled-gate state operator target control)))
|
||||
|
||||
Loading…
Reference in New Issue
Block a user