From 1b50a1c5e5c2c1ab70422b0a56c373b6d698f39c Mon Sep 17 00:00:00 2001
From: Mirko Vukovic <mirko.vukovic@gmail.com>
Date: Sun, 29 Nov 2015 08:42:08 -0500
Subject: [PATCH 6/6] Modified combination.lisp to use GSL's combination object
 exclusively

combination: Redefined class to contain a pointer to GSL's
	combination object.  The slots reader is MPOINTER.
initialize-instance: Create GSL's combination object either
	unitialized, or initialized in lexicographically first or last
	order.  Prepare finalizer.  Check if GSL was able to allocate
	memory.
make-combination: Cleaned up, made syntax more readable, and
	allowed for initializtion in lexicograhpically last order
print-object: Changed code to query GSL's object
grid:copy: Re-wrote documentation, cleaned up code (all this
	needs to be double-checked by Liam)
save-test combination: Slightly simplified code (eliminated
	calls to init-first, init-last) to use initializations provided by
	MAKE-COMBINATION
Also rearranged some code for better logical flow
---
 data/combination.lisp | 232 ++++++++++++++++++++++++++++++++------------------
 1 file changed, 148 insertions(+), 84 deletions(-)

diff --git a/data/combination.lisp b/data/combination.lisp
index 0215caf..883aa58 100644
--- a/data/combination.lisp
+++ b/data/combination.lisp
@@ -1,6 +1,6 @@
 ;; Combinations
 ;; Liam Healy, Sun Mar 26 2006 - 11:51
-;; Time-stamp: <2012-01-13 12:01:36EST combination.lisp>
+;; Time-stamp: <2015-11-29 08:28:11Eastern Standard Time combination.lisp>
 ;;
 ;; Copyright 2006, 2007, 2008, 2009, 2010, 2011 Liam M. Healy
 ;; Distributed under the terms of the GNU General Public License
@@ -26,95 +26,84 @@
 ;;;; Combination structure and CL object
 ;;;;****************************************************************************
 
-(defclass combination 
-    (#+int64 grid:vector-unsigned-byte-64 #+int32 grid:vector-unsigned-byte-32)
-  ()
+;;; Nomenclature and conventions:
+;;; GSL GSLL                Comment
+;;; ---------------------------------------------
+;;; n   range               Number elements (0...n-1) from which k are chosen
+;;; k   (first dimensions)  Array size, k<n
+
+;;; To compile the GSL combination example do:
+;;; > gcc -L/mingw64/bin -lgslcblas -lgsl-19 combination-example.c
+
+(defclass combination ()
+  ((pointer :reader mpointer
+	    :documentation "Pointer to GSL's combination object"))
   (:documentation "GSL combinations."))
 
 (defmethod initialize-instance :after
-    ((object combination) &key range dimensions &allow-other-keys)
-  (let ((mptr (cffi:foreign-alloc 'gsl-combination-c)))
-    (setf (grid:metadata-slot object 'mpointer)
-	  mptr
-	  (cffi:foreign-slot-value mptr 'gsl-combination-c 'data)
-	  (grid:foreign-pointer object)
-	  (cffi:foreign-slot-value mptr 'gsl-combination-c 'range)
-	  range
-	  (cffi:foreign-slot-value mptr 'gsl-combination-c 'size)
-	  (first dimensions))
-    (tg:finalize object (lambda () (cffi:foreign-free mptr)))))
+    ((object combination) &key range dimensions init &allow-other-keys)
+  "Initialize GSL's Combination object that contains an array of size
+K of integers in the range 0..N-1.
+
+RANGE - N
+DIMENSIONS - a list whose first element denotes K.
+INIT - Controls initialization:
+- T, initialize in lexicographically first combination (0, 1, 2,...,K-1)
+- :LAST, initialize in lexicographically last combination (N-K,N-K+1,...,N-1)
+- NIL, contents not initialized.  Accessing them returns a random integer"
+  (let* ((dim0 (first dimensions))
+	 (combination* 
+	  (cond
+	    ((or (null init) (equal init :last))
+	     (cffi:foreign-funcall "gsl_combination_alloc"
+				   :sizet range
+				   :sizet dim0
+				   :pointer))
+	    ((equal init t)
+	     (cffi:foreign-funcall "gsl_combination_calloc"
+				   :sizet range
+				   :sizet dim0
+				   :pointer)))))
+    (assert (not (cffi:null-pointer-p combination*)) ()
+	    "GSL failed to allocate memory for combination of size ~a, range ~a"
+	    dim0 range)
+    (when (equal init :last)
+      (cffi:foreign-funcall "gsl_combination_init_last" :pointer combination*
+			    :void))
+    (setf (slot-value object 'pointer) combination*)
+    (tg:finalize object (lambda () (foreign-funcall "gsl_combination_free"
+						    :pointer (mpointer object)
+						    :void)))
+    object))
 
 (export 'make-combination)
 
-(defun make-combination (n &optional k (initialize t))
-  "Make the object representing a combination of k things from a set of n.
-   If initialize is T, initialize as the first k values (init-first).
-   If n is a combination, make a new combination with the same
-   specification.  If initialize is also T, copy it."
-  (let ((comb
-	 (if (typep n 'combination)
-	     (make-instance
-	      'combination
-	      :element-type '(unsigned-byte #+int64 64 #+int32 32)
-	      :range (combination-range n) :dimensions (grid:dimensions k))
-	     (make-instance
-	      'combination
-	      :element-type '(unsigned-byte #+int64 64 #+int32 32)
-	      :range n :dimensions (list k)))))
-    (when initialize
-      (if (typep n 'combination)
-	  (error "not available yet")	; (copy comb n)
-	  (init-first comb)))
-    comb))
+(defun make-combination (range-or-combination &optional size (initialize t))
+  "Make the object representing a combination of k integers in the range 0...n-1
 
-(defmethod print-object ((object combination) stream)
-  (print-unreadable-object (object stream :type t)
-    (format stream "range ~d: " (combination-range object))
-    (princ (grid:contents object) stream)))
+RANGE-OR-COMBINATION: N or a combination object
+SIZE: Number of integers to combine
+INITIALIZE: nil, T, or :LAST
 
-;;;;****************************************************************************
-;;;; Setting values
-;;;;****************************************************************************
+If RANGE-OR-COMBINATION is a combination object, return a copy of it
+If it is an integer, create a new combination object.
 
-(defmfun init-first (combination)
-  "gsl_combination_init_first"
-  (((mpointer combination) :pointer))
-  :c-return :void
-  :outputs (combination)
-  :documentation			; FDL
-  "Initialize the combination c to the lexicographically
-      first combination, i.e.  (0,1,2,...,k-1).")
+INITIALIZE determines how the new combination object is initialized:
+NIL - not initialized
+T - initialized in lexicographic first order
+:LAST - initialized in lexicographic last order"
+  (if (typep range-or-combination 'combination)
+      (grid:copy range-or-combination)
+      (make-instance
+       'combination
+       :range range-or-combination :dimensions (list size)
+       :init initialize)))
 
-(defmfun init-last (combination)
-  "gsl_combination_init_last"
-  (((mpointer combination) :pointer))
-  :c-return :void
-  :outputs (combination)
-  :documentation			; FDL
-  "Initialize the combination c to the lexicographically
-   last combination, i.e. (n-k,n-k+1,...,n-1).")
-
-(defmfun comb-copy (source destination)
-  "gsl_combination_memcpy"
-  (((mpointer destination) :pointer)
-   ((mpointer source) :pointer))
-  :inputs (source)
-  :outputs (destination)
-  :return (destination)
-  :export nil
-  :index grid:copy
-  :documentation			; FDL
-  "Copy the elements of the combination source into the
-  combination destination.  The two combinations must have the same size.")
-
-(defmethod grid:copy
-    ((source combination) &key grid-type destination &allow-other-keys)
-  (if grid-type
-      (call-next-method)
-      (comb-copy
-       source
-       (or destination
-	   (make-combination (combination-range source) (size source))))))
+(defmethod print-object ((object combination) stream)
+  (print-unreadable-object (object stream :type t :identity t)
+    (format stream "size ~d: " (size object))
+    (format stream "range ~d: " (combination-range object))
+    #+skip(princ (grid:contents object) stream)))
 
 ;;;;****************************************************************************
 ;;;; Combination properties
@@ -157,6 +146,83 @@
    elements should lie in the range 0 to n-1, with each
    value occurring once at most and in increasing order.")
 
+
+
+(defmethod grid:aref ((combination combination) &rest indices)
+  (let ((i (first indices)))
+    (assert (< i (size combination)) ()
+	    "Index ~a out of bounds" i)
+    (cffi:foreign-funcall "gsl_combination_get" 
+			  :pointer (mpointer combination)
+			  :sizet i
+			  :sizet)))
+
+(defmethod grid:dimensions ((combination combination))
+  (list (size combination)))
+
+;;;;****************************************************************************
+;;;; Setting values
+;;;;****************************************************************************
+
+(defmfun init-first (combination)
+  "gsl_combination_init_first"
+  (((mpointer combination) :pointer))
+  :c-return :void
+  :outputs (combination)
+  :documentation			; FDL
+  "Initialize the combination c to the lexicographically
+      first combination, i.e.  (0,1,2,...,k-1).")
+
+(defmfun init-last (combination)
+  "gsl_combination_init_last"
+  (((mpointer combination) :pointer))
+  :c-return :void
+  :outputs (combination)
+  :documentation			; FDL
+  "Initialize the combination c to the lexicographically
+   last combination, i.e. (n-k,n-k+1,...,n-1).")
+
+(defmfun comb-copy (source destination)
+  "gsl_combination_memcpy"
+  (((mpointer destination) :pointer)
+   ((mpointer source) :pointer))
+  :inputs (source)
+  :outputs (destination)
+  :return (destination)
+  :export nil
+  :index grid:copy
+  :documentation			; FDL
+  "Copy the elements of the combination source into the
+  combination destination.  The two combinations must have the same size.")
+
+(defmethod grid:copy
+    ((source combination) 
+     &rest named-pairs
+     &key grid-type destination &allow-other-keys)
+  "Copy COMBINATION into a new combination object or into a grid (array,foreign-array)
+
+SOURCE: original combination
+GRID-TYPE: Destination type: NIL, ARRAY, FOREIGN-ARRAY:
+- NIL: copy source into a combination of the same size
+- ARRAY: copy combination into a CL array
+- GRID:FOREIGN-ARRAY: copy into a foreign array using DESTINATION specification
+DESTINATION: specify the foreign-array type
+
+Additional keywords are permitted"
+  (if grid-type
+      (let* ((contents (grid:contents source))
+	     (arr (make-array (size source) :initial-contents 
+			      contents)))
+	(apply #'grid:copy arr
+	       :grid-type grid-type
+	       :destination destination
+	       :allow-other-keys t
+	       named-pairs))
+      (comb-copy
+       source
+       (or destination
+	   (make-combination (combination-range source) (size source))))))
+
 ;;;;****************************************************************************
 ;;;; Combination functions
 ;;;;****************************************************************************
@@ -195,12 +261,10 @@
    (combination-range comb))
  (let ((comb (make-combination 4 2)))	; size
    (size comb))
- (let ((comb (make-combination 4 2)))	; init-first, combination-next
-   (init-first comb)
+ (let ((comb (make-combination 4 2 t)))	; init-first, combination-next
    (loop collect (grid:contents comb)
 	 while (combination-next comb)))
- (let ((comb (make-combination 4 2)))  ; init-last, combination-previous
-   (init-last comb)
+ (let ((comb (make-combination 4 2 :last)))  ; init-last, combination-previous
    (loop collect (grid:contents comb)
 	 while (combination-previous comb)))
  (loop for i from 0 to 4		; combination-next
-- 
2.6.3

