Skip to content

Commit 0197001

Browse files
jmbrjmbr
committed
Accelerate APPLY-QUBIT-PERMUTATION.
1 parent 391681a commit 0197001

File tree

3 files changed

+233
-112
lines changed

3 files changed

+233
-112
lines changed

‎dqvm/src/permutation.lisp

Lines changed: 182 additions & 110 deletions
Original file line numberDiff line numberDiff line change
@@ -4,33 +4,63 @@
44

55
(in-package #:dqvm2)
66

7-
;;; A simple implementation of a permutation data structure.
8-
9-
;;; Note that (make-permutation) and NIL both represent the identity.
7+
;;; Permutation classes for permuting sets of qubits.
8+
;;;
9+
;;; The value NIL represents the identity permutation. General permutations
10+
;;; are embodied by the PERMUTATION-GENERAL class. Permutations involving a
11+
;;; single transposition swapping 0 with another qubit are represented by the
12+
;;; PERMUTATION-TRANSPOSITION class.
13+
;;;
14+
;;; The generic function APPLY-QUBIT-PERMUTATION does the heavy lifting of
15+
;;; permuting addresses and the class hierarchy laid out here allows us to
16+
;;; accomplish significant speed-ups (applying a PERMUTATION-TRANSPOSITION is
17+
;;; more than three times faster than the equivalent application of a
18+
;;; PERMUTATION-GENERAL object).
1019

1120
(deftype transposition ()
1221
'(or null (cons alexandria:non-negative-fixnum
1322
alexandria:non-negative-fixnum)))
1423

1524
(defclass permutation ()
25+
()
26+
(:documentation "Base class for permutations."))
27+
28+
(defclass permutation-general (permutation)
1629
((number-of-transpositions
17-
:initarg :number-of-transpositions
1830
:type alexandria:non-negative-integer
31+
:initarg :number-of-transpositions
1932
:documentation "Number of transpositions defining the permutation.")
2033
(transpositions
21-
:initarg :transpositions
2234
:type list
35+
:initarg :transpositions
2336
:reader permutation-transpositions
2437
:documentation "Bijective map determined by transpositions, stored as an association list sorted by CAR."))
2538
(:default-initargs
2639
:transpositions nil)
27-
(:documentation "Permutation acting on sets of qubit indices."))
40+
(:documentation "Arbitrary permutation acting on sets of qubit indices."))
41+
42+
(defclass permutation-transposition ()
43+
((tau
44+
:type (unsigned-byte 6) ; Implies a maximum of 2⁶ = 64 qubits.
45+
:initarg :tau
46+
:initform (error-missing-initform :tau)
47+
:documentation "Positive value of τ in π = (0 τ)."))
48+
(:documentation "Specialized permutation involving a single transposition of the form π = (0 τ) where τ ≠ 0."))
49+
50+
(defmethod permutation-transpositions ((permutation permutation-transposition))
51+
(let ((tau (slot-value permutation 'tau)))
52+
(list (cons 0 tau) (cons tau 0))))
2853

29-
(defmethod print-object ((permutation permutation) stream)
54+
(defmethod print-object ((permutation permutation-general) stream)
3055
(print-unreadable-object (permutation stream :type t :identity t)
3156
(let ((transpositions (permutation-transpositions permutation)))
3257
(format stream "~:[~:A~;~{~A~^ ~}~]" transpositions transpositions))))
3358

59+
(defmethod print-object ((permutation permutation-transposition) stream)
60+
(print-unreadable-object (permutation stream :type t :identity t)
61+
(let ((tau (slot-value permutation 'tau)))
62+
(format stream "(0 . ~D) (~D . 0)" tau tau))))
63+
3464
(defun-inlinable make-permutation (&optional transpositions)
3565
"Allocate a permutation defined by TRANSPOSITIONS.
3666
@@ -43,11 +73,10 @@ DQVM2> (make-permutation '((2 . 1) (1 . 0)))
4373
#<permutation (0 . 2) (1 . 0) (2 . 1) {10086BB8B3}>
4474
4575
Note that in the example above, the transposition (0 2) was automatically added."
46-
(declare (optimize (speed 3) (safety 0))
76+
(declare #.qvm::*optimize-dangerously-fast*
4777
(type list transpositions))
4878

49-
(let ((permutation (make-instance 'permutation))
50-
(transpositions* nil)
79+
(let ((transpositions* nil)
5180
(domain nil)
5281
(codomain nil))
5382

@@ -59,6 +88,8 @@ Note that in the example above, the transposition (0 2) was automatically added.
5988
(error "Malformed permutation. A mapping ~D ↦ ~D already existed."
6089
(first z) (rest z))))))
6190

91+
(declare (inline check-transposition))
92+
6293
(loop :for (a . b) :in transpositions :do
6394
(check-transposition a b)
6495
(unless (= a b)
@@ -69,93 +100,85 @@ Note that in the example above, the transposition (0 2) was automatically added.
69100
(loop :for a :of-type alexandria:non-negative-fixnum
70101
:in (set-difference codomain domain)
71102
:for b :of-type alexandria:non-negative-fixnum
72-
:in (nset-difference domain codomain)
103+
:in (set-difference domain codomain)
73104
:unless (= a b) :do
74105
(pushnew (cons a b) transpositions* :test #'equal))
75106

76-
(setf (slot-value permutation 'number-of-transpositions) (length transpositions*)
77-
(slot-value permutation 'transpositions) (sort transpositions* #'< :key #'first))
78-
79-
permutation))
80-
81-
(defun-inlinable inverse-permutation (permutation)
82-
"Return the inverse of PERMUTATION."
83-
(declare (optimize (speed 3) (safety 0)))
84-
(when permutation
85-
86-
(let ((inverse-permutation (make-instance 'permutation))
87-
(transpositions (permutation-transpositions permutation)))
88-
89-
(setf (slot-value inverse-permutation 'transpositions) (loop :for (a . b) :in transpositions :collect (cons b a))
90-
(slot-value inverse-permutation 'number-of-transpositions) (slot-value permutation 'number-of-transpositions))
91-
92-
inverse-permutation)))
93-
94-
(defun is-identity-permutation-p (permutation)
95-
"Return T if PERMUTATION is the identity, NIL otherwise."
96-
(if (or (null permutation) (null (permutation-transpositions permutation)))
97-
t
98-
nil))
99-
100-
(defun-inlinable apply-permutation (permutation item)
101-
"Apply PERMUTATION to ITEM.
102-
103-
Examples
104-
--------
105-
106-
DQVM2> (apply-permutation (make-permutation) 42)
107-
42
108-
109-
DQVM2> (apply-permutation (make-permutation '((2 . 0))) 2)
110-
0
111-
112-
DQVM2> (apply-permutation (make-permutation '((2 . 1) (1 . 0))) 2)
113-
1"
114-
(declare (optimize (speed 3) (safety 0))
115-
(type (or null permutation) permutation)
116-
(type alexandria:non-negative-fixnum item))
117-
(the alexandria:non-negative-fixnum
118-
(if permutation
119-
(alexandria:if-let ((transposition (assoc item (permutation-transpositions permutation))))
120-
(rest transposition)
121-
item)
122-
item)))
123-
124-
(defun-inlinable apply-inverse-permutation (permutation item)
125-
"Apply PERMUTATION⁻¹ to ITEM."
126-
(apply-permutation (inverse-permutation permutation) item))
107+
(cond
108+
((and (null domain) (null codomain)) nil)
109+
((and (= 1 (length domain))
110+
(zerop (min (the qvm:amplitude-address (first domain))
111+
(the qvm:amplitude-address (first codomain)))))
112+
(make-instance 'permutation-transposition
113+
:tau (max (the qvm:amplitude-address (first domain))
114+
(the qvm:amplitude-address (first codomain)))))
115+
((and (= 2 (length domain))
116+
(null (set-difference domain codomain))
117+
(zerop (the qvm:amplitude-address (apply #'min domain))))
118+
(make-instance 'permutation-transposition :tau (apply #'max domain)))
119+
(t
120+
(make-instance 'permutation-general :number-of-transpositions (length transpositions*)
121+
:transpositions (sort transpositions* #'< :key #'first))))))
122+
123+
(defgeneric inverse-permutation (permutation)
124+
(:documentation "Return the inverse of PERMUTATION.")
125+
(declare #.qvm::*optimize-dangerously-fast*))
126+
127+
(defmethod inverse-permutation ((permutation (eql nil)))
128+
nil)
129+
130+
(defmethod inverse-permutation ((permutation permutation-transposition))
131+
permutation)
132+
133+
(defmethod inverse-permutation ((permutation permutation-general))
134+
(make-instance 'permutation-general
135+
:transpositions (loop :for (a . b) :in (permutation-transpositions permutation) :collect (cons b a))
136+
:number-of-transpositions (slot-value permutation 'number-of-transpositions)))
137+
138+
(defgeneric is-identity-permutation-p (permutation)
139+
(:documentation "Return T if PERMUTATION is the identity, NIL otherwise."))
140+
141+
(defmethod is-identity-permutation-p ((permutation (eql nil)))
142+
t)
143+
144+
(defmethod is-identity-permutation-p ((permutation permutation-transposition))
145+
nil) ; By construction PERMUTATION-TRANSPOSITION objects cannot be the identity.
146+
147+
(defmethod is-identity-permutation-p ((permutation permutation-general))
148+
(null (permutation-transpositions permutation)))
127149

128150
(defun compose-permutations (&rest permutations)
129151
"Return a new permutation that is the composition of PERMUTATIONS.
130152
131153
If PERMUTATIONS is the list π₁, π₂, ..., πₛ, then the result is the composition π₁ ∘ π₂ ∘ ... ∘ πₛ. In other words, the composition starts from right to left as in standard mathematical notation."
132-
(let (transpositions)
133-
134-
(let (domain)
135-
;; Aggregate the domain of the composed permutation to get a list of
136-
;; all possible relevant inputs.
137-
(loop :for permutation :in permutations :when permutation :do
138-
(loop :for transposition :of-type transposition :in (permutation-transpositions permutation) :do
139-
(let ((a (first transposition)))
140-
(declare (type alexandria:non-negative-fixnum a))
141-
(pushnew a domain))))
142-
143-
;; Now map each domain element to obtain transpositions.
144-
(loop :with codomain := (coerce domain 'vector)
145-
:for permutation :in (nreverse permutations) :when permutation :do
146-
(loop :for i :from 0 :for b :across codomain :do
147-
(setf (aref codomain i)
148-
(apply-permutation permutation (aref codomain i))))
149-
:finally
150-
(loop :for a :of-type alexandria:non-negative-fixnum :in domain
151-
:for b :of-type alexandria:non-negative-fixnum :across codomain
152-
:unless (= a b) :do
153-
(pushnew (cons a b) transpositions :test #'equal))))
154+
(let ((transpositions nil)
155+
(domain nil))
156+
157+
;; Aggregate the domain of the composed permutation to get a list of
158+
;; all possible relevant inputs.
159+
(loop :for permutation :in permutations :when permutation :do
160+
(loop :for transposition :of-type transposition :in (permutation-transpositions permutation) :do
161+
(let ((a (first transposition)))
162+
(declare (type alexandria:non-negative-fixnum a))
163+
(pushnew a domain))))
164+
165+
;; Now map each domain element to obtain transpositions.
166+
(loop :with codomain := (coerce domain 'vector)
167+
:for permutation :in (nreverse permutations) :when permutation :do
168+
(loop :for i :from 0 :for b :across codomain :do
169+
(setf (aref codomain i)
170+
(apply-permutation permutation (aref codomain i))))
171+
:finally
172+
(loop :for a :of-type alexandria:non-negative-fixnum :in domain
173+
:for b :of-type alexandria:non-negative-fixnum :across codomain
174+
:unless (= a b) :do
175+
(pushnew (cons a b) transpositions :test #'equal)))
154176

155177
(make-permutation transpositions)))
156178

157-
(defun-inlinable apply-qubit-permutation (permutation address)
158-
"Apply PERMUTATION to an index ADDRESS within a wavefunction.
179+
(defgeneric apply-qubit-permutation (permutation address)
180+
(:documentation
181+
"Apply PERMUTATION to an index ADDRESS within a wavefunction.
159182
160183
Examples
161184
--------
@@ -165,36 +188,56 @@ DQVM2> (apply-qubit-permutation (make-permutation '((2 . 0))) #b100)
165188
166189
DQVM2> (write (apply-qubit-permutation (make-permutation '((2 . 0))) #b001) :base 2)
167190
100
168-
4"
191+
4")
192+
(declare #.qvm::*optimize-dangerously-fast*))
193+
194+
(defmethod apply-qubit-permutation ((permutation (eql nil)) address)
195+
address)
196+
197+
(defmethod apply-qubit-permutation ((permutation permutation-transposition) address)
198+
(declare #.qvm::*optimize-dangerously-fast*
199+
(type (or null permutation) permutation)
200+
;; (type qvm:amplitude-address address)
201+
(type (unsigned-byte 64) address) ; Imposed maximum number of qubits.
202+
(values qvm:amplitude-address))
203+
204+
(let ((tau (slot-value permutation 'tau)))
205+
(declare (type (unsigned-byte 6) tau))
206+
207+
(rotatef (ldb (byte 1 0) address) (ldb (byte 1 tau) address))
208+
address))
209+
210+
(defmethod apply-qubit-permutation ((permutation permutation) address)
169211
;; Alternatively, in-place permutations could be implemented following:
170212
;;
171213
;; F. Fich, J. Munro, and P. Poblete, “Permuting in Place,” SIAM
172214
;; J. Comput., vol. 24, no. 2, pp. 266–278, Apr. 1995.
173215

174-
(declare (optimize (speed 3) (safety 0))
216+
(declare #.qvm::*optimize-dangerously-fast*
175217
(type (or null permutation) permutation)
176-
(type qvm:amplitude-address address))
177-
178-
(the qvm:amplitude-address
179-
(if permutation
180-
(let* ((transpositions (slot-value permutation 'transpositions))
181-
(number-of-transpositions (slot-value permutation 'number-of-transpositions))
182-
(bit-vector (make-array number-of-transpositions :element-type 'bit)))
183-
;; (declare (dynamic-extent bit-vector))
184-
185-
(loop :for index :from 0
186-
:for transposition :in transpositions :do
187-
(setf (bit bit-vector index) (ldb (byte 1 (first transposition))
188-
address)))
189-
190-
(loop :for index :from 0
191-
:for transposition :of-type transposition :in transpositions :do
192-
(setf address (dpb (bit bit-vector index)
193-
;; (byte 1 (the (unsigned-byte 6) (rest transposition))) ; Enable this for speed (assumes a maximum of 64 qubits).
194-
(byte 1 (rest transposition))
195-
address))
196-
:finally (return address)))
197-
address)))
218+
;; (type qvm:amplitude-address address)
219+
(type (unsigned-byte 64) address) ; Imposed maximum number of qubits.
220+
(values qvm:amplitude-address))
221+
222+
(let* ((transpositions (slot-value permutation 'transpositions))
223+
(number-of-transpositions (slot-value permutation 'number-of-transpositions))
224+
(bit-vector (make-array number-of-transpositions :element-type 'bit)))
225+
(declare (type (integer 0 128) number-of-transpositions)
226+
(dynamic-extent bit-vector))
227+
228+
(loop :for index :from 0
229+
:for transposition :in transpositions :do
230+
(setf (bit bit-vector index) (ldb (byte 1 (first transposition))
231+
address)))
232+
233+
(loop :for index :from 0
234+
:for transposition :of-type transposition :in transpositions :do
235+
(setf address (the qvm:amplitude-address
236+
(dpb (bit bit-vector index)
237+
(byte 1 (the (unsigned-byte 6) (rest transposition))) ; Enable this for speed (assumes a maximum of 64 qubits).
238+
;; (byte 1 (rest transposition))
239+
address)))
240+
:finally (return address))))
198241

199242
(defun-inlinable apply-inverse-qubit-permutation (permutation address)
200243
(apply-qubit-permutation (inverse-permutation permutation) address))
@@ -213,3 +256,32 @@ DQVM2> (write (apply-qubit-permutation (make-permutation '((2 . 0))) #b001) :bas
213256
(dotimes (i1 max-value (values))
214257
(let ((i2 (apply-qubit-permutation permutation i1)))
215258
(format stream control-string i1 i1 i2 i2)))))
259+
260+
(defun-inlinable apply-permutation (permutation item)
261+
"Apply PERMUTATION to ITEM.
262+
263+
Examples
264+
--------
265+
266+
DQVM2> (apply-permutation (make-permutation) 42)
267+
42
268+
269+
DQVM2> (apply-permutation (make-permutation '((2 . 0))) 2)
270+
0
271+
272+
DQVM2> (apply-permutation (make-permutation '((2 . 1) (1 . 0))) 2)
273+
1"
274+
(declare #.qvm::*optimize-dangerously-fast*
275+
(type (or null permutation) permutation)
276+
(type alexandria:non-negative-fixnum item)
277+
(values alexandria:non-negative-fixnum))
278+
279+
(if permutation
280+
(alexandria:if-let ((transposition (assoc item (permutation-transpositions permutation))))
281+
(rest transposition)
282+
item)
283+
item))
284+
285+
(defun-inlinable apply-inverse-permutation (permutation item)
286+
"Apply PERMUTATION⁻¹ to ITEM."
287+
(apply-permutation (inverse-permutation permutation) item))

‎dqvm/tests/distributed-qvm-tests.lisp

Lines changed: 0 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -25,8 +25,6 @@
2525
"Find amplitude addresses to exchange when applying NEXT-PERMUTATION and the rank where the amplitudes are located.
2626
2727
Returns four sequences: current addresses, new addresses, and the source and target addresses."
28-
(check-type next-permutation permutation)
29-
3028
(let ((permutation (permutation addresses))
3129
(effective-permutation
3230
(dqvm2::get-effective-permutation addresses next-permutation))

0 commit comments

Comments
 (0)