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:
Zander671
2024-12-08 09:41:05 -08:00
parent 5d2249e1fa
commit 5adc755be4
6 changed files with 200 additions and 120 deletions
Download Patch File Download Diff File Expand all files Collapse all files
state.lisp
+107 -59
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))