diff --git a/init/funcallable.lisp b/init/funcallable.lisp index a99813caf239aa2d8013b9aa203c4437cc1a9a46..f997b45b5b9cc1a04ea11ae3cdf1b7e63e60a939 100644 --- a/init/funcallable.lisp +++ b/init/funcallable.lisp @@ -1,6 +1,6 @@ ;; Generate a lambda that calls the user function; will be called by callback. ;; Liam Healy -;; Time-stamp: <2010-07-11 18:12:29EDT funcallable.lisp> +;; Time-stamp: <2010-07-12 21:09:21EDT funcallable.lisp> ;; ;; Copyright 2009, 2010 Liam M. Healy ;; Distributed under the terms of the GNU General Public License @@ -65,39 +65,18 @@ ;;;; Reference foreign elements and make multiple-value-bind form ;;;;**************************************************************************** -(defun gref-mpointer-form - (mpointer index &optional value (category 'vector) (element-type 'double-float)) - "Create the call that will return an element from a GSL array mpointer, - or set it to value if value is non-NIL." - (ffexpand - nil - (actual-gsl-function-name - `("gsl_" :category :type ,(if value "_set" "_get")) - category element-type) - (if value - `(:pointer ,mpointer sizet ,index ,element-type ,value :void) - `(:pointer ,mpointer sizet ,index ,element-type)))) - (defun reference-foreign-element (foreign-variable-name linear-index argspec dimension-values) "Form to reference, for getting or setting, the element of a foreign array, or a scalar." (if (parse-callback-argspec argspec 'dimensions) (if (eql (parse-callback-argspec argspec 'array-type) :foreign-array) - (if (= (length (value-from-dimensions argspec dimension-values)) 2) ; matrix - (error "Not ready for matrices yet!") - #+(or) - (gref-mpointer-form - foreign-variable-name - (multiple-value-list - (floor linear-index - (first dims))) - 'matrix - (parse-callback-argspec argspec 'element-type)) - ;; A vector - (gref-mpointer-form - foreign-variable-name linear-index nil 'vector - (parse-callback-argspec argspec 'element-type))) + `(get-value + ',(grid:data-class-name + (length (value-from-dimensions argspec dimension-values)) + (grid:cffi-cl (parse-callback-argspec argspec 'element-type))) + ,foreign-variable-name + ,linear-index) `(cffi:mem-aref ,foreign-variable-name ',(parse-callback-argspec argspec 'element-type) diff --git a/solve-minimize-fit/minimization-multi.lisp b/solve-minimize-fit/minimization-multi.lisp index 1f8e09705f5b5bb4d35367ee1928fac833b2579b..60f0dfe4c1aec060457dcc5bc382d7137ed3deb8 100644 --- a/solve-minimize-fit/minimization-multi.lisp +++ b/solve-minimize-fit/minimization-multi.lisp @@ -1,6 +1,6 @@ ;; Multivariate minimization. ;; Liam Healy <Tue Jan 8 2008 - 21:28> -;; Time-stamp: <2010-06-30 19:57:28EDT minimization-multi.lisp> +;; Time-stamp: <2010-07-12 21:28:04EDT minimization-multi.lisp> ;; ;; Copyright 2008, 2009 Liam M. Healy ;; Distributed under the terms of the GNU General Public License @@ -393,15 +393,19 @@ (values (grid:gref x 0) (grid:gref x 1) (function-value minimizer)))))))) ;;; Example using derivatives, taking a vector argument. -;;; Note that these functions are written to read objects of +;;; Note that these functions are written to read mpointers to ;;; vector-double-float. They could as well have been written to ;;; accept the correct number of scalar double-floats. -(defun paraboloid-vector (gsl-vector) +(defun paraboloid-vector (mpointer) "A paraboloid function of two arguments, given in GSL manual Sec. 35.4. This version takes a vector-double-float argument." - (let ((x (grid:gref gsl-vector 0)) - (y (grid:gref gsl-vector 1)) + ;; An alternative access to the passed-in vector would be to + ;; bind a variable to + ;; (make-foreign-array-from-mpointer mpointer 'double-float :vector) + ;; and then call grid:gref on it. + (let ((x (get-value 'grid:vector-double-float mpointer 0)) + (y (get-value 'grid:vector-double-float mpointer 1)) (dp0 (aref *paraboloid-center* 0)) (dp1 (aref *paraboloid-center* 1))) (+ (* 10 (expt (- x dp0) 2)) @@ -410,13 +414,13 @@ (defun paraboloid-derivative (arguments-gv-pointer derivative-gv-pointer) - (let ((x (grid:gref arguments-gv-pointer 0)) - (y (grid:gref arguments-gv-pointer 1)) + (let ((x (get-value 'grid:vector-double-float arguments-gv-pointer 0)) + (y (get-value 'grid:vector-double-float arguments-gv-pointer 1)) (dp0 (aref *paraboloid-center* 0)) (dp1 (aref *paraboloid-center* 1))) - (setf (grid:gref derivative-gv-pointer 0) + (setf (get-value 'grid:vector-double-float derivative-gv-pointer 0) (* 20 (- x dp0)) - (grid:gref derivative-gv-pointer 1) + (get-value 'grid:vector-double-float derivative-gv-pointer 1) (* 40 (- y dp1))))) (defun paraboloid-and-derivative