Zander671/cl-quantum
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Initial implementation (hopefully) done

Browse Source
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

60
circuit.lisp
View File

@ -1,16 +1,19 @@
(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)
(let ((matrix (case operator
(:* identity-2x2)
(:x pauli-x-gate)
(:y pauli-y-gate)
(:z pauli-z-gate)
(:h hadamard-gate)
(:p phase-gate)
(:t pi/8-gate)
(:cnot pauli-x-gate)
(:cz pauli-z-gate))))
(:* +identity-2x2+)
(:x +pauli-x-gate+)
(:y +pauli-y-gate+)
(:z +pauli-z-gate+)
(:h +hadamard-gate+)
(:p +phase-gate+)
(: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)
@ -30,7 +33,8 @@
(:cz 2 nil circuit-matrix-operation)
(:measure 2 t ,(lambda (state operator &rest args)
(declare (ignorable operator))
(nmeasure state (car args))))))
(nmeasure state (car args)
:places *circuit-measure-places*)))))
(defun make-circuit ()
"Create a new blank circuit."
@ -52,7 +56,7 @@
(nconc circuit (list (cons operator args))))
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
addition to function calls to functions named in `*circuit-operators*'."
(let ((circuit-var (gensym))
@ -68,17 +72,17 @@ addition to function calls to functions named in `*circuit-operators*'."
(< ,size-var ,ao-i-var))
(setq ,size-var ,ao-i-var)))
(push ,ao-entry-var ,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)))))
*circuit-operators*))
,@body))
(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)))))
*circuit-operators*))
,@body))
(cons (1+ ,size-var) (nreverse ,circuit-var)))))
(defun apply-circuit-operator-to-state (state operator args)
@ -93,7 +97,7 @@ ARGS."
(when has-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
specified in one of three ways:
- BITS: the number of qbits
@ -112,16 +116,10 @@ specified in one of three ways:
(state-bits state)))
(values
state
(loop for element in elements
(loop with *circuit-measure-places* = places
for element in elements
for name = (car element)
for args = (cdr element)
for result = (apply-circuit-operator-to-state state name args)
when 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")))

46
package.lisp
View File

@ -48,7 +48,20 @@
(defpackage :cl-quantum/state
(: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
#:nnormalize-state
#:state-bits
@ -59,26 +72,27 @@
#:bit-probability
#:nmeasure
#:measure
#:ncollapse
#:collapse
#:make-operator
#:make-controlled-operator
#:apply-operator
#:napply-operator
#:apply-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))
#:napply-controlled-operator))
(defpackage :cl-quantum/circuit
(: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))

26
parse.lisp
View File

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

2
pprint.lisp
View File

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

166
state.lisp
View File

@ -1,5 +1,82 @@
(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))
"Return non-nil if state is normalized. PLACES is the number of places to
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."
(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)
"Create an operator matrix that can act on a state with BITS bits and will
apply OPERATOR to TARGET."
(loop with out = (if (= (1- bits) target)
operator
identity-2x2)
+identity-2x2+)
for i from (- bits 2) downto 0
do (setq out (tensor-mm out (if (= i target)
operator
identity-2x2)))
+identity-2x2+)))
finally (return out)))
(defun make-controlled-operator (bits operator target control)
@ -102,7 +204,7 @@ apply OPERATOR to TARGET if CONTROL is set."
(cond
((= bit target) target-operator)
((= bit control) control-operator)
(t identity-2x2)))
(t +identity-2x2+)))
(tensor-chain (target-operator control-operator)
(loop with out = (matrix-for (1- bits) target-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
control-operator)))
finally (return out))))
(+mm (tensor-chain identity-2x2 unset-projector)
(tensor-chain operator set-projector))))
(+mm (tensor-chain +identity-2x2+ +unset-projector+)
(tensor-chain operator +set-projector+))))
(defun replace-state (target 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
modified STATE."
(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))