permutation.lisp 11.2 KB
Newer Older
1 2
;; Permutations
;; Liam Healy, Sun Mar 26 2006 - 11:51
3
;; Time-stamp: <2008-12-31 21:10:05EST permutation.lisp>
lhealy's avatar
lhealy committed
4
;; $Id$
5 6 7 8

(in-package :gsl)

;;;;****************************************************************************
9
;;;; Permutation structure and CL object
10
;;;;****************************************************************************
Liam Healy's avatar
Liam Healy committed
11 12 13 14
   
(defclass permutation (mobject foreign-array)
  ((element-type
    :initform
15 16
    #+int64 '(unsigned-byte 64)
    #+int32 '(unsigned-byte 32)
Liam Healy's avatar
Liam Healy committed
17
    :reader element-type :allocation :class))
18
  (:documentation "GSL permutations."))
19

Liam Healy's avatar
Liam Healy committed
20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35
;;(pushnew (cons 'permutation *sizet-type*) *class-element-type* :test #'equal)

(cffi:defcstruct gsl-permutation-c	; The GSL struct
  (size sizet)
  (data :pointer))

(defmethod initialize-instance :after
    ((object permutation) &key dimensions &allow-other-keys)
  (let ((mptr (cffi:foreign-alloc 'gsl-permutation-c)))
    (setf (slot-value object 'mpointer)
	  mptr
	  (cffi:foreign-slot-value mptr 'gsl-permutation-c 'data)
	  (c-pointer object)
	  (cffi:foreign-slot-value mptr 'gsl-permutation-c 'size)
	  dimensions)
    (tg:finalize object (lambda () (cffi:foreign-free mptr)))))
36

37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52
(export 'make-permutation)
(defun make-permutation (n &optional (initialize t))
  "Make the object representing a permutation of n objects.
   If n is a permutation, make a new permutation of the same size.  If
   initialize is T (default), set to the identity permutation if n is
   an integer, or copy the permutation if it's a permutation."
  (let ((perm
	 (make-instance
	  'permutation
	  :dimensions (if (typep n 'permutation) (dimensions n) n))))
    (when initialize
      (if (typep n 'permutation)
	  (copy perm n)
	  (set-identity perm)))
    perm))

53 54 55 56
;;;;****************************************************************************
;;;; Setting values
;;;;****************************************************************************

57
(defmfun set-identity ((permutation permutation))
58
  "gsl_permutation_init"
59 60
  (((mpointer permutation) :pointer))
  :definition :method
61
  :c-return :void
62 63
  :outputs (permutation)
  :return (permutation)
64 65
  :documentation			; FDL
  "Initialize the permutation p to the identity, i.e.
liam's avatar
liam committed
66
   (0,1,2,...,n-1).")
67

68
(defmfun copy ((destination permutation) (source permutation))
69
  "gsl_permutation_memcpy"
70 71 72 73 74
  (((mpointer destination) :pointer)
   ((mpointer source) :pointer))
  :definition :method
  :inputs (source)
  :outputs (destination)
75
  :return (destination)
76 77 78
  :documentation			; FDL
  "Copy the elements of the permutation source into the
   permutation destination.  The two permutations must have the same size.")
79

80
(defmfun swap-elements ((p permutation) i j)
81
  "gsl_permutation_swap"
82 83 84 85
  (((mpointer p) :pointer) (i sizet) (j sizet))
  :definition :method
  :inputs (p)
  :outputs (p)
86
  :return (p)
87 88
  :documentation			; FDL
  "Exchanges the ith and jth elements of the permutation p.")
89 90 91 92 93

;;;;****************************************************************************
;;;; Permutation properties
;;;;****************************************************************************

liam's avatar
liam committed
94
(defmfun permutation-size (p)
95
  "gsl_permutation_size"
96 97
  (((mpointer p) :pointer))
  :c-return sizet
98
  :inputs (p)
99
  :documentation			; FDL
100
  "The size of the permutation p.")
101

liam's avatar
liam committed
102
(defmfun permutation-data (p)
103
  "gsl_permutation_data"
104
  (((mpointer p) :pointer))
105
  :c-return :pointer
106
  :inputs (p)
107
  :documentation			; FDL
108
  "A pointer to the array of elements in the
109
   permutation p.")
110

111 112 113 114
(defgeneric data-valid (object)
  (:documentation			; FDL
   "Check that the object p is valid."))

115
(defmfun data-valid ((permutation permutation))
116
  "gsl_permutation_valid"
117
  (((mpointer permutation) :pointer))
118
  :definition :method
119
  :c-return :boolean
120
  :inputs (permutation)
121 122 123
  :documentation			; FDL
  "Check that the permutation p is valid.  The n
  elements should contain each of the numbers 0 to n-1 once and only
124
  once.")
125 126 127 128 129

;;;;****************************************************************************
;;;; Permutation functions
;;;;****************************************************************************

liam's avatar
liam committed
130
(defmfun permutation-reverse (p)
131
  "gsl_permutation_reverse"
132
  (((mpointer p) :pointer))
133
  :c-return :void
134 135 136
  :inputs (p)
  :outputs (p)
  :return (p)
137 138
  :documentation			; FDL
  "Reverse the order of the elements of the permutation p.")
139

liam's avatar
liam committed
140
(defmfun permutation-inverse (inv p)
141
  "gsl_permutation_inverse"
142
  (((mpointer inv) :pointer) ((mpointer p) :pointer))
143
  :inputs (p)
144
  :outputs (inv)
145
  :return (inv)
146 147
  :documentation			; FDL
  "Find the inverse of the permutation p.")
148

liam's avatar
liam committed
149
(defmfun permutation-next (p)
150
  "gsl_permutation_next"
151
  (((mpointer p) :pointer))
152
  :c-return :success-failure
153
  :inputs (p)
154
  :outputs (p)
155
  :return (p :c-return)
156 157
  :documentation			; FDL
  "Advance the permutation p to the next permutation
158 159
   in lexicographic order and return p and T.  If no further
   permutations are available, return p and NIL with
160
   p unmodified.  Starting with the identity permutation and
161 162 163
   repeatedly applying this function will iterate through all possible
   permutations of a given order.")

liam's avatar
liam committed
164
(defmfun permutation-previous (p)
165
  "gsl_permutation_prev"
166
  (((mpointer p) :pointer))
167
  :c-return :success-failure
168
  :inputs (p)
169
  :outputs (p)
170
  :return (p :c-return)
171 172
  :documentation			; FDL
  "Step backwards from the permutation p to the
173
   previous permutation in lexicographic order, returning p and T.
174
   If no previous permutation is available, return
175
   p and NIL with p unmodified.")
176 177 178 179 180

;;;;****************************************************************************
;;;; Applying Permutations
;;;;****************************************************************************

liam's avatar
liam committed
181
(defmfun permute (p data stride n)
182
  "gsl_permute"
183
  (((mpointer p) :pointer) (data :pointer) (stride sizet) (n sizet))
184 185 186
  :inputs (p data)
  :outputs (data)
  :return (data)
187 188 189
  :documentation			; FDL
  "Apply the permutation p to the array data of
   size n with stride stride.")
190

liam's avatar
liam committed
191
(defmfun permute-inverse (p data stride n)
192
    "gsl_permute_inverse"
193
  (((mpointer p) :pointer) (data :pointer) (stride sizet) (n sizet))
194 195 196
  :inputs (p data)
  :outputs (data)
  :return (data)
197 198 199 200
  :documentation			; FDL
  "Apply the inverse of the permutation p to the array data of
   size n with stride.")

201 202 203 204
(defmfun permute-vector ((p permutation) (v vector))
  ("gsl_permute_vector" :type)
  (((mpointer p) :pointer) ((mpointer v) :pointer))
  :definition :generic
205
  :inputs (p v)
206
  :outputs (v)
207
  :return (v)
208
  :documentation			; FDL
209 210 211 212 213
  "Apply the permutation p to the elements of the
   vector v considered as a row-vector acted on by a permutation
   matrix from the right, v' = v P.  The jth column of the
   permutation matrix P is given by the p_j-th column of the
   identity matrix. The permutation p and the vector v must
214 215 216 217 218 219
   have the same length.")

(defmfun permute-vector-inverse ((p permutation) (v vector))
  ("gsl_permute_vector" :type "_inverse")
  (((mpointer p) :pointer) ((mpointer v) :pointer))
  :definition :generic
220
  :inputs (p v)
221
  :outputs (v)
222
  :return (v)
223 224 225 226 227 228 229
  :documentation			; FDL
  "Apply the permutation p to the elements of the
   vector v considered as a row-vector acted on by a permutation
   matrix from the right, v' = v P.  The jth column of the
   permutation matrix P is given by the p_j-th column of the
   identity matrix. The permutation p and the vector v must
   have the same length.")
230

liam's avatar
liam committed
231
(defmfun permutation* (p pa pb)
232
  "gsl_permutation_mul"
233 234 235
  (((mpointer p) :pointer)
   ((mpointer pa) :pointer)
   ((mpointer pb) :pointer))
236
  :inputs (pa pb)
237
  :outputs (p)
238
  :return (p)
239 240 241 242
  :documentation			; FDL
  "Combine the two permutations pa and pb into a
  single permutation p where p = pa . pb. The permutation
  p is equivalent to applying pb first and then pa.")
243 244 245 246 247

;;;;****************************************************************************
;;;; Permutations in cyclic form
;;;;****************************************************************************

liam's avatar
liam committed
248
(defmfun linear-to-canonical (q p)
249
  "gsl_permutation_linear_to_canonical"
250
  (((mpointer q) :pointer) ((mpointer p) :pointer))
251
  :inputs (p)
252
  :outputs (q)
253 254 255
  :documentation			; FDL
  "Compute the canonical form of the permutation p and
   stores it in the output argument q.")
256

liam's avatar
liam committed
257
(defmfun canonical-to-linear (p q)
258
  "gsl_permutation_canonical_to_linear"
259
  (((mpointer p) :pointer) ((mpointer q) :pointer))
260
  :inputs (q)
261
  :outputs (p)
262 263 264
  :documentation			; FDL
  "Convert a permutation q in canonical form back into
   linear form storing it in the output argument p.")
265

liam's avatar
liam committed
266
(defmfun inversions (p)
267 268
  "gsl_permutation_inversions" (((mpointer p) :pointer))
  :c-return sizet
269
  :inputs (p)
270
  :documentation			; FDL
271
  "Count the number of inversions in the permutation
272
  p.  An inversion is any pair of elements that are not in order.
273 274 275 276
  For example, the permutation 2031 has three inversions, corresponding to
  the pairs (2,0) (2,1) and (3,1).  The identity permutation has no
  inversions.")

liam's avatar
liam committed
277
(defmfun linear-cycles (p)
278 279
  "gsl_permutation_linear_cycles" (((mpointer p) :pointer))
  :c-return sizet
280
  :inputs (p)
281 282
  :documentation			; FDL
  "Count the number of cycles in the permutation p, given in linear form.")
283

liam's avatar
liam committed
284
(defmfun canonical-cycles (p)
285
  "gsl_permutation_canonical_cycles"
286 287
  (((mpointer p) :pointer))
  :c-return sizet
288
  :inputs (p)
289 290
  :documentation			; FDL
  "Count the number of cycles in the permutation q, given in canonical form.")
291

292 293 294 295
;;;;****************************************************************************
;;;; Examples and unit test
;;;;****************************************************************************

296 297
(defun generate-all-permutations (n)
  "Generate all the permutations of n objects."
298
  (let ((perm (make-permutation n)))
299 300
    (set-identity perm)
    (loop collect (copy-seq (cl-array perm))
301
	  while (permutation-next perm))))
302

303 304
(defun generate-all-permutations-backwards (n)
  "Generate all the permutations of n objects."
305
  (let ((perm (make-permutation n)))
306 307 308 309 310
    (set-identity perm)
    (permutation-reverse perm)
    (loop collect (copy-seq (cl-array perm))
	  while (permutation-previous perm))))

Liam Healy's avatar
Liam Healy committed
311
(save-test
liam's avatar
liam committed
312
 permutation
313
 (let ((perm-1 (make-permutation 4 t)))	;maref
314
   (maref perm-1 2))
315
 (let ((perm-1 (make-permutation 4 t)))	;cl-array
316
   (cl-array perm-1))
317
 (let ((perm-1 (make-permutation 4 t)))	;permutation-reverse
liam's avatar
liam committed
318
   (set-identity perm-1)
319
   (cl-array (permutation-reverse perm-1)))
320 321
 (let				;permutation-next, permutation-inverse
     ((perm-1 (make-permutation 4 t)) (perm-2 (make-permutation 4 t)))
liam's avatar
liam committed
322 323 324 325 326
   (set-identity perm-1)
   (permutation-next perm-1)
   (permutation-next perm-1)
   (permutation-next perm-1)
   (permutation-inverse perm-2 perm-1)
327
   (cl-array perm-2))
328
 (let ((perm-1 (make-permutation 4 t)))	;swap-elements
liam's avatar
liam committed
329 330
   (set-identity perm-1)
   (swap-elements perm-1 1 3)
331
   (cl-array perm-1))
332 333
 (let ((perm-1 (make-permutation 4 t))	;permute-vector
       (intvec #31m(11 22 33 44)))
liam's avatar
liam committed
334 335 336 337
   (set-identity perm-1)
   (swap-elements perm-1 1 3)
   (swap-elements perm-1 0 2)
   (permute-vector perm-1 intvec)
338
   (cl-array intvec))
339
 (let ((perm-1 (make-permutation 4 t)))	;inversions
liam's avatar
liam committed
340 341 342
   (set-identity perm-1)
   (swap-elements perm-1 1 3)
   (inversions perm-1))
343
 (let ((perm-1 (make-permutation 4 t)))	;linear-cycles
liam's avatar
liam committed
344 345 346
   (set-identity perm-1)
   (swap-elements perm-1 1 3)
   (linear-cycles perm-1))
347
 (let ((perm-1 (make-permutation 4 t)))	;canonical-cycles
liam's avatar
liam committed
348 349 350 351
   (set-identity perm-1)
   (swap-elements perm-1 1 3)
   (swap-elements perm-1 0 2)
   (canonical-cycles perm-1)))