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

Experiment

Browse Source
This commit is contained in:
Alexander Rosenberg 2024-12-19 12:25:23 -08:00
parent f702251949
commit 806fc10d8a
Signed by: Zander671
GPG Key ID: 5FD0394ADBD72730
5 changed files with 105 additions and 73 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

154
circuit.lisp
View File

@ -4,13 +4,13 @@
(defparameter *circuit-measure-places* 5
"The number of places to use with the :measure instruction in circuits.")
(defun circuit-arbitrary-gate (state operator gate target &optional control)
(defun circuit-arbitrary-gate (size operator gate target &optional control)
(declare (ignorable operator))
(if control
(napply-controlled-gate state gate target control)
(napply-gate state gate target)))
(make-controlled-operator size gate target control)
(make-operator size gate target)))
(defun circuit-matrix-operation (state operator target &optional control)
(defun circuit-matrix-operation (size operator target &optional control)
(let ((matrix (case operator
(:* +identity-2x2+)
(:x +pauli-x-gate+)
@ -22,16 +22,13 @@
(:cnot +pauli-x-gate+)
(:cz +pauli-z-gate+))))
(if control
(napply-controlled-gate state matrix target control)
(napply-gate state matrix target))))
(make-controlled-operator size matrix target control)
(make-operator size 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))))
(defun circuit-n-controlled-gate (size operator target controls)
(case operator
(:ntoff (make-n-toffoli-operator size target controls))
(:ncz (make-n-controlled-z-operator size target controls))))
(defparameter *circuit-operators*
;; Operator, # args, more args?, has output?, function
@ -47,36 +44,72 @@
(: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*)))
(:ntoff 2 nil nil circuit-n-controlled-gate)
(:ncz 2 nil nil circuit-n-controlled-gate)))
(:ncz 2 nil nil circuit-n-controlled-gate)
(:measure 2 nil t ,(lambda (size operator bit target)
(declare (ignorable size operator target))
(lambda (state)
(nmeasure state bit
:places *circuit-measure-places*))))))
(defun make-circuit ()
"Create a new blank circuit."
'(:circuit))
(defun make-circuit (bits)
"Create a new blank circuit of BITS bits."
`(:circuit ,bits))
(defun circuitp (obj)
"Return non-nil if OBJ is a quantum circuit."
(and (eq (first obj) :circuit)
(integerp (second obj))))
(defun add-to-circuit (circuit operator &rest args)
"Add OPERATOR to CIRCUIT."
(let ((entry (assoc operator *circuit-operators*)))
(let ((bits (second circuit))
(entry (assoc operator *circuit-operators*)))
(unless entry
(error "Unknown circuit operator: ~s" operator))
(destructuring-bind (name arg-count has-rest &rest r) entry
(declare (ignorable name r))
(destructuring-bind (name arg-count has-rest has-output func) entry
(declare (ignorable name))
(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))))
(let ((action (apply func bits operator args))
(prev-action (car (last circuit))))
(cond
((and (matrixp action) (matrixp prev-action))
(setf (car (last circuit)) (*mm action prev-action)))
((functionp action)
(setf (cdr (last circuit)) (list (cons action
(and has-output
(car (last args)))))))
(t (setf (cdr (last circuit)) (list action))))))
circuit))
(defmacro with-build-circuit (&body body)
(defun build-circuit-add-action (bits actions args)
"Add the action denoted by ARGS to the front of ACTIONS. The action is assumed
to operate on a state of BITS bits."
(let ((entry (assoc (car args) *circuit-operators*)))
(destructuring-bind (name arg-count has-rest has-output func) entry
(declare (ignorable arg-count has-rest))
(declare (ignorable name))
(let ((action (apply func bits (car args) (cdr args)))
(prev-action (car actions)))
(cond
((and (matrixp action) (matrixp prev-action))
(setf (car actions) (*mm action prev-action)))
((functionp action)
(push (cons action (and has-output (car (last args))))
actions))
(t (push action actions)))
actions))))
(defmacro with-build-circuit (bits &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)))
`(let ((,circuit-var))
(let ((circuit-var (gensym))
(bits-var (gensym)))
`(let ((,circuit-var)
(,bits-var ,bits))
(macrolet
(,@(mapcar (lambda (oper)
(let ((arg (gensym))
@ -91,44 +124,37 @@ addition to function calls to functions named in `*circuit-operators*'."
(declare (ignorable ,@arg-list
,@(when (third oper)
(list whole-arg))))
`(push (list ,@,arg) ,',circuit-var))))
`(setq ,',circuit-var
(build-circuit-add-action
,',bits-var ,',circuit-var (list ,@,arg))))))
*circuit-operators*))
,@body)
(cons :circuit (nreverse ,circuit-var)))))
(apply 'list :circuit ,bits-var (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-rest has-output function)
(assoc operator *circuit-operators*)
(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 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 uniform)))
()
"Exactly one of BITS, UNIFORM, COEFFICIENTS, and PROBABILITIES can ~
be present")
(let ((state (cond
(bits (make-zero-state bits))
(uniform (make-uniform-normal-state uniform))
(coefficients (coerce coefficients 'vector))
(probabilities (make-normal-state probabilities)))))
(defun run-circuit (circuit &key (state :zero) (places 5))
"Run the circuit CIRCUIT and return the final state. The initial STATE can be
specified in one of four ways:
- :ZERO: a zero state is used -> #(1 0 0 0), etc.
- :UNIFORM: a uniform state -> #(1/sqrt(2) 1/sqrt(2)), etc
- a vector: the initial coefficients"
(let ((real-state (cond
((eq state :zero)
(make-zero-state (second circuit)))
((eq state :uniform)
(make-uniform-normal-state (second circuit)))
(t (coerce state 'vector)))))
(values
state
real-state
(loop with *circuit-measure-places* = places
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))))
with outputs = ()
for action in (cddr circuit) do
(cond
((matrixp action)
(replace-state real-state (*mv action real-state)))
((consp action)
(destructuring-bind (func output) action
(let ((res (funcall func real-state)))
(when output
(push res outputs)
(push output outputs)))))
(t (error "Unknown circuit element type: ~s" action)))))))

16
examples/bell.lisp
View File

@ -1,29 +1,29 @@
;;;; Example Bell state creation circuits
(in-package :cl-quantum/examples)
(defun make-bell-phi+-circuit ()
(defun make-bell-phi+-circuit (bits)
"Return a circuit that makes a Bell phi+ state. That is |00>+|11>."
(with-build-circuit
(with-build-circuit bits
(:h 0)
(:cnot 1 0)))
(defun make-bell-phi--circuit ()
(defun make-bell-phi--circuit (bits)
"Return a circuit that makes a Bell phi- state. That is |00>-|11>."
(with-build-circuit
(with-build-circuit bits
(:h 0)
(:cnot 1 0)
(:z 1)))
(defun make-bell-psi+-circuit ()
(defun make-bell-psi+-circuit (bits)
"Return a circuit that makes a Bell psi+ state. That is |01>+|10>."
(with-build-circuit
(with-build-circuit bits
(:x 1)
(:h 0)
(:cnot 1 0)))
(defun make-bell-psi--circuit ()
(defun make-bell-psi--circuit (bits)
"Return a circuit that makes a Bell psi- state. That is |01>-|10>."
(with-build-circuit
(with-build-circuit bits
(:x 1)
(:h 0)
(:cnot 1 0)

2
examples/grover.lisp
View File

@ -12,7 +12,7 @@ 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
(with-build-circuit bits
;; Setup
(loop for i below bits do (:h i))

5
math.lisp
View File

@ -42,6 +42,11 @@ VALUE, the ROW, and the COLUMN."
(domatrix ((elem row col) matrix new-mat)
(setf (aref new-mat row col) (funcall function elem row col)))))
(defun matrixp (obj)
"Return non-nil if OBJ is a matrix."
(and (arrayp obj)
(= (array-rank obj) 2)))
;; Matrix subroutines
(defun minor (mat i j)
"Find the minor of MAT for I and J."

1
package.lisp
View File

@ -4,6 +4,7 @@ quantum operators.")
(:use :cl)
(:export #:domatrix
#:mapmatrix
#:matrixp
#:minor
#:cofactor
#:det