sorting.lisp 11.5 KB
Newer Older
1 2
;; Sorting
;; Liam Healy, Fri Apr 14 2006 - 20:20
3
;; Time-stamp: <2011-01-10 18:16:18EST sorting.lisp>
4
;;
5
;; Copyright 2006, 2007, 2008, 2009, 2011 Liam M. Healy
6 7 8 9 10 11 12 13 14 15 16 17 18 19
;; Distributed under the terms of the GNU General Public License
;;
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
liam's avatar
liam committed
20 21 22 23 24 25 26 27 28 29 30 31 32

(in-package :gsl)

;;; #'heapsort has just a cursory port, use CL's #'sort.

;;;;****************************************************************************
;;;; Heapsort, not recommended
;;;;****************************************************************************

(defmacro defcomparison (name &body body)
  `(cffi:defcallback ,name :int ((a :pointer) (b :pointer))
    ,body))

liam's avatar
liam committed
33
(defmfun heapsort (array count size function)
34
  "gsl_heapsort"
35
  ((array :pointer) (count sizet) (size sizet) (function :pointer))
36
  :documentation			; FDL
37 38 39
  "Sort the count elements of the array of size specified
   into ascending order using the comparison
   function.  The type of the comparison function is defined by,
liam's avatar
liam committed
40
   A comparison function should return a negative integer if the first
41
   argument is less than the second argument, zero if the two arguments
liam's avatar
liam committed
42 43
   are equal and a positive integer if the first argument is greater than
   the second argument."
44
  :c-return :void)
liam's avatar
liam committed
45

liam's avatar
liam committed
46
(defmfun heapsort-index (p array count size function)
liam's avatar
liam committed
47
  "gsl_heapsort_index"
48
  ((p sizet) (array :pointer) (count sizet) (size sizet) (function :pointer))
49 50 51 52 53
  :documentation			; FDL
  "Indirectly sort the count elements of the array
   array, each of size given, into ascending order using the
   comparison function.  The resulting permutation is stored
   in p, an array of length n.  The elements of p give the
liam's avatar
liam committed
54
   index of the array element which would have been stored in that position
55 56 57 58
   if the array had been sorted in place.  The first element of p
   gives the index of the least element in array, and the last
   element of p gives the index of the greatest element in
   array.  The array itself is not changed.")
liam's avatar
liam committed
59 60

;;;;****************************************************************************
61
;;;; Sorting vectors
liam's avatar
liam committed
62 63
;;;;****************************************************************************

64 65
;;; The GSL vector sorting routines come in two forms, those that sort
;;; on GSL vectors (with "vector" in the name), and those that sort on
66 67 68 69 70
;;; C arrays.  The former can sort vectors, the latter can both
;;; vectors and matrices.  The functions #'sort-index,
;;; #'sort-smallest-index, #'sort-largest-index could be made to work
;;; on matrices, but the indexing would have to be worked out
;;; correctly.
liam's avatar
liam committed
71

72 73 74
;;; It ought to be possible to provide a stride argument, but this
;;; gives an error:
;;;(defmfun msort ((v vector) &optional (stride 1))
75

76
(defmfun msort ((v both))
77
  ("gsl_sort" :type)
78
  (((grid:foreign-pointer v) :pointer) (1 sizet) ((size v) sizet))
79 80 81
  :definition :generic
  :element-types :no-complex
  :c-return :void
82
  :inputs (v)
83 84 85 86 87 88 89 90 91 92 93
  :outputs (v)
  :documentation			; FDL
  "Sort the n elements of the array data with stride stride into
   ascending numerical order.")

(defmfun sort-vector ((v vector))
  ("gsl_sort_vector" :type)
  (((mpointer v) :pointer))
  :definition :generic
  :element-types :no-complex
  :c-return :void
94
  :inputs (v)
95 96 97 98
  :outputs (v)
  :documentation			; FDL
  "Sort the elements of the vector v into ascending numerical order.")

99
(defmfun sort-index ((permutation permutation) (vector vector))
100 101
  ("gsl_sort" :type "_index")
  (((mpointer permutation) :pointer)
102
   ((grid:foreign-pointer vector) :pointer)
103 104 105 106 107 108 109 110 111 112 113 114 115
   (1 sizet) ((dim0 vector) sizet))
  :definition :generic
  :element-types :no-complex
  :c-return :void
  :inputs (vector)
  :outputs (permutation)
  :documentation			; FDL
  "Indirectly sort the n elements of the array vector with stride stride
   into ascending order, storing the resulting permutation.  The latter
   must be created with the same size as the vector.
   The elements of permutation give the index of the
   array element which would have been stored in that position if the
   array had been sorted in place. The array data is not changed.")
liam's avatar
liam committed
116

117 118 119 120 121 122 123 124 125 126 127
(defmfun sort-vector-index ((permutation permutation) (vector vector))
  ("gsl_sort_vector" :type "_index")
  (((mpointer permutation) :pointer)
   ((mpointer vector) :pointer))
  :definition :generic
  :element-types :no-complex
  :c-return :void
  :inputs (vector)
  :outputs (permutation)
  :documentation			; FDL
  "Indirectly sort the elements of the vector v into
128 129 130 131 132
   ascending order, storing the resulting permutation in p.  The
   elements of p give the index of the vector element which would
   have been stored in that position if the vector had been sorted in
   place.  The first element of p gives the index of the least element
   in v and the last element of p gives the index of the
133 134 135 136 137 138 139 140
   greatest element in v.  The vector v is not changed.")

;;;;****************************************************************************
;;;; Selecting the k smallest or largest elements
;;;;****************************************************************************

(defmfun sort-vector-smallest (dest (v vector))
  ("gsl_sort_vector" :type "_smallest")
141
  (((grid:foreign-pointer dest) :pointer) ((dim0 dest) sizet)
142 143 144 145
   ((mpointer v) :pointer))
  :definition :generic
  :element-types :no-complex
  :c-return :void
146
  :inputs (v)
147 148 149 150 151
  :outputs (dest)
  :documentation			; FDL
  "Find the smallest elements of the vector v and put them into dest,
   which must be shorter than v.")

152
(defmfun sort-smallest (dest (v both))
153
  ("gsl_sort" :type "_smallest")
154 155
  (((grid:foreign-pointer dest) :pointer) ((size dest) sizet)
   ((grid:foreign-pointer v) :pointer)
156
   (1 sizet)				; stride, set to 1 for now
157
   ((size v) sizet))
158 159
  :definition :generic
  :element-types :no-complex
160
  :c-return :void
161
  :inputs (v)
162 163 164 165
  :outputs (dest)
  :documentation			; FDL
  "Find the smallest elements of the vector v and put them into dest,
   which must be shorter than v.")
166

167
(defmfun sort-vector-smallest-index (combination (v vector))
168
  ("gsl_sort_vector" :type "_smallest_index")
169
  (((grid:foreign-pointer combination) :pointer) ((size combination) sizet)
170 171
   ((mpointer v) :pointer)
   (1 sizet)				; stride, set to 1 for now
172
   ((first (grid:dimensions combination)) sizet))
173 174 175
  :definition :generic
  :element-types :no-complex
  :c-return :void
176 177
  :inputs (v)
  :outputs (combination)
178 179
  :documentation
  "The indices of the smallest elements of the vector stored,
180 181 182
    returned as a CL vector of element type fixnum.  If
    indices is a positive initeger, a vector will be
    allocated and returned.  If it is a CL vector,
183 184
    it will be filled with the indices.")

185
(defmfun sort-smallest-index (combination (v vector))
186
  ("gsl_sort" :type "_smallest_index")
187 188
  (((grid:foreign-pointer combination) :pointer) ((size combination) sizet)
   ((grid:foreign-pointer v) :pointer)
189
   (1 sizet)				; stride, set to 1 for now
190
   ((first (grid:dimensions combination)) sizet))
191 192 193
  :definition :generic
  :element-types :no-complex
  :c-return :void
194 195
  :inputs (v)
  :outputs (combination)
196 197 198 199 200 201 202 203 204
  :documentation
  "The indices of the smallest elements of the vector stored,
    returned as a CL vector of element type fixnum.  If
    indices is a positive initeger, a vector will be
    allocated and returned.  If it is a CL vector,
    it will be filled with the indices.")

(defmfun sort-vector-largest (dest (v vector))
  ("gsl_sort_vector" :type "_largest")
205
  (((grid:foreign-pointer dest) :pointer) ((dim0 dest) sizet)
206 207 208 209
   ((mpointer v) :pointer))
  :definition :generic
  :element-types :no-complex
  :c-return :void
210
  :inputs (v)
211 212 213 214 215
  :outputs (dest)
  :documentation			; FDL
  "Find the largest elements of the vector v and put them into dest,
   which must be shorter than v.")

216
(defmfun sort-largest (dest (v both))
217
  ("gsl_sort" :type "_largest")
218 219
  (((grid:foreign-pointer dest) :pointer) ((size dest) sizet)
   ((grid:foreign-pointer v) :pointer)
220
   (1 sizet)				; stride, set to 1 for now
221
   ((size v) sizet))
222 223
  :definition :generic
  :element-types :no-complex
224
  :c-return :void
225
  :inputs (v)
226 227 228 229 230
  :outputs (dest)
  :documentation			; FDL
  "Find the largest elements of the vector v and put them into dest,
   which must be shorter than v.")

231
(defmfun sort-vector-largest-index (combination (v vector))
232
  ("gsl_sort_vector" :type "_largest_index")
233
  (((grid:foreign-pointer combination) :pointer) ((size combination) sizet)
234 235
   ((mpointer v) :pointer)
   (1 sizet)				; stride, set to 1 for now
236
   ((first (grid:dimensions combination)) sizet))
237 238
  :definition :generic
  :element-types :no-complex
239
  :c-return :void
240 241
  :inputs (v)
  :outputs (combination)
242 243
  :documentation
  "The indices of the largest elements of the vector stored,
244 245 246
    returned as a CL vector of element type fixnum.  If
    indices is a positive initeger, a vector will be
    allocated and returned.  If it is a CL vector,
247
    it will be filled with the indices.")
248

249
(defmfun sort-largest-index (combination (v vector))
250
  ("gsl_sort" :type "_largest_index")
251 252
  (((grid:foreign-pointer combination) :pointer) ((size combination) sizet)
   ((grid:foreign-pointer v) :pointer)
253
   (1 sizet)				; stride, set to 1 for now
254
   ((first (grid:dimensions combination)) sizet))
255 256
  :element-types :no-complex
  :definition :generic
257
  :c-return :void
258 259
  :inputs (v)
  :outputs (combination)
260 261 262 263 264 265
  :documentation
  "The indices of the largest elements of the vector stored,
    returned as a CL vector of element type fixnum.  If
    indices is a positive initeger, a vector will be
    allocated and returned.  If it is a CL vector,
    it will be filled with the indices.")
liam's avatar
liam committed
266 267

;;;;****************************************************************************
268
;;;; Examples and unit test
liam's avatar
liam committed
269 270
;;;;****************************************************************************

271
(generate-all-array-tests sort-vector :no-complex
272
 (let ((v1 (array-default 8)))
273
   ;; or you can use msort
274
   (grid:copy-to (sort-vector v1))))
275 276

(generate-all-array-tests sort-matrix :no-complex
277
 (let ((m1 (array-default '(3 3))))
278
   (grid:copy-to (msort m1))))
279 280

(generate-all-array-tests sort-vector-index :no-complex
281
 (let ((perm (make-permutation 8))
282 283
	(v1 (array-default 8)))
   (sort-vector-index perm v1)
284
   (grid:copy-to perm)))
285 286

(generate-all-array-tests sort-vector-smallest :no-complex
287
 (let ((v1 (array-default 8))
288
	(v2 (array-default 3)))
289
   (grid:copy-to (sort-vector-smallest v2 v1))))
290 291

(generate-all-array-tests sort-matrix-smallest :no-complex
292
 (let ((m1 (array-default '(3 3)))
293
	(m2 (array-default '(2 3) t)))
294
   (grid:copy-to (sort-smallest m2 m1))))
295 296

(generate-all-array-tests sort-vector-smallest-index :no-complex
Liam Healy's avatar
Liam Healy committed
297
 (let ((comb (make-combination 8 3 nil))
298
	(v1 (array-default 8)))
299
   (grid:copy-to (sort-vector-smallest-index comb v1))))
300 301

(generate-all-array-tests sort-vector-largest :no-complex
302
 (let ((v1 (array-default 8))
303
	(v2 (array-default 3)))
304
   (grid:copy-to (sort-vector-largest v2 v1))))
305 306

(generate-all-array-tests sort-matrix-largest :no-complex
307
 (let ((m1 (array-default '(3 3)))
308
	(m2 (array-default '(2 3) t)))
309
   (grid:copy-to (sort-largest m2 m1))))
liam's avatar
liam committed
310

311
(generate-all-array-tests sort-vector-largest-index :no-complex
Liam Healy's avatar
Liam Healy committed
312
 (let ((comb (make-combination 8 3 nil))
313
	(v1 (array-default 8)))
314
   (grid:copy-to (sort-vector-largest-index comb v1))))