diff --git a/data/foreign-array.lisp b/data/foreign-array.lisp index b59ae3a48536421aa5f7e5a551df96d008a61e2a..d550a2c38c0de5057d95864facff48a6d99c4f57 100644 --- a/data/foreign-array.lisp +++ b/data/foreign-array.lisp @@ -1,6 +1,6 @@ ;; A grid:foreign-array with added metadata for GSL. ;; Liam Healy 2008-04-06 21:23:41EDT -;; Time-stamp: <2010-07-01 19:38:35EDT foreign-array.lisp> +;; Time-stamp: <2010-07-13 10:24:43EDT foreign-array.lisp> ;; ;; Copyright 2008, 2009, 2010 Liam M. Healy ;; Distributed under the terms of the GNU General Public License @@ -80,16 +80,16 @@ gsl-vector-c or gsl-matrix-c is given." (let* ((cstruct (case category - (:vector 'gsl-vector-c) - (:matrix 'gsl-matrix-c) + ((vector :vector 1) 'gsl-vector-c) + ((matrix :matrix 2) 'gsl-matrix-c) (t (error "Unrecognized category ~a" category)))) (fa (grid:make-grid (case category - (:vector + ((vector :vector 1) `((foreign-array ,(cffi:foreign-slot-value mpointer cstruct 'size)) ,element-type)) - (:matrix + ((matrix :matrix 2) `((foreign-array ,(cffi:foreign-slot-value mpointer cstruct 'size0) ,(cffi:foreign-slot-value mpointer cstruct 'size1)) diff --git a/init/funcallable.lisp b/init/funcallable.lisp index f997b45b5b9cc1a04ea11ae3cdf1b7e63e60a939..a4358d5a1d531bb47573cd4a96e3cefaf491cd8b 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-12 21:09:21EDT funcallable.lisp> +;; Time-stamp: <2010-07-13 10:37:28EDT funcallable.lisp> ;; ;; Copyright 2009, 2010 Liam M. Healy ;; Distributed under the terms of the GNU General Public License @@ -61,6 +61,21 @@ arg)) argspecs)) +(defun faify-form (ptr argspec) + "Make the form that turns the mpointer into a foreign-array." + (ecase (parse-callback-argspec argspec 'array-type) + (:foreign-array ; a GSL mpointer + `(make-foreign-array-from-mpointer + ,ptr + ',(grid:cffi-cl (parse-callback-argspec argspec 'element-type)) + ,(length (parse-callback-argspec argspec 'dimensions)))) + (:cvector ; a raw C vector + `(grid:make-foreign-array-from-pointer + ,ptr + ',(parse-callback-argspec argspec 'dimensions) + ',(grid:cffi-cl (parse-callback-argspec argspec 'element-type)) + t)))) + ;;;;**************************************************************************** ;;;; Reference foreign elements and make multiple-value-bind form ;;;;**************************************************************************** @@ -168,9 +183,10 @@ call-form)) `(funcall ,function-designator ,@(if outarrayp - (append inargs-names outargs-names) + (append (mapcar 'faify-form inargs-names inargs-specs) + (mapcar 'faify-form outargs-names outarrayp)) ;; no arrays to return, just return the value - inargs-names))) + (mapcar 'faify-form inargs-names inargs-specs)))) ,@(case (parse-callback-fnspec fnspec 'return-spec) (:success-failure diff --git a/solve-minimize-fit/minimization-multi.lisp b/solve-minimize-fit/minimization-multi.lisp index 60f0dfe4c1aec060457dcc5bc382d7137ed3deb8..38bdb3e3b059be0d7d86e6ef7fe2af4454c9a784 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-07-12 21:28:04EDT minimization-multi.lisp> +;; Time-stamp: <2010-07-13 10:33:06EDT minimization-multi.lisp> ;; ;; Copyright 2008, 2009 Liam M. Healy ;; Distributed under the terms of the GNU General Public License @@ -397,42 +397,47 @@ ;;; vector-double-float. They could as well have been written to ;;; accept the correct number of scalar double-floats. -(defun paraboloid-vector (mpointer) +(defun paraboloid-vector (xy) "A paraboloid function of two arguments, given in GSL manual Sec. 35.4. This version takes a vector-double-float argument." ;; 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)) + (let ((x (grid:gref xy 0)) + (y (grid:gref xy 1)) (dp0 (aref *paraboloid-center* 0)) (dp1 (aref *paraboloid-center* 1))) (+ (* 10 (expt (- x dp0) 2)) (* 20 (expt (- y dp1) 2)) 30))) -(defun paraboloid-derivative - (arguments-gv-pointer derivative-gv-pointer) - (let ((x (get-value 'grid:vector-double-float arguments-gv-pointer 0)) - (y (get-value 'grid:vector-double-float arguments-gv-pointer 1)) +(defun paraboloid-derivative (xy output) + (let ((x (grid:gref xy 0)) + (y (grid:gref xy 1)) (dp0 (aref *paraboloid-center* 0)) (dp1 (aref *paraboloid-center* 1))) - (setf (get-value 'grid:vector-double-float derivative-gv-pointer 0) + (setf (grid:gref output 0) (* 20 (- x dp0)) - (get-value 'grid:vector-double-float derivative-gv-pointer 1) + (grid:gref output 1) (* 40 (- y dp1))))) (defun paraboloid-and-derivative (arguments-gv-pointer value-pointer derivative-gv-pointer) + (lu:print-variables arguments-gv-pointer value-pointer derivative-gv-pointer) (prog1 - (setf (grid:dcref value-pointer) + (setf (grid:gref value-pointer 0) (paraboloid-vector arguments-gv-pointer)) (paraboloid-derivative arguments-gv-pointer derivative-gv-pointer))) (defun multimin-example-derivative (&optional (method +conjugate-fletcher-reeves+) (print-steps t)) + "This is an example solving the multidimensional minimization problem + of a paraboloid using the derivative. The callback functions + paraboloid-vector and paraboloid-derivative expect vectors. + Contrast this with multimin-example-derivative-scalars, which + expects and returns the scalar components." (let* ((initial #m(5.0d0 7.0d0)) (minimizer (make-multi-dimensional-minimizer-fdf @@ -472,6 +477,11 @@ (defun multimin-example-derivative-scalars (&optional (method +conjugate-fletcher-reeves+) (print-steps t)) + "This is an example solving the multidimensional minimization problem + of a paraboloid using the derivative. The callback functions + paraboloid-scalar and paraboloid-derivative-scalar expect scalars. + Contrast this with multimin-example-derivative, which + expects and returns vectors." (let* ((initial #m(5.0d0 7.0d0)) (minimizer (make-multi-dimensional-minimizer-fdf @@ -497,8 +507,6 @@ (let ((x (solution minimizer))) (values (grid:gref x 0) (grid:gref x 1) (function-value minimizer))))))) - - (save-test minimization-multi (multimin-example-no-derivative +simplex-nelder-mead-on2+ nil) (multimin-example-derivative +conjugate-fletcher-reeves+ nil) diff --git a/solve-minimize-fit/roots-multi.lisp b/solve-minimize-fit/roots-multi.lisp index 62ad91880a96329f07d8de1673cb874291d6dd73..25b70dab625a91c9c2e56ad29cf1781cf7450412 100644 --- a/solve-minimize-fit/roots-multi.lisp +++ b/solve-minimize-fit/roots-multi.lisp @@ -1,6 +1,6 @@ ;;; Multivariate roots. ;;; Liam Healy 2008-01-12 12:49:08 -;;; Time-stamp: <2010-06-30 19:57:28EDT roots-multi.lisp> +;;; Time-stamp: <2010-07-13 09:52:54EDT roots-multi.lisp> ;; ;; Copyright 2008, 2009 Liam M. Healy ;; Distributed under the terms of the GNU General Public License @@ -376,6 +376,13 @@ ;;;; Examples ;;;;**************************************************************************** +;;; This is the example given in GSL manual, Sec. 35.8. +;;; http://www.gnu.org/software/gsl/manual/html_node/Example-programs-for-Multidimensional-Root-finding.html + +;;; These examples use use scalarsp=T in the +;;; multi-dimensional-root-solver argument. To see how vectors would +;;; be used, see minimization-multi. + (defparameter *powell-A* 1.0d4) (defun powell (arg0 arg1) "Powell's test function." @@ -384,8 +391,6 @@ (+ (exp (- arg0)) (exp (- arg1)) (- (1+ (/ *powell-A*)))))) ;; not used? -;;; This is the example given in Sec. 34.8. - (defparameter *rosenbrock-a* 1.0d0) (defparameter *rosenbrock-b* 10.0d0)