combination.lisp 5.83 KB
Newer Older
1
2
3
4
;; Combinations
;; Liam Healy, Sun Mar 26 2006 - 11:51
;; Time-stamp: <2008-02-04 19:25:57EST combination.lisp>
;; $Id: $
5
6
7
8

(in-package :gsl)

;;;;****************************************************************************
9
;;;; Combination structure and CL object
10
11
12
13
14
15
16
17
18
;;;;****************************************************************************

;;; GSL-combination definition
(cffi:defcstruct gsl-combination-c
  (n :size)
  (k :size)
  (data :pointer))

;;; Allocation, freeing, reading and writing
19
(defdata "combination" combination unsigned-byte gsl-data 2)
20

21
22
23
(defmethod gsl-array ((object gsl-combination))
  (foreign-slot-value (pointer object) 'gsl-combination-c 'data))

24
25
26
27
;;;;****************************************************************************
;;;; Getting values
;;;;****************************************************************************

28
(defun-gsl gsl-aref ((combination gsl-combination) &rest indices)
29
  "gsl_combination_get"
30
31
32
  (((pointer combination) :pointer) ((first indices) :size))
  :type :method 
  :c-return :size
33
34
  :documentation			; FDL
  "The ith element of the combination.")
35
36
37
38
39
40
41
42
43
44
45
46
47

(defmethod data ((object gsl-combination) &optional sequence)
  (let ((seq (or sequence
		 (make-sequence 'list (combination-size object)))))
    (loop for i from 0
	  below (min (length seq) (combination-size object))
	  do (setf (elt seq i) (gsl-aref object i)))
    seq))

;;;;****************************************************************************
;;;; Setting values
;;;;****************************************************************************

48
(defun-gsl init-first (combination)
49
  "gsl_combination_init_first"
50
51
52
  (((pointer combination) gsl-combination-c))
  :c-return :void
  :invalidate (combination)
53
54
55
  :documentation			; FDL
  "Initialize the combination c to the lexicographically
      first combination, i.e.  (0,1,2,...,k-1).")
56

57
(defun-gsl init-last (combination)
58
  "gsl_combination_init_last"
59
60
61
  (((pointer combination) gsl-combination-c))
  :c-return :void
  :invalidate (combination)
62
63
64
  :documentation			; FDL
  "Initialize the combination c to the lexicographically
   last combination, i.e. (n-k,n-k+1,...,n-1).")
65

66
(defun-gsl copy (destination source)
67
  "gsl_combination_memcpy"
68
69
70
71
  (((pointer destination) gsl-combination-c)
   ((pointer source) gsl-combination-c))
  :type :method
  :invalidate (destination)
72
73
74
  :documentation			; FDL
  "Copy the elements of the combination source into the
  combination destination.  The two combinations must have the same size.")
75
76
77
78
79

;;;;****************************************************************************
;;;; Combination properties
;;;;****************************************************************************

80
(defun-gsl combination-range (c)
81
  "gsl_combination_n"
82
83
  (((pointer c) gsl-combination-c))
  :c-return :size
84
85
  :documentation			; FDL
  "The range (n) of the combination c.")
86

87
(defun-gsl combination-size (c)
88
  "gsl_combination_k"
89
90
  (((pointer c) gsl-combination-c))
  :c-return :size
91
92
  :documentation			; FDL
  "The number of elements (k) in the combination c.")
93

94
95
96
#|
;;; Unnecessary, gsl-array serves this function.
(defun-gsl combination-data (c)
97
  "gsl_combination_data"
98
99
  (((pointer c) gsl-combination-c))
  :c-return :pointer
100
101
  :documentation			; FDL
  "A pointer to the array of elements in the combination.")
102
|#
103

104
(defun-gsl data-valid ((combination gsl-combination))
105
  "gsl_combination_valid"
106
107
108
  (((pointer combination) :pointer))
  :type :method 
  :c-return :boolean
109
110
111
  :documentation			; FDL
  "Check that the combination is valid.  The k
   elements should lie in the range 0 to n-1, with each
112
113
114
115
116
117
   value occurring once at most and in increasing order.")

;;;;****************************************************************************
;;;; Combination functions
;;;;****************************************************************************

118
119
120
121
(defun-gsl combination-next (c)
  "gsl_combination_next" (((pointer c) gsl-combination-c))
  :c-return :success-failure
  :invalidate (c)
122
123
  :documentation			; FDL
  "Advance the combination c to the next combination
124
125
   in lexicographic order and return T and c.  If no further
   combinations are available it return NIL and c with
126
   c unmodified.  Starting with the first combination and
127
128
129
   repeatedly applying this function will iterate through all possible
   combinations of a given order.")

130
(defun-gsl combination-previous (c)
131
  "gsl_combination_prev"
132
133
134
  (((pointer c) gsl-combination-c))
  :c-return :success-failure
  :invalidate (c)
135
136
  :documentation			; FDL
  "Step backwards from the combination c to the
137
   previous combination in lexicographic order, returning
138
   T and c.  If no previous combination is available it returns
139
   NIL and c with c unmodified.")
140
141

;;;;****************************************************************************
142
;;;; Examples and unit test
143
144
;;;;****************************************************************************

145
146
147
(lisp-unit:define-test combination
  (lisp-unit:assert-eql			; combination-range
   4
148
149
   (letm ((comb (combination 4 2 t)))
     (combination-range comb)))
150
151
  (lisp-unit:assert-eql			; combination-size
   2
152
153
   (letm ((comb (combination 4 2 t)))
     (combination-size comb)))
154
155
  (lisp-unit:assert-equal		; init-first, combination-next
   '((0 1) (0 2) (0 3) (1 2) (1 3) (2 3))
156
157
158
159
160
   (letm ((comb (combination 4 2 t)))
     (init-first comb)
     (loop collect (data comb)
	   while (combination-next comb))))
  (lisp-unit:assert-equal	     ; init-last, combination-previous
161
   '((2 3) (1 3) (1 2) (0 3) (0 2) (0 1))
162
163
164
165
166
   (letm ((comb (combination 4 2 t)))
     (init-last comb)
     (loop collect (data comb)
	   while (combination-previous comb))))
  (lisp-unit:assert-equal		; combination-next
167
   '(NIL (0) (1) (2) (3) (0 1) (0 2) (0 3) (1 2) (1 3) (2 3)
168
     (0 1 2) (0 1 3) (0 2 3) (1 2 3) (0 1 2 3))
169
170
   (loop for i from 0 to 4
	 append
171
172
	 (letm ((comb (combination 4 i t)))
	   (init-first comb)
173
	   (loop collect (data comb)
174
		 while (combination-next comb))))))