Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
antik
gsll
Commits
630a69bd
Commit
630a69bd
authored
Oct 30, 2011
by
Liam M. Healy
Browse files
Use (:struct foo) syntax to eliminate style warnings from CFFI
parent
18e08e4e
Changes
15
Hide whitespace changes
Inline
Side-by-side
calculus/monte-carlo.lisp
View file @
630a69bd
;; Monte Carlo Integration
;; Liam Healy Sat Feb 3 2007 - 17:42
;; Time-stamp: <2011-
08-16 23:54:40
EDT monte-carlo.lisp>
;; Time-stamp: <2011-
10-30 10:01:57
EDT monte-carlo.lisp>
;;
;; Copyright 2007, 2008, 2009, 2011 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
...
...
@@ -58,7 +58,7 @@
(
result
(
:pointer
:double
))
(
abserr
(
:pointer
:double
)))
:inputs
(
lower-limits
upper-limits
)
:callbacks
(
callback
fnstruct-dimension
(
dimension
)
(
callback
(
:struct
fnstruct-dimension
)
(
dimension
)
(
function
:double
(
:input
:double
:cvector
dim0
)
:slug
))
:callback-dynamic
(((
dim0
lower-limits
))
(
function
scalars
))
:documentation
; FDL
...
...
@@ -119,7 +119,7 @@
(
result
(
:pointer
:double
))
(
abserr
(
:pointer
:double
)))
:inputs
(
lower-limits
upper-limits
)
:callbacks
(
callback
fnstruct-dimension
(
dimension
)
(
callback
(
:struct
fnstruct-dimension
)
(
dimension
)
(
function
:double
(
:input
:double
:cvector
dim0
)
:slug
))
:callback-dynamic
(((
dim0
lower-limits
))
(
function
scalars
))
:documentation
; FDL
...
...
@@ -180,7 +180,7 @@
(
result
(
:pointer
:double
))
(
abserr
(
:pointer
:double
)))
:inputs
(
lower-limits
upper-limits
)
:callbacks
(
callback
fnstruct-dimension
(
dimension
)
(
callback
(
:struct
fnstruct-dimension
)
(
dimension
)
(
function
:double
(
:input
:double
:cvector
dim0
)
:slug
))
:callback-dynamic
(((
dim0
lower-limits
))
(
function
scalars
))
:documentation
; FDL
...
...
calculus/numerical-differentiation.lisp
View file @
630a69bd
;; Numerical differentiation.
;; Liam Healy Mon Nov 12 2007 - 22:07
;; Time-stamp: <20
09-12-27 09:42:10ES
T numerical-differentiation.lisp>
;; Time-stamp: <20
11-10-30 10:27:07ED
T numerical-differentiation.lisp>
;;
;; Copyright 2007, 2008, 2009 Liam M. Healy
;; Copyright 2007, 2008, 2009
, 2011
Liam M. Healy
;; Distributed under the terms of the GNU General Public License
;;
;; This program is free software: you can redistribute it and/or modify
...
...
@@ -27,7 +27,7 @@
((
callback
:pointer
)
(
x
:double
)
(
step
:double
)
(
result
(
:pointer
:double
))
(
abserr
(
:pointer
:double
)))
:callbacks
(
callback
fnstruct
nil
(
function
:double
(
:input
:double
)
:slug
))
(
callback
(
:struct
fnstruct
)
nil
(
function
:double
(
:input
:double
)
:slug
))
:callback-dynamic
(
nil
(
function
))
:documentation
; FDL
"Compute the numerical derivative of the function
...
...
@@ -50,7 +50,7 @@
((
callback
:pointer
)
(
x
:double
)
(
step
:double
)
(
result
(
:pointer
:double
))
(
abserr
(
:pointer
:double
)))
:callbacks
(
callback
fnstruct
nil
(
function
:double
(
:input
:double
)
:slug
))
(
callback
(
:struct
fnstruct
)
nil
(
function
:double
(
:input
:double
)
:slug
))
:callback-dynamic
(
nil
(
function
))
:documentation
; FDL
"Compute the numerical derivative of the function
...
...
@@ -75,7 +75,7 @@
((
callback
:pointer
)
(
x
:double
)
(
step
:double
)
(
result
(
:pointer
:double
))
(
abserr
(
:pointer
:double
)))
:callbacks
(
callback
fnstruct
nil
(
function
:double
(
:input
:double
)
:slug
))
(
callback
(
:struct
fnstruct
)
nil
(
function
:double
(
:input
:double
)
:slug
))
:callback-dynamic
(
nil
(
function
))
:documentation
; FDL
"Compute the numerical derivative of the function at the point x
...
...
calculus/numerical-integration-with-tables.lisp
View file @
630a69bd
;; Numerical integration techniques that require tables
;; Liam Healy 2009-04-04 15:24:05EDT
;; Time-stamp: <201
0-08-07 21:41:16
EDT numerical-integration-with-tables.lisp>
;; Time-stamp: <201
1-10-30 10:27:27
EDT numerical-integration-with-tables.lisp>
;;
;; Copyright 2009 Liam M. Healy
;; Copyright 2009
, 2011
Liam M. Healy
;; Distributed under the terms of the GNU General Public License
;;
;; This program is free software: you can redistribute it and/or modify
...
...
@@ -65,7 +65,7 @@
(
limit
sizet
)
((
mpointer
workspace
)
:pointer
)
(
result
(
:pointer
:double
))
(
abserr
(
:pointer
:double
)))
:callbacks
(
callback
fnstruct
nil
(
function
:double
(
:input
:double
)
:slug
))
(
callback
(
:struct
fnstruct
)
nil
(
function
:double
(
:input
:double
)
:slug
))
:callback-dynamic
(
nil
(
function
))
:documentation
; FDL
"Compute the integral of the function f(x) over the interval (a,b)
...
...
@@ -123,7 +123,7 @@
((
mpointer
table
)
:pointer
)
(
result
(
:pointer
:double
))
(
abserr
(
:pointer
:double
)))
:callbacks
(
callback
fnstruct
nil
(
function
:double
(
:input
:double
)
:slug
))
(
callback
(
:struct
fnstruct
)
nil
(
function
:double
(
:input
:double
)
:slug
))
:callback-dynamic
(
nil
(
function
))
:documentation
; FDL
"Use an adaptive algorithm to compute the integral of f over (a,b)
...
...
@@ -167,7 +167,7 @@
((
mpointer
table
)
:pointer
)
(
result
(
:pointer
:double
))
(
abserr
(
:pointer
:double
)))
:callbacks
(
callback
fnstruct
nil
(
function
:double
(
:input
:double
)
:slug
))
(
callback
(
:struct
fnstruct
)
nil
(
function
:double
(
:input
:double
)
:slug
))
:callback-dynamic
(
nil
(
function
))
:documentation
; FDL
"This function attempts to compute a Fourier integral of the
...
...
calculus/numerical-integration.lisp
View file @
630a69bd
;; Numerical integration
;; Liam Healy, Wed Jul 5 2006 - 23:14
;; Time-stamp: <2011-
01-10 17:59:2
1E
S
T numerical-integration.lisp>
;; Time-stamp: <2011-
10-30 10:01:1
1E
D
T numerical-integration.lisp>
;;
;; Copyright 2006, 2007, 2008, 2009, 2010, 2011 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
...
...
@@ -52,7 +52,7 @@
(
result
(
:pointer
:double
))
(
abserr
(
:pointer
:double
))
(
neval
(
:pointer
sizet
)))
:callbacks
(
callback
fnstruct
nil
(
function
:double
(
:input
:double
)
:slug
))
(
callback
(
:struct
fnstruct
)
nil
(
function
:double
(
:input
:double
)
:slug
))
:callback-dynamic
(
nil
(
function
))
:documentation
; FDL
"Apply the Gauss-Kronrod 10-point, 21-point, 43-point and
...
...
@@ -92,7 +92,7 @@
(
limit
sizet
)
(
method
integrate-method
)
((
mpointer
workspace
)
:pointer
)
(
result
(
:pointer
:double
))
(
abserr
(
:pointer
:double
)))
:callbacks
(
callback
fnstruct
nil
(
function
:double
(
:input
:double
)
:slug
))
(
callback
(
:struct
fnstruct
)
nil
(
function
:double
(
:input
:double
)
:slug
))
:callback-dynamic
(
nil
(
function
))
:documentation
; FDL
"Apply an integration rule adaptively until an estimate
...
...
@@ -129,7 +129,7 @@
((
mpointer
workspace
)
:pointer
)
(
result
(
:pointer
:double
))
(
abserr
(
:pointer
:double
)))
:callbacks
(
callback
fnstruct
nil
(
function
:double
(
:input
:double
)
:slug
))
(
callback
(
:struct
fnstruct
)
nil
(
function
:double
(
:input
:double
)
:slug
))
:callback-dynamic
(
nil
(
function
))
:documentation
; FDL
"Apply the Gauss-Kronrod 21-point integration rule
...
...
@@ -163,7 +163,7 @@
(
result
(
:pointer
:double
))
(
abserr
(
:pointer
:double
)))
:inputs
(
points
)
:callbacks
(
callback
fnstruct
nil
(
function
:double
(
:input
:double
)
:slug
))
(
callback
(
:struct
fnstruct
)
nil
(
function
:double
(
:input
:double
)
:slug
))
:callback-dynamic
(
nil
(
function
))
:documentation
; FDL
"Apply the adaptive integration algorithm QAGS taking
...
...
@@ -193,7 +193,7 @@
((
mpointer
workspace
)
:pointer
)
(
result
(
:pointer
:double
))
(
abserr
(
:pointer
:double
)))
:callbacks
(
callback
fnstruct
nil
(
function
:double
(
:input
:double
)
:slug
))
(
callback
(
:struct
fnstruct
)
nil
(
function
:double
(
:input
:double
)
:slug
))
:callback-dynamic
(
nil
(
function
))
:documentation
; FDL
"Compute the integral of the function f over the
...
...
@@ -218,7 +218,7 @@
((
mpointer
workspace
)
:pointer
)
(
result
(
:pointer
:double
))
(
abserr
(
:pointer
:double
)))
:callbacks
(
callback
fnstruct
nil
(
function
:double
(
:input
:double
)
:slug
))
(
callback
(
:struct
fnstruct
)
nil
(
function
:double
(
:input
:double
)
:slug
))
:callback-dynamic
(
nil
(
function
))
:documentation
; FDL
"Compute the integral of the function f over the
...
...
@@ -239,7 +239,7 @@
((
mpointer
workspace
)
:pointer
)
(
result
(
:pointer
:double
))
(
abserr
(
:pointer
:double
)))
:callbacks
(
callback
fnstruct
nil
(
function
:double
(
:input
:double
)
:slug
))
(
callback
(
:struct
fnstruct
)
nil
(
function
:double
(
:input
:double
)
:slug
))
:callback-dynamic
(
nil
(
function
))
:documentation
; FDL
"Compute the integral of the function f over the
...
...
@@ -265,7 +265,7 @@
((
mpointer
workspace
)
:pointer
)
(
result
(
:pointer
:double
))
(
abserr
(
:pointer
:double
)))
:callbacks
(
callback
fnstruct
nil
(
function
:double
(
:input
:double
)
:slug
))
(
callback
(
:struct
fnstruct
)
nil
(
function
:double
(
:input
:double
)
:slug
))
:callback-dynamic
(
nil
(
function
))
:documentation
; FDL
"Compute the Cauchy principal value of the integral of
...
...
chebyshev.lisp
View file @
630a69bd
;; Chebyshev Approximations
;; Liam Healy Sat Nov 17 2007 - 20:36
;; Time-stamp: <201
0-06-29 21:47
:3
4
EDT chebyshev.lisp>
;; Time-stamp: <201
1-10-30 10:25
:3
9
EDT chebyshev.lisp>
;;
;; Copyright 2007, 2008, 2009, 2010 Liam M. Healy
;; Copyright 2007, 2008, 2009, 2010
, 2011
Liam M. Healy
;; Distributed under the terms of the GNU General Public License
;;
;; This program is free software: you can redistribute it and/or modify
...
...
@@ -32,7 +32,7 @@
:documentation
; FDL
"Make a Chebyshev series of specified order."
:callbacks
(
callback
fnstruct
nil
(
function
:double
(
:input
:double
)
:slug
))
(
callback
(
:struct
fnstruct
)
nil
(
function
:double
(
:input
:double
)
:slug
))
:initialize-suffix
"init"
:initialize-args
((
callback
:pointer
)
(
lower-limit
:double
)
(
upper-limit
:double
))
...
...
data/foreign-array.lisp
View file @
630a69bd
;; A grid:foreign-array with added metadata for GSL.
;; Liam Healy 2008-04-06 21:23:41EDT
;; Time-stamp: <2011-
01-12 00:34:42ES
T foreign-array.lisp>
;; Time-stamp: <2011-
10-30 09:45:20ED
T foreign-array.lisp>
;;
;; Copyright 2008, 2009, 2010, 2011 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
...
...
@@ -53,7 +53,10 @@
;; from the block to the vector/matrix; we must do that manually here
(
cffi:foreign-slot-value
array-struct
(
if
(
typep
object
'grid:matrix
)
'gsl-matrix-c
'gsl-vector-c
)
'data
)
(
if
(
typep
object
'grid:matrix
)
'
(
:struct
gsl-matrix-c
)
'
(
:struct
gsl-vector-c
))
'data
)
(
grid:foreign-pointer
object
))
(
tg:finalize
object
(
lambda
()
...
...
@@ -77,8 +80,7 @@
(
defun
make-foreign-array-from-mpointer
(
mpointer
&optional
(
element-type
'double-float
)
(
category-or-rank
'vector
)
finalize
)
"Make the foreign array when a GSL pointer to a
gsl-vector-c or gsl-matrix-c is given."
"Make the foreign array when a GSL pointer to a gsl-vector-c or gsl-matrix-c is given."
(
let*
((
category
(
case
category-or-rank
((
vector
:vector
1
)
'vector
)
...
...
@@ -86,8 +88,8 @@
(
t
(
error
"Unrecognized category ~a"
category-or-rank
))))
(
cstruct
(
case
category
(
vector
'gsl-vector-c
)
(
grid:matrix
'gsl-matrix-c
)))
(
vector
'
(
:struct
gsl-vector-c
)
)
(
grid:matrix
'
(
:struct
gsl-matrix-c
)))
)
(
fa
(
grid:make-grid
(
case
category
...
...
histogram/ntuple.lisp
View file @
630a69bd
;; N-tuples
;; Liam Healy Sat Feb 3 2007 - 12:53
;; Time-stamp: <2011-
08-19 09:44:1
6EDT ntuple.lisp>
;; Time-stamp: <2011-
10-30 10:09:0
6EDT ntuple.lisp>
;;
;; Copyright 2007, 2008, 2009, 2011 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
...
...
@@ -90,7 +90,7 @@
:callbacks
;; (valfn fnstruct nil (value-function :pointer (:input :pointer) :slug))
;; Need a second cbstruct definition:
(selfn fnstruct nil (select-function :pointer (:input :pointer) :slug))
(selfn
(:struct
fnstruct
)
nil (select-function :pointer (:input :pointer) :slug))
;;:callback-dynamic (nil (value-function))
:callback-dynamic (nil (select-function))
:documentation ; FDL
...
...
@@ -115,7 +115,7 @@
select-function returns zero are ignored. New entries are added to
the histogram, so subsequent calls can be used to accumulate further
data in the same histogram."
(
WITH-FOREIGN-OBJECTS
((
VALFN
'FNSTRUCT
)
(
SELFN
'fnstruct
))
(
WITH-FOREIGN-OBJECTS
((
VALFN
'
(
:struct
FNSTRUCT
)
)
(
SELFN
'
(
:struct
fnstruct
))
)
(
SETF
PROJECT-NTUPLE-DYNFN0
(
MAKE-COMPILED-FUNCALLABLE
VALUE-FUNCTION
...
...
@@ -124,8 +124,8 @@
(
MAKE-COMPILED-FUNCALLABLE
SELECT-FUNCTION
'
(
FUNCTION
:boolean
(
:INPUT
:POINTER
)
:SLUG
)
NIL
(
LIST
)))
(
SET-CBSTRUCT
VALFN
'FNSTRUCT
NIL
(
LIST
'FUNCTION
'PROJECT-NTUPLE-CBFN0
))
(
SET-CBSTRUCT
SELFN
'FNSTRUCT
NIL
(
LIST
'FUNCTION
'PROJECT-NTUPLE-CBFN1
))
(
SET-CBSTRUCT
VALFN
'
(
:struct
FNSTRUCT
)
NIL
(
LIST
'FUNCTION
'PROJECT-NTUPLE-CBFN0
))
(
SET-CBSTRUCT
SELFN
'
(
:struct
FNSTRUCT
)
NIL
(
LIST
'FUNCTION
'PROJECT-NTUPLE-CBFN1
))
(
LET
((
CRETURN
(
FOREIGN-FUNCALL
"gsl_ntuple_project"
:POINTER
(
MPOINTER
HISTOGRAM
)
:POINTER
NTUPLE
...
...
@@ -178,16 +178,16 @@
(
defun
make-ntuple-example-data
(
&optional
(
filename
*ntuple-example-data-file*
))
(
cffi:with-foreign-object
(
data
'ntuple-data
)
(
let
((
ntuple
(
create-ntuple
filename
data
'ntuple-data
))
(
cffi:with-foreign-object
(
data
'
(
:struct
ntuple-data
)
)
(
let
((
ntuple
(
create-ntuple
filename
data
'
(
:struct
ntuple-data
))
)
(
answer
(
make-array
100
:element-type
'fixnum
:initial-element
0
)))
(
dotimes
(
row
1000
)
(
multiple-value-bind
(
xi
yi
zi
)
(
ntuple-example-values
row
)
(
setf
(
cffi:foreign-slot-value
data
'ntuple-data
'num
)
row
(
cffi:foreign-slot-value
data
'ntuple-data
'x
)
xi
(
cffi:foreign-slot-value
data
'ntuple-data
'y
)
yi
(
cffi:foreign-slot-value
data
'ntuple-data
'z
)
zi
)
(
setf
(
cffi:foreign-slot-value
data
'
(
:struct
ntuple-data
)
'num
)
row
(
cffi:foreign-slot-value
data
'
(
:struct
ntuple-data
)
'x
)
xi
(
cffi:foreign-slot-value
data
'
(
:struct
ntuple-data
)
'y
)
yi
(
cffi:foreign-slot-value
data
'
(
:struct
ntuple-data
)
'z
)
zi
)
(
when
(
<
(
*
xi
*ntuple-example-scale*
)
0.1d0
)
(
incf
(
aref
answer
(
truncate
(
*
100
*ntuple-example-scale*
(
+
xi
yi
zi
)))))))
(
bookdata-ntuple
ntuple
))
...
...
@@ -195,37 +195,37 @@
answer
)))
(
defun
ntuple-example-read
(
&optional
(
filename
*ntuple-example-data-file*
))
(
cffi:with-foreign-object
(
data
'ntuple-data
)
(
let
((
ntuple
(
open-ntuple
filename
data
'ntuple-data
)))
(
cffi:with-foreign-object
(
data
'
(
:struct
ntuple-data
)
)
(
let
((
ntuple
(
open-ntuple
filename
data
'
(
:struct
ntuple-data
)))
)
(
prog1
(
dotimes
(
row
1000
t
)
(
multiple-value-bind
(
xi
yi
zi
)
(
ntuple-example-values
row
)
(
read-ntuple
ntuple
)
(
unless
(
and
(
eql
row
(
cffi:foreign-slot-value
data
'ntuple-data
'num
))
(
eql
xi
(
cffi:foreign-slot-value
data
'ntuple-data
'x
))
(
eql
yi
(
cffi:foreign-slot-value
data
'ntuple-data
'y
))
(
eql
zi
(
cffi:foreign-slot-value
data
'ntuple-data
'z
)))
(
and
(
eql
row
(
cffi:foreign-slot-value
data
'
(
:struct
ntuple-data
)
'num
))
(
eql
xi
(
cffi:foreign-slot-value
data
'
(
:struct
ntuple-data
)
'x
))
(
eql
yi
(
cffi:foreign-slot-value
data
'
(
:struct
ntuple-data
)
'y
))
(
eql
zi
(
cffi:foreign-slot-value
data
'
(
:struct
ntuple-data
)
'z
)))
(
return
nil
))))
(
close-ntuple
ntuple
)))))
(
defun
ntuple-example-sel-func
(
ntuple-data
)
(
<
(
*
(
cffi:foreign-slot-value
ntuple-data
'ntuple-data
'x
)
(
<
(
*
(
cffi:foreign-slot-value
ntuple-data
'
(
:struct
ntuple-data
)
'x
)
*ntuple-example-scale*
)
0.1d0
))
(
defun
ntuple-example-val-func
(
ntuple-data
)
(
*
(
+
(
cffi:foreign-slot-value
ntuple-data
'ntuple-data
'x
)
(
cffi:foreign-slot-value
ntuple-data
'ntuple-data
'y
)
(
cffi:foreign-slot-value
ntuple-data
'ntuple-data
'z
))
(
*
(
+
(
cffi:foreign-slot-value
ntuple-data
'
(
:struct
ntuple-data
)
'x
)
(
cffi:foreign-slot-value
ntuple-data
'
(
:struct
ntuple-data
)
'y
)
(
cffi:foreign-slot-value
ntuple-data
'
(
:struct
ntuple-data
)
'z
))
*ntuple-example-scale*
))
(
defun
ntuple-example-histogramming
(
&optional
(
filename
*ntuple-example-data-file*
))
(
cffi:with-foreign-object
(
data
'ntuple-data
)
(
cffi:with-foreign-object
(
data
'
(
:struct
ntuple-data
)
)
(
let
((
histo
(
make-histogram
100
))
(
ntuple
(
open-ntuple
filename
data
'ntuple-data
))
(
ntuple
(
open-ntuple
filename
data
'
(
:struct
ntuple-data
))
)
(
answer
(
make-ntuple-example-data
filename
)))
(
set-ranges-uniform
histo
0.0d0
1.0d0
)
(
project-ntuple
...
...
ordinary-differential-equations/stepping.lisp
View file @
630a69bd
;; Stepping functions for ODE systems.
;; Liam Healy, Mon Sep 24 2007 - 21:33
;; Time-stamp: <2011-
01-10 17:59:27ES
T stepping.lisp>
;; Time-stamp: <2011-
10-30 09:55:50ED
T stepping.lisp>
;;
;; Copyright 2007, 2008, 2009, 2011 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
...
...
@@ -33,7 +33,7 @@
continuation of a previous step."
:superclasses
(
callback-included-cl
)
:callbacks
(
callback
ode-system
(
callback
(
:struct
ode-system
)
(
dimension
)
(
function
:success-failure
(
:input
:double
)
; t (independent variable)
...
...
series-acceleration.lisp
View file @
630a69bd
;; Series acceleration.
;; Liam Healy, Wed Nov 21 2007 - 18:41
;; Time-stamp: <2011-
05-26 12:37:29
EDT series-acceleration.lisp>
;; Time-stamp: <2011-
10-30 09:55:05
EDT series-acceleration.lisp>
;;
;; Copyright 2007, 2008, 2009, 2011 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
...
...
@@ -27,7 +27,7 @@
;;;;****************************************************************************
(
defun
levin-value
(
levin
slot
)
(
cffi:foreign-slot-value
(
mpointer
levin
)
'levin-c
slot
))
(
cffi:foreign-slot-value
(
mpointer
levin
)
'
(
:struct
levin-c
)
slot
))
(
defmobject
levin
"gsl_sum_levin_u"
((
order
sizet
))
...
...
solve-minimize-fit/minimization-multi.lisp
View file @
630a69bd
;; Multivariate minimization.
;; Liam Healy <Tue Jan 8 2008 - 21:28>
;; Time-stamp: <2011-
09-28 13:30:49
EDT minimization-multi.lisp>
;; Time-stamp: <2011-
10-30 10:03:24
EDT minimization-multi.lisp>
;;
;; Copyright 2008, 2009, 2011 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
...
...
@@ -53,7 +53,7 @@
of the initial trial steps is given in vector step-size. The
precise meaning of this parameter depends on the method used."
:callbacks
(
callback
fnstruct-dimension
(
dimension
)
(
callback
(
:struct
fnstruct-dimension
)
(
dimension
)
(
function
:double
(
:input
:double
:foreign-array
dim0
)
:slug
))
:initialize-suffix
"set"
:initialize-args
;; Could have one fewer argument: dimension=(dim0 initial)
...
...
@@ -76,7 +76,7 @@
function g is orthogonal to the current search direction p to a
relative accuracy of tolerance, where dot(p,g) < tol |p| |g|."
:callbacks
(
callback
fnstruct-dimension-fdf
(
dimension
)
(
callback
(
:struct
fnstruct-dimension-fdf
)
(
dimension
)
(
function
:double
(
:input
:double
:foreign-array
dim0
)
:slug
)
(
df
:void
(
:input
:double
:foreign-array
dim0
)
:slug
...
...
solve-minimize-fit/minimization-one.lisp
View file @
630a69bd
;; Univariate minimization
;; Liam Healy Tue Jan 8 2008 - 21:02
;; Time-stamp: <201
0-08-07 21:41:13
EDT minimization-one.lisp>
;; Time-stamp: <201
1-10-30 10:31:55
EDT minimization-one.lisp>
;;
;; Copyright 2008, 2009 Liam M. Healy
;; Copyright 2008, 2009
, 2011
Liam M. Healy
;; Distributed under the terms of the GNU General Public License
;;
;; This program is free software: you can redistribute it and/or modify
...
...
@@ -37,7 +37,7 @@
(x-minimum x-lower x-upper) and optionally
function values at those points (f-minimum f-lower f-upper)."
:callbacks
(
callback
fnstruct
nil
(
function
:double
(
:input
:double
)
:slug
))
(
callback
(
:struct
fnstruct
)
nil
(
function
:double
(
:input
:double
)
:slug
))
:initialize-suffix
(
"set"
"set_with_values"
)
:initialize-args
(((
callback
:pointer
)
(
x-minimum
:double
)
...
...
solve-minimize-fit/nonlinear-least-squares.lisp
View file @
630a69bd
;; Nonlinear least squares fitting.
;; Liam Healy, 2008-02-09 12:59:16EST nonlinear-least-squares.lisp
;; Time-stamp: <2011-
08-17 00:50:45
EDT nonlinear-least-squares.lisp>
;; Time-stamp: <2011-
10-30 10:02:12
EDT nonlinear-least-squares.lisp>
;;
;; Copyright 2008, 2009, 2011 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
...
...
@@ -37,7 +37,7 @@
:documentation
; FDL
"The number of observations must be greater than or equal to parameters."
:callbacks
(
callback
fnstruct-fit
(
callback
(
:struct
fnstruct-fit
)
(
number-of-observations
number-of-parameters
)
(
function
:success-failure
...
...
@@ -68,7 +68,7 @@
"The number of observations must be greater than or
equal to parameters."
:callbacks
(
callback
fnstruct-fit-fdf
(
callback
(
:struct
fnstruct-fit-fdf
)
(
number-of-observations
number-of-parameters
)
(
function
:success-failure
(
:input
:double
:foreign-array
dim1
)
...
...
solve-minimize-fit/roots-multi.lisp
View file @
630a69bd
;;; Multivariate roots.
;;; Liam Healy 2008-01-12 12:49:08
;;; Time-stamp: <2011-
08-16 23:58:3
5EDT roots-multi.lisp>
;;; Time-stamp: <2011-
10-30 10:02:5
5EDT roots-multi.lisp>
;;
;; Copyright 2008, 2009, 2011 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
...
...
@@ -44,7 +44,7 @@
:initialize-suffix
"set"
:initialize-args
((
callback
:pointer
)
((
mpointer
initial
)
:pointer
))
:callbacks
(
callback
fnstruct-dimension
(
dimension
)
(
callback
(
:struct
fnstruct-dimension
)
(
dimension
)
(
function
:success-failure
(
:input
:double
:foreign-array
dim0
)
:slug
...
...
@@ -71,7 +71,7 @@
:initialize-suffix
"set"
:initialize-args
((
callback
:pointer
)
((
mpointer
initial
)
:pointer
))
:callbacks
(
callback
fnstruct-dimension-fdf
(
dimension
)
(
callback
(
:struct
fnstruct-dimension-fdf
)
(
dimension
)
(
function
:success-failure
(
:input
:double
:foreign-array
dim0
)
:slug
...
...
@@ -206,7 +206,7 @@
;;; to discriminate on mfsolver vs. mfdfsolver.
(
defun
multiroot-slot
(
solver
slot
)
(
cffi:foreign-slot-value
(
mpointer
solver
)
'gsl-multiroot-fsolver
slot
))
(
cffi:foreign-slot-value
(
mpointer
solver
)
'
(
:struct
gsl-multiroot-fsolver
)
slot
))
(
defmfun
multiroot-test-delta
(
solver
absolute-error
relative-error
)
"gsl_multiroot_test_delta"
...
...
solve-minimize-fit/roots-one.lisp
View file @
630a69bd
;; One-dimensional root solver.
;; Liam Healy
;; Time-stamp: <20
09-12-27 10:05:31ES
T roots-one.lisp>
;; Time-stamp: <20
11-10-30 10:34:42ED
T roots-one.lisp>
;;
;; Copyright 2009 Liam M. Healy
;; Copyright 2009
, 2011
Liam M. Healy
;; Distributed under the terms of the GNU General Public License
;;
;; This program is free software: you can redistribute it and/or modify
...
...
@@ -32,7 +32,7 @@
:initialize-suffix
"set"
:initialize-args
((
callback
:pointer
)
(
lower
:double
)
(
upper
:double
))
:callbacks
(
callback
fnstruct
nil
(
function
:double
(
:input
:double
)
:slug
))
(
callback
(
:struct
fnstruct
)
nil
(
function
:double
(
:input
:double
)
:slug
))
:singular
(
function
))
(
defmobject
one-dimensional-root-solver-fdf
"gsl_root_fdfsolver"
...
...
@@ -41,7 +41,7 @@
:initialize-suffix
"set"
:initialize-args
((
callback
:pointer
)
(
root-guess
:double
))
:callbacks
(
callback
fnstruct-fdf
nil
(
callback
(
:struct
fnstruct-fdf
)
nil
(
function
:double
(
:input
:double
)
:slug
)
(
df
:double
(
:input
:double
)
:slug
)
(
fdf
:void
(
:input
:double
)
:slug
...
...
solve-minimize-fit/simulated-annealing.lisp
View file @
630a69bd
;; Simulated Annealing
;; Liam Healy Sun Feb 11 2007 - 17:23
;; Time-stamp: <2011-10-
23 22:15:00
EDT simulated-annealing.lisp>
;; Time-stamp: <2011-10-
30 09:40:23
EDT simulated-annealing.lisp>
;;
;; Copyright 2007, 2008, 2009 Liam M. Healy
;; Copyright 2007, 2008, 2009
, 2011
Liam M. Healy
;; Distributed under the terms of the GNU General Public License
;;
;; This program is free software: you can redistribute it and/or modify
...
...
@@ -160,7 +160,13 @@
(
setf
cl-generator
generator
)
(
let
((
x0-p
(
make-new-sa-state
state-values
)))
(
simulated-annealing-int
(
list
n-tries
iterations-fixed-T
step-size
k
t-initial
mu-t
t-min
)
(
list
'n-tries
n-tries
'iterations-fixed-T
iterations-fixed-T
'step-size
step-size
'k
k
't-initial
t-initial
'mu-t
mu-t
't-min
t-min
)
generator
x0-p
'sa-energy-function
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment