Commit e236d8d7 authored by Liam Healy's avatar Liam Healy

Make 'single-function "class" for (def-)make-callbacks

Many callback users need just a single function taking and returning
scalars.  These are all defined the same way.  So I have defined in
callbacks.lisp a def-make-callbacks for 'single-function.  This works
for chebyshev, minimization-one, and roots-one, and it should be
applicable to callbacks sent directly to functions without being
stored in mobjects.
parent 84b5a165
;; Chebyshev Approximations
;; Liam Healy Sat Nov 17 2007 - 20:36
;; Time-stamp: <2009-02-15 10:44:23EST chebyshev.lisp>
;; Time-stamp: <2009-02-15 11:23:40EST chebyshev.lisp>
;; $Id$
(in-package :gsl)
......@@ -23,13 +23,6 @@
((callback :pointer) (lower-limit :double) (upper-limit :double))
:singular (function))
(def-make-callbacks chebyshev (function)
`(defmcallback ,function
:double :double
nil
t
,function))
;;;;****************************************************************************
;;;; Chebyshev series evaluation
;;;;****************************************************************************
......@@ -90,7 +83,7 @@
(defun chebyshev-step (x) (if (< x 0.5d0) 0.25d0 0.75d0))
(make-callbacks chebyshev chebyshev-step)
(make-callbacks single-function chebyshev-step)
(defun chebyshev-table-example ()
(let ((steps 100))
......
;; Foreign callback functions.
;; Liam Healy
;; Time-stamp: <2009-02-15 10:43:05EST callback.lisp>
;; Time-stamp: <2009-02-15 11:23:42EST callback.lisp>
;; $Id$
(in-package :gsl)
......@@ -360,6 +360,13 @@
(destructuring-bind ,arglist ,args
,@body)))))
(def-make-callbacks single-function (function)
`(defmcallback ,function
:double :double
nil
t
,function))
(export 'make-callbacks)
(defmacro make-callbacks (class &rest args)
"Make the callbacks for the named class. The args are generally of the form
......
;; Univariate minimization
;; Liam Healy Tue Jan 8 2008 - 21:02
;; Time-stamp: <2009-02-15 10:14:09EST minimization-one.lisp>
;; Time-stamp: <2009-02-15 11:23:41EST minimization-one.lisp>
;; $Id$
(in-package :gsl)
......@@ -27,13 +27,6 @@
((callback :pointer) (minimum :double) (lower :double) (upper :double))
:singular (function))
(def-make-callbacks one-dimensional-minimizer (function)
`(defmcallback ,function
:double :double
nil
t
,function))
(defmfun set-fminimizer-with-values
(minimizer function x-minimum x-lower x-upper
f-minimum f-lower f-upper)
......@@ -190,7 +183,7 @@
(defun minimization-one-fn (x)
(1+ (cos x)))
(make-callbacks one-dimensional-minimizer minimization-one-fn)
(make-callbacks single-function minimization-one-fn)
(defun minimization-one-example
(&optional (minimizer-type *brent-fminimizer*) (print-steps t))
......
;; One-dimensional root solver.
;; Liam Healy
;; Time-stamp: <2009-02-10 21:53:03EST roots-one.lisp>
;; Time-stamp: <2009-02-15 11:27:34EST roots-one.lisp>
;; $Id$
(in-package :gsl)
......@@ -20,13 +20,6 @@
:initialize-args ((callback :pointer) (lower :double) (upper :double))
:singular (function))
(def-make-callbacks one-dimensional-root-solver-f (function)
`(defmcallback ,function
:double :double
nil
t
,function))
(defmobject one-dimensional-root-solver-fdf "gsl_root_fdfsolver"
((type :pointer))
"one-dimensional root solver with function and derivative"
......@@ -309,7 +302,7 @@
(values (+ (* (+ (* a x) b) x) c)
(+ (* 2 a x) b))))
(make-callbacks one-dimensional-root-solver-f quadratic)
(make-callbacks single-function quadratic)
(make-callbacks one-dimensional-root-solver-fdf
quadratic quadratic-derivative quadratic-and-derivative)
......
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