Initial implementation (hopefully) done

This commit is contained in:
Alexander Rosenberg 2024-12-08 09:41:05 -08:00
parent 5d2249e1fa
commit 5adc755be4
Signed by: Zander671
GPG Key ID: 5FD0394ADBD72730
6 changed files with 200 additions and 120 deletions

View File

@ -1,16 +1,19 @@
(in-package :cl-quantum/circuit) (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-matrix-operation (state operator &rest args)
(let ((matrix (case operator (let ((matrix (case operator
(:* identity-2x2) (:* +identity-2x2+)
(:x pauli-x-gate) (:x +pauli-x-gate+)
(:y pauli-y-gate) (:y +pauli-y-gate+)
(:z pauli-z-gate) (:z +pauli-z-gate+)
(:h hadamard-gate) (:h +hadamard-gate+)
(:p phase-gate) (:p +phase-gate+)
(:t pi/8-gate) (:t +pi/8-gate+)
(:cnot pauli-x-gate) (:cnot +pauli-x-gate+)
(:cz pauli-z-gate)))) (:cz +pauli-z-gate+))))
(destructuring-bind (target &optional control) args (destructuring-bind (target &optional control) args
(if control (if control
(napply-controlled-operator state matrix target control) (napply-controlled-operator state matrix target control)
@ -30,7 +33,8 @@
(:cz 2 nil circuit-matrix-operation) (:cz 2 nil circuit-matrix-operation)
(:measure 2 t ,(lambda (state operator &rest args) (:measure 2 t ,(lambda (state operator &rest args)
(declare (ignorable operator)) (declare (ignorable operator))
(nmeasure state (car args)))))) (nmeasure state (car args)
:places *circuit-measure-places*)))))
(defun make-circuit () (defun make-circuit ()
"Create a new blank circuit." "Create a new blank circuit."
@ -52,7 +56,7 @@
(nconc circuit (list (cons operator args)))) (nconc circuit (list (cons operator args))))
circuit)) circuit))
(defmacro with-circuit (&body body) (defmacro with-build-circuit (&body body)
"Create a circuit using a simple DSL. BODY can be any valid Lisp forms, in "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*'." addition to function calls to functions named in `*circuit-operators*'."
(let ((circuit-var (gensym)) (let ((circuit-var (gensym))
@ -93,7 +97,7 @@ ARGS."
(when has-output (when has-output
(cons (car (last args)) output))))) (cons (car (last args)) output)))))
(defun run-circuit (circuit &key bits coefficients probabilities) (defun run-circuit (circuit &key bits coefficients probabilities (places 5))
"Run the circuit CIRCUIT and return the final state. The initial state can be "Run the circuit CIRCUIT and return the final state. The initial state can be
specified in one of three ways: specified in one of three ways:
- BITS: the number of qbits - BITS: the number of qbits
@ -112,16 +116,10 @@ specified in one of three ways:
(state-bits state))) (state-bits state)))
(values (values
state state
(loop for element in elements (loop with *circuit-measure-places* = places
for element in elements
for name = (car element) for name = (car element)
for args = (cdr element) for args = (cdr element)
for result = (apply-circuit-operator-to-state state name args) for result = (apply-circuit-operator-to-state state name args)
when result when result
collect result))))) collect result)))))
(let ((circuit
(with-circuit
(:h 0)
(:cnot 0 1)
(:measure 0 :v1))))
(run-circuit circuit :bits 2))

20
cl-quantum.asd Normal file
View File

@ -0,0 +1,20 @@
(defsystem #:cl-quantum
:version "0.0.1"
:description "Quantum computing operations in pure Common Lisp."
:author "Alexander Rosenberg <zanderpkg@pm.me>"
:license "GPL3"
:depends-on ()
:serial t
:components
((:file "package")
(:file "math")
(:file "state")
(:file "circuit")
(:file "pprint")))
(defsystem #:cl-quantum/parse
:description "Textual state parsing component for cl-quantum."
:depends-on (#:cl-ppcre)
:serial t
:components
((:file "parse")))

View File

@ -48,7 +48,20 @@
(defpackage :cl-quantum/state (defpackage :cl-quantum/state
(:use :cl :cl-quantum/math) (:use :cl :cl-quantum/math)
(:export #:normal-state-p (:export #:+unset-projector+
#:+set-projector+
#:+identity-2x2+
#:+pauli-x-gate+
#:+pauli-y-gate+
#:+pauli-z-gate+
#:+hadamard-gate+
#:+phase-gate+
#:+pi/8-gate+
#:+cnot-gate+
#:+cz-gate+
#:+swap-gate+
#:+ccnot-gate+
#:normal-state-p
#:normalize-state #:normalize-state
#:nnormalize-state #:nnormalize-state
#:state-bits #:state-bits
@ -59,26 +72,27 @@
#:bit-probability #:bit-probability
#:nmeasure #:nmeasure
#:measure #:measure
#:ncollapse
#:collapse
#:make-operator #:make-operator
#:make-controlled-operator #:make-controlled-operator
#:apply-operator #:apply-operator
#:napply-operator #:napply-operator
#:apply-controlled-operator #:apply-controlled-operator
#:napply-controlled-operator #:napply-controlled-operator))
#:unset-projector
#:set-projector
#:identity-2x2
#:pauli-x-gate
#:pauli-y-gate
#:pauli-z-gate
#:hadamard-gate
#:phase-gate
#:pi/8-gate
#:cnot-gate
#:cz-gate
#:swap-gate
#:ccnot-gate))
(defpackage :cl-quantum/circuit (defpackage :cl-quantum/circuit
(:use :cl :cl-quantum/math :cl-quantum/state) (:use :cl :cl-quantum/math :cl-quantum/state)
(:export)) (:export #:*circuit-measure-places*
#:*circuit-operators*
#:make-circuit
#:add-to-circuit
#:with-build-circuit
#:run-circuit))
(defpackage :cl-quantum/pprint
(:use :cl :cl-quantum/math :cl-quantum/state)
(:export #:pprint-complex
#:pprint-format-bits
#:pprint-format-linear
#:pprint-state))

View File

@ -1,5 +1,5 @@
(defpackage :cl-quantum/parse (defpackage :cl-quantum/parse
(:use :cl :cl-quantum) (:use :cl :cl-quantum/state)
(:export #:parse-real (:export #:parse-real
#:parse-complex #:parse-complex
#:parse-state #:parse-state
@ -7,7 +7,7 @@
(in-package :cl-quantum/parse) (in-package :cl-quantum/parse)
(defconstant +parse-real-regexp+ (define-constant +parse-real-regexp+
(ppcre:create-scanner (ppcre:create-scanner
"^(\\s*([-+]?[0-9]+)(?:/([0-9]+)|\\.?([0-9]*)(?:[eE]([-+]?[0-9]+))?)\\s*)" "^(\\s*([-+]?[0-9]+)(?:/([0-9]+)|\\.?([0-9]*)(?:[eE]([-+]?[0-9]+))?)\\s*)"
:extended-mode t) :extended-mode t)
@ -44,7 +44,7 @@ stopped. That is, the index of the first un-parsed character."
(list 0 0) (list 0 0)
(error "Malformed number: ~s" (subseq string start end)))))) (error "Malformed number: ~s" (subseq string start end))))))
(defconstant +parse-complex-regexp+ (define-constatnt +parse-complex-regexp+
(ppcre:create-scanner (ppcre:create-scanner
"^\\s*([-+])?\\s*([-+]?)([0-9/.]+(?:[eE][-+]?[0-9]+)?)?(i)?" "^\\s*([-+])?\\s*([-+]?)([0-9/.]+(?:[eE][-+]?[0-9]+)?)?(i)?"
:extended-mode t) :extended-mode t)
@ -83,7 +83,7 @@ which parsing stopped. That is, the index of the first un-parsed character."
(error "Junk in string: ~s" (subseq string start end)) (error "Junk in string: ~s" (subseq string start end))
(return (values num pos))))) (return (values num pos)))))
(defconstant +parse-state-regexp+ (define-constant +parse-state-regexp+
(ppcre:create-scanner (ppcre:create-scanner
"^\\s*([-+])?\\s*(\\()?\\s*([-+0-9ei./]*)\\s*(\\))?\\s*\\|([^>]*)>" "^\\s*([-+])?\\s*(\\()?\\s*([-+0-9ei./]*)\\s*(\\))?\\s*\\|([^>]*)>"
:extended-mode t) :extended-mode t)

View File

@ -1,4 +1,4 @@
(in-package :cl-quantum) (in-package :cl-quantum/pprint)
(defun pprint-complex (n &key parens (places 5)) (defun pprint-complex (n &key parens (places 5))
"Pretty-print the complex (or real, rational, etc.) number N. If PARENS is "Pretty-print the complex (or real, rational, etc.) number N. If PARENS is

View File

@ -1,5 +1,82 @@
(in-package :cl-quantum/state) (in-package :cl-quantum/state)
;;; 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."
`(defconstant ,name (if (boundp ',name)
(symbol-value ',name)
,value)
,@(when doc (list doc))))
;;; Gates and Operators:
(define-constant +unset-projector+
#2A((1 0)
(0 0)))
(define-constant +set-projector+
#2A((0 0)
(0 1)))
(define-constant +identity-2x2+
(make-identity-matrix 2))
(define-constant +pauli-x-gate+
#2A((0 1)
(1 0)))
(define-constant +pauli-y-gate+
#2A((0 #C(0 -1))
(#C(0 -1) 0)))
(define-constant +pauli-z-gate+
#2A((1 0)
(0 -1)))
(define-constant +hadamard-gate+
(let ((oort (/ (sqrt 2))))
(make-array '(2 2) :initial-contents
`((,oort ,oort)
(,oort ,(- oort))))))
(define-constant +phase-gate+
#2A((1 0)
(0 #C(0 1))))
(define-constant +pi/8-gate+
(make-array '(2 2) :initial-contents
`((1 0)
(0 ,(exp (complex 0 (/ pi 4)))))))
(define-constant +cnot-gate+
#2A((1 0 0 0)
(0 1 0 0)
(0 0 0 1)
(0 0 1 0)))
(define-constant +cz-gate+
#2A((1 0 0 0)
(0 1 0 0)
(0 0 1 0)
(0 0 0 -1)))
(define-constant +swap-gate+
#2A((1 0 0 0)
(0 0 1 0)
(0 1 0 0)
(0 0 0 1)))
(define-constant +ccnot-gate+
#2A((1 0 0 0 0 0 0 0)
(0 1 0 0 0 0 0 0)
(0 0 1 0 0 0 0 0)
(0 0 0 1 0 0 0 0)
(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)))
;;; State Functions:
(defun normal-state-p (state &key (places 5)) (defun normal-state-p (state &key (places 5))
"Return non-nil if state is normalized. PLACES is the number of places to "Return non-nil if state is normalized. PLACES is the number of places to
round the norm of STATE before checking." round the norm of STATE before checking."
@ -83,16 +160,41 @@ measurement. You will probably want to save the second value as the first value
too as the second value alone means pretty much nothing." too as the second value alone means pretty much nothing."
(nmeasure (copy-seq state) bit :places places)) (nmeasure (copy-seq state) bit :places places))
(defun ncollapse (state &key (places 5))
"Collapse STATE into a single quantum state. After this call, STATE will be a
state with a zero coefficient in all but one place. This returns two values, the
first is the index into which STATE collapsed and the second is STATE."
(nnormalize-state state)
(loop with rval = (random most-positive-fixnum)
with did-find = nil
for i below (length state)
for coef = (aref state i)
for plimit = 0 then limit
for prob = (round-to-place (* coef coef) places)
for limit = (+ plimit (* prob (1- most-positive-fixnum)))
when (and (not did-find) (< rval limit))
do (setf (aref state i) 1
did-find i)
else
do (setf (aref state i) 0)
finally (return (values did-find state))))
(defun collapse (state &key (places 5))
"Collapse STATE into a single quantum state. This is like `ncollapse', except
that it does not modify STATE. Thus, you will probably want to keep both
returned values."
(ncollapse (copy-seq state) :places places))
(defun make-operator (bits operator target) (defun make-operator (bits operator target)
"Create an operator matrix that can act on a state with BITS bits and will "Create an operator matrix that can act on a state with BITS bits and will
apply OPERATOR to TARGET." apply OPERATOR to TARGET."
(loop with out = (if (= (1- bits) target) (loop with out = (if (= (1- bits) target)
operator operator
identity-2x2) +identity-2x2+)
for i from (- bits 2) downto 0 for i from (- bits 2) downto 0
do (setq out (tensor-mm out (if (= i target) do (setq out (tensor-mm out (if (= i target)
operator operator
identity-2x2))) +identity-2x2+)))
finally (return out))) finally (return out)))
(defun make-controlled-operator (bits operator target control) (defun make-controlled-operator (bits operator target control)
@ -102,7 +204,7 @@ apply OPERATOR to TARGET if CONTROL is set."
(cond (cond
((= bit target) target-operator) ((= bit target) target-operator)
((= bit control) control-operator) ((= bit control) control-operator)
(t identity-2x2))) (t +identity-2x2+)))
(tensor-chain (target-operator control-operator) (tensor-chain (target-operator control-operator)
(loop with out = (matrix-for (1- bits) target-operator (loop with out = (matrix-for (1- bits) target-operator
control-operator) control-operator)
@ -110,8 +212,8 @@ apply OPERATOR to TARGET if CONTROL is set."
do (setq out (tensor-mm out (matrix-for i target-operator do (setq out (tensor-mm out (matrix-for i target-operator
control-operator))) control-operator)))
finally (return out)))) finally (return out))))
(+mm (tensor-chain identity-2x2 unset-projector) (+mm (tensor-chain +identity-2x2+ +unset-projector+)
(tensor-chain operator set-projector)))) (tensor-chain operator +set-projector+))))
(defun replace-state (target template) (defun replace-state (target template)
"Replace each element of TARGET with the corresponding element in TEMPLATE." "Replace each element of TARGET with the corresponding element in TEMPLATE."
@ -138,57 +240,3 @@ apply OPERATOR to TARGET if CONTROL is set."
"Apply OPERATOR to the bit numbered TARGET in STATE if CONTROL is set. This "Apply OPERATOR to the bit numbered TARGET in STATE if CONTROL is set. This
modified STATE." modified STATE."
(replace-state state (apply-controlled-operator state operator target control))) (replace-state state (apply-controlled-operator state operator target control)))
;;; Gates and Operators:
(defconstant unset-projector
#2A((1 0)
(0 0)))
(defconstant set-projector
#2A((0 0)
(0 1)))
(defconstant identity-2x2
(make-identity-matrix 2))
(defconstant pauli-x-gate
#2A((0 1)
(1 0)))
(defconstant pauli-y-gate
#2A((0 #C(0 -1))
(#C(0 -1) 0)))
(defconstant pauli-z-gate
#2A((1 0)
(0 -1)))
(defconstant hadamard-gate
(let ((oort (/ (sqrt 2))))
(make-array '(2 2) :initial-contents
`((,oort ,oort)
(,oort ,(- oort))))))
(defconstant phase-gate
#2A((1 0)
(0 #C(0 1))))
(defconstant pi/8-gate
(make-array '(2 2) :initial-contents
`((1 0)
(0 ,(exp (complex 0 (/ pi 4)))))))
(defconstant cnot-gate
(make-controlled-operator 2 pauli-x-gate 0 1))
(defconstant cz-gate
(make-controlled-operator 2 pauli-z-gate 0 1))
(defconstant swap-gate
#2A((1 0 0 0)
(0 0 1 0)
(0 1 0 0)
(0 0 0 1)))
(defconstant ccnot-gate
(nswap-rows (make-identity-matrix 8) 6 7))