From 5d8b495a06e6920c08028689dc3a32fccdd1df94 Mon Sep 17 00:00:00 2001 From: Alexander Rosenberg Date: Fri, 6 Dec 2024 22:24:29 -0800 Subject: [PATCH] Work on parsing and operators --- .gitignore | 1 + math.lisp | 94 +++++++++++++++++++++++++++++++++++---- state.lisp | 127 +++++++++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 213 insertions(+), 9 deletions(-) create mode 100644 .gitignore diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..0a7b27d --- /dev/null +++ b/.gitignore @@ -0,0 +1 @@ +*.fasl \ No newline at end of file diff --git a/math.lisp b/math.lisp index 153f422..5c529e2 100644 --- a/math.lisp +++ b/math.lisp @@ -60,13 +60,6 @@ VALUE, the ROW, and the COLUMN." col))) (setf (aref minor out-row out-col) (aref mat row col))))))))) -(defun first-column-cofactors (mat) - "Find the cofactors for the first column of MAT." - (let* ((height (array-dimension mat 0)) - (out-arr (make-array height))) - (dotimes (i height out-arr) - (setf (aref out-arr i) (cofactor mat i 0))))) - (defun cofactor-sgn (i j) "Return the sign of the cofactor at I and J." (expt -1 (+ i j))) @@ -75,6 +68,13 @@ VALUE, the ROW, and the COLUMN." "Find the cofactor for I and J in MAT." (* (cofactor-sgn i j) (det (mat-minor mat i j)))) +(defun first-column-cofactors (mat) + "Find the cofactors for the first column of MAT." + (let* ((height (array-dimension mat 0)) + (out-arr (make-array height))) + (dotimes (i height out-arr) + (setf (aref out-arr i) (cofactor mat i 0))))) + (defun det2x2 (mat) "Find the determinate of a 2x2 matrix MAT." (let ((a (aref mat 0 0)) @@ -295,6 +295,84 @@ already been calculated, they can be supplied in FIRST-COLUMN-COFACTORS." (dotimes (i n mat) (setf (aref mat i i) 1)))) +(defun copy-matrix (mat) + "Return a copy of MAT." + (mapmatrix (lambda (val row col) + (declare (ignorable row col)) + val) + mat)) + +(defun nswap-rows (mat r1 r2) + "Swap rows R1 and R2 in mat. R1 and R2 are 0-indexed. This operation is +destructive." + (let ((width (array-dimension mat 1))) + (dotimes (i width mat) + (rotatef (aref mat r1 i) (aref mat r2 i))))) + +(defun swap-rows (mat r1 r2) + "Swap rows R1 and R2 in mat. R1 and R2 are 0-indexed. This operation is +not destructive." + (mapmatrix (lambda (val row col) + (cond + ((= r1 row) + (aref mat r2 col)) + ((= r2 row) + (aref mat r1 col)) + (t val))) + mat)) + +(defun nscale-row (mat row scale) + "Replace ROW in MAT with itself multiplied by SCALE. ROW is 0-indexed." + (let ((width (array-dimension mat 1))) + (dotimes (i width mat) + (setf (aref mat row i) + (* scale (aref mat row i)))))) + +(defun scale-row (mat row scale) + "Like `nscale-row', but copy MAT." + (mapmatrix (lambda (val irow col) + (declare (ignorable col)) + (if (= irow row) + (* val scale) + val)) + mat)) + +(defun nreplace-row-with-sum (mat r1 r2 &key (scale 1)) + "Replace row R2 in MAT with R1 + SCALE * R2. ROW is 0-indexed." + (let ((width (array-dimension mat 1))) + (dotimes (i width mat) + (incf (aref mat r1 i) (* scale (aref mat r2 i)))))) + +(defun replace-row-with-sum (mat r1 r2 &key (scale 1)) + "Like `nreplace-row-with-sum', but copy MAT." + (mapmatrix (lambda (val row col) + (if (= row r1) + (+ val (* scale (aref mat r2 col))) + val)) + mat)) + +(defun tensor-mm (m1 m2) + "Calculate the tensor product of M1 and M2." + (let* ((height (* (array-dimension m1 0) + (array-dimension m2 0))) + (width (* (array-dimension m1 1) + (array-dimension m2 1))) + (out-mat (make-array (list height width)))) + (dotimes (row height out-mat) + (dotimes (col width) + (setf (aref out-mat row col) + (* (aref m1 (floor row (array-dimension m2 0)) + (floor col (array-dimension m2 1))) + (aref m2 (mod row (array-dimension m2 0)) + (mod col (array-dimension m2 1))))))))) + +(defun tensor-vv (v1 v2) + "Calculate the tensor product of V1 and V2." + (apply 'concatenate 'vector + (map 'list (lambda (elt) + (*vs v2 elt)) + v1))) + (defun round-to-place (num places &key (base 10)) "Round NUM to PLACES places in BASE." (let ((scale (expt base places))) @@ -387,5 +465,3 @@ which parsing stopped. That is, the index of the first un-parsed character." (< pos end)) (error "Junk in string: ~s" (subseq string start end)) (return (values num pos))))) - - diff --git a/state.lisp b/state.lisp index 5b02891..de058d4 100644 --- a/state.lisp +++ b/state.lisp @@ -111,3 +111,130 @@ round the norm of STATE before checking." "Make a uniform normalized quantum state of BITS qbits." (let ((size (ash 1 bits))) (make-array (ash 1 bits) :initial-element (/ (sqrt size))))) + +(defun bit-unset-index (bit n &key (period (ash 1 bit))) + "Return the Nth index in a state in which BIT is 0." + (multiple-value-bind (quo rem) + (floor n period) + (+ (* 2 period quo) rem))) + +(defun bit-set-index (bit n &key (period (ash 1 bit))) + "Return the Nth index in a state in which BIT is 1." + (+ (bit-unset-index bit n :period period))) + +(defun bit-probability (state bit) + "Return the probability that BIT is set in STATE." + (setq state (normalize-state state)) + (loop with period = (ash 1 bit) + for i below (/ (length state) 2) + for index = (bit-set-index bit i :period period) + for coef = (aref state index) + summing (* coef coef))) + +(defun nmeasure (state bit) + "Collapse BIT in STATE by measuring it. This will return t or nil depending +on the state the bit collapsed to. Note that this will also modify STATE." + (loop with prob = (round-to-place (bit-probability state bit) 5) + with limit = (* most-positive-fixnum prob) + with rnum = (random most-positive-fixnum) + with result = (>= rnum limit) + with period = (ash 1 bit) + for i below (/ (length state) 2) + for unset-index = (bit-unset-index bit i :period period) + for set-index = (+ period unset-index) + for unset-coef = (aref state unset-index) + for set-coef = (aref state set-index) + for new-coef = (sqrt (+ (* set-coef set-coef) + (* unset-coef unset-coef))) + if result + do (setf (aref state unset-index) 0 + (aref state set-index) new-coef) + else + do (setf (aref state unset-index) new-coef + (aref state set-index) 0) + finally (return (values result state)))) + +(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) + for i from (- bits 2) downto 0 + do (setq out (tensor-mm out (if (= i target) + operator + identity-2x2))) + finally (return out))) + +(defun make-controlled-operator (bits operator target controls) + "Create an operator matrix that can act on a state with BITS bits and will +apply OPERATOR to TARGET if CONTROLS are all set." + (labels ((matrix-for (bit target-operator control-operator) + (cond + ((= bit target) target-operator) + ((member bit controls :test '=) control-operator) + (t identity-2x2))) + (tensor-chain (target-operator control-operator) + (loop with out = (matrix-for (1- bits) target-operator + control-operator) + for i from (- bits 2) downto 0 + 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)))) + +;;; 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 cnot-gate + #2A((1 0 0 0) + (0 1 0 0) + (0 0 0 1) + (0 0 1 0))) + +(defconstant cz-gate + #2A((1 0 0 0) + (0 1 0 0) + (0 0 1 0) + (0 0 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 9) 7 8))