Commit 26e3b36e authored by Liam Healy's avatar Liam Healy

Dynamic callbacks for nonlinear-least-squares

Dynamic callbacks now operational for nonlinear-least-squares, test
passes.  Callback struct slot name(s) and value(s) now properly set in
pure function calls, even though this only affects Monte Carlo, which
doesn't care whether the dimension is set or not.  The first optional
argument to the mobject maker generated by #'mobject-maker can now
have a default value, and the settingp will be added correctly.
parent cd435bbf
;; Monte Carlo Integration
;; Liam Healy Sat Feb 3 2007 - 17:42
;; Time-stamp: <2009-03-21 23:48:35EDT monte-carlo.lisp>
;; Time-stamp: <2009-03-22 00:18:55EDT monte-carlo.lisp>
;; $Id$
(in-package :gsl)
......@@ -48,7 +48,7 @@
(result :double) (abserr :double))
:inputs (lower-limits upper-limits)
:callbacks
(callback monte-function dimensions (function :double (:double :cvector dim0)))
(callback monte-function (dimensions) (function :double (:double :cvector dim0)))
:callback-dynamic ((function scalars (dim0 lower-limits)))
:documentation ; FDL
"Uses the plain Monte Carlo algorithm to integrate the
......@@ -127,7 +127,7 @@
(result :double) (abserr :double))
:inputs (lower-limits upper-limits)
:callbacks
(callback monte-function dimensions (function :double (:double :cvector dim0)))
(callback monte-function (dimensions) (function :double (:double :cvector dim0)))
:callback-dynamic ((function scalars (dim0 lower-limits)))
:documentation ; FDL
"Uses the miser Monte Carlo algorithm to integrate the
......@@ -216,7 +216,7 @@
(result :double) (abserr :double))
:inputs (lower-limits upper-limits)
:callbacks
(callback monte-function dimensions (function :double (:double :cvector dim0)))
(callback monte-function (dimensions) (function :double (:double :cvector dim0)))
:callback-dynamic ((function scalars (dim0 lower-limits)))
:documentation ; FDL
"Uses the vegas Monte Carlo algorithm to integrate the
......
;; Definition of GSLL system
;; Liam Healy
;; Time-stamp: <2009-03-21 18:10:15EDT gsll.asd>
;; Time-stamp: <2009-03-22 16:58:26EDT gsll.asd>
;; $Id$
(asdf:defsystem "gsll"
......@@ -207,6 +207,5 @@
(:file "roots-multi" :depends-on (roots-one generic))
(:file "minimization-multi" :depends-on (generic))
(:file "linear-least-squares")
;;(:file "nonlinear-least-squares" :depends-on (generic))
))
(:file "nonlinear-least-squares" :depends-on (generic))))
(:file "basis-splines" :depends-on (init data random))))
;; Foreign callback functions.
;; Liam Healy
;; Time-stamp: <2009-03-21 23:43:36EDT callback.lisp>
;; Time-stamp: <2009-03-22 15:40:17EDT callback.lisp>
;; $Id$
(in-package :gsl)
......@@ -205,15 +205,17 @@
for list in (callback-dynamic-lister callbacks)
append (list symb list))))))
(defun callback-set-slots (callbacks symbols)
(defun callback-set-slots (callbacks dynamic-variables)
(when callbacks
`((set-cbstruct
,(parse-callback-static callbacks 'foreign-argument)
',(parse-callback-static callbacks 'callback-structure-type)
nil ; will have dimensions
(mapcan 'list
',(parse-callback-static callbacks 'dimension-names)
(cddr ,(caar dynamic-variables)))
,(cons
'list
(loop for symb in symbols
(loop for symb in (second dynamic-variables)
for fn in (parse-callback-static callbacks 'functions)
append
`(',(parse-callback-fnspec fn 'structure-slot-name)
......
;; Helpers that define a single GSL function interface
;; Liam Healy 2009-01-07 22:02:20EST defmfun-single.lisp
;; Time-stamp: <2009-03-21 16:44:34EDT defmfun-single.lisp>
;; Time-stamp: <2009-03-22 15:40:17EDT defmfun-single.lisp>
;; $Id: $
(in-package :gsl)
......@@ -188,7 +188,7 @@
callback-dynamic (first callback-dynamic-variables))
(when callback-object (callback-set-dynamic callback-object arglist))
before)
,@(callback-set-slots callbacks (second callback-dynamic-variables))
,@(callback-set-slots callbacks callback-dynamic-variables)
(let ((,cret-name
(cffi:foreign-funcall
,gsl-name
......
;; Definition of GSL objects and ways to use them.
;; Liam Healy, Sun Dec 3 2006 - 10:21
;; Time-stamp: <2009-03-22 00:02:39EDT mobject.lisp>
;; Time-stamp: <2009-03-22 19:52:53EDT mobject.lisp>
;;; GSL objects are represented in GSLL as and instance of a 'mobject.
;;; The macro demobject takes care of defining the appropriate
......@@ -194,7 +194,10 @@
,@(when initargs
(append
(list
'&optional (list (first initargs) nil settingp))
'&optional
(if (listp (first initargs))
`(,@(first initargs) ,settingp)
`(,(first initargs) nil ,settingp)))
(rest initargs))))))
,(format
nil "Create the GSL object representing a ~a (class ~a).~@[~&~a~]"
......
;; Nonlinear least squares fitting.
;; Liam Healy, 2008-02-09 12:59:16EST nonlinear-least-squares.lisp
;; Time-stamp: <2009-03-21 23:56:35EDT nonlinear-least-squares.lisp>
;; Time-stamp: <2009-03-22 16:09:53EDT nonlinear-least-squares.lisp>
;; $Id$
(in-package :gsl)
......@@ -74,8 +74,11 @@
(number-of-observations number-of-parameters)
(function :success-failure
(:double :marray dim1) (:double :marray dim0))
(df ???????????)
(fdf ????????????))
(df :success-failure
(:double :marray dim1) (:double :marray dim0 dim1))
(fdf :success-failure
(:double :marray dim1)
(:double :marray dim0) (:double :marray dim0 dim1)))
:initialize-suffix "set"
:initialize-args ((callback :pointer) ((mpointer initial-guess) :pointer)))
......@@ -101,6 +104,7 @@
(number-of-parameters sizet)
(parameters :pointer))
#|
(def-make-callbacks nonlinear-fdffit
(function df fdf &optional number-of-observations number-of-parameters)
(if number-of-observations
......@@ -128,6 +132,7 @@
(defmcallback ,df :success-failure :pointer :pointer nil ,df)
(defmcallback
,fdf :success-failure :pointer (:pointer :pointer) nil ,fdf))))
|#
(defmfun name ((solver nonlinear-fdffit))
"gsl_multifit_fdfsolver_name"
......@@ -382,10 +387,12 @@
(exponential-residual x f)
(exponential-residual-derivative x jacobian))
#|
(make-callbacks
nonlinear-fdffit
exponential-residual exponential-residual-derivative
exponential-residual-fdf)
|#
(defun norm-f (fit)
"Find the norm of the fit function f."
......@@ -407,7 +414,7 @@
(list number-of-observations number-of-parameters)
'(exponential-residual
exponential-residual-derivative exponential-residual-fdf)
init)))
init nil)))
(macrolet ((fitx (i) `(maref (solution fit) ,i))
(err (i) `(sqrt (maref covariance ,i ,i))))
(when print-steps
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment