Commit 19dbbe90 authored by Liam Healy's avatar Liam Healy

Build 'one-dimensional-root-solver-f on 'callbacks-included

Now define one-dimensional-root-solver-f on 'callbacks-included.  This
needs some modification to mobject to add the 'functions slot argument
and remove 'dimensions from the cbstruct when it is not in the
allocation arguments.  The :functions argument must be given as a
list, even though there's only one function.  The example
(roots-one-example-no-derivative) works.
parent 866e84bd
;; Definition of GSL objects and ways to use them.
;; Liam Healy, Sun Dec 3 2006 - 10:21
;; Time-stamp: <2009-02-07 14:34:59EST mobject.lisp>
;; Time-stamp: <2009-02-07 21:37:24EST mobject.lisp>
;;; GSL objects are represented in GSLL as and instance of a 'mobject.
;;; The macro demobject takes care of defining the appropriate
......@@ -40,7 +40,7 @@
(maker (intern (format nil "MAKE-~:@(~a~)" class) :gsl))
(cl-alloc-args (variables-used-in-c-arguments allocation-args))
(cl-initialize-args
(remove +callback-argument-name+
(subst 'functions +callback-argument-name+
(variables-used-in-c-arguments initialize-args)))
(initializerp (or initialize-name initialize-suffix))
(initargs ; arguments that are exclusively for reinitialize-instance
......@@ -70,7 +70,7 @@
(make-reinitialize-instance
class cl-initialize-args initialize-name prefix
initialize-suffix initialize-args inputs
callbackp))
callbackp (member 'dimensions cl-alloc-args)))
(export ',maker)
,(mobject-maker
maker arglists initargs class cl-alloc-args cl-initialize-args
......@@ -103,7 +103,7 @@
(defun make-reinitialize-instance
(class cl-initialize-args initialize-name prefix
initialize-suffix initialize-args inputs
callback)
callback dimensionsp)
"Expand the reinitialize-instance form. In the GSL arglist, the callback
structure pointer should be named the value of +callback-argument-name+."
(let ((cbstruct (make-symbol "CBSTRUCT")))
......@@ -117,7 +117,8 @@
(,cbstruct
(apply
'make-cbstruct
(cbstruct-name object) `(dimensions ,@(dimensions object))
(cbstruct-name object)
,(when dimensionsp '`(dimensions ,@(dimensions object)))
(mapcan 'list (callback-labels object) (functions object)))))))
,(or initialize-name
(format nil "~a_~a" prefix
......
;; One-dimensional root solver.
;; Liam Healy
;; Time-stamp: <2009-01-26 21:44:26EST roots-one.lisp>
;; Time-stamp: <2009-02-07 21:36:44EST roots-one.lisp>
;; $Id$
(in-package :gsl)
......@@ -14,8 +14,22 @@
(defmobject one-dimensional-root-solver-f "gsl_root_fsolver"
((type :pointer))
"one-dimensional root solver with function only"
:superclasses (callback-included)
:ci-class-slots (gsl-function nil (function))
:initialize-suffix "set"
:initialize-args ((function :pointer) (lower :double) (upper :double)))
:initialize-args ((callback :pointer) (lower :double) (upper :double)))
(eval-when (:compile-toplevel :load-toplevel)
(defmethod make-callbacks-fn
((class (eql 'one-dimensional-root-solver-f)) args)
;; This is "make-single-function"
(declare (ignore class))
(destructuring-bind (function) args
`(defmcallback ,function
:double :double
nil
t
,function))))
(defmobject one-dimensional-root-solver-fdf "gsl_root_fdfsolver"
((type :pointer))
......@@ -280,6 +294,8 @@
(values (+ (* (+ (* a x) b) x) c)
(+ (* 2 a x) b))))
(make-callbacks one-dimensional-root-solver-f quadratic)
#+callback-toplevel-only
(defparameter *roots-one-noderiv-cb*
(make-single-function quadratic))
......@@ -289,11 +305,7 @@
"Solving a quadratic, the example given in Sec. 32.10 of the GSL manual."
(let ((max-iter 50)
(solver
(make-one-dimensional-root-solver-f
method
#-callback-toplevel-only (make-single-function quadratic)
#+callback-toplevel-only *roots-one-noderiv-cb*
0.0d0 5.0d0)))
(make-one-dimensional-root-solver-f method '(quadratic) 0.0d0 5.0d0)))
(when print-steps
(format t "iter ~6t [lower ~24tupper] ~36troot ~44terr ~54terr(est)~&"))
(loop for iter from 0
......
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