Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Support
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
G
gsll
Project overview
Project overview
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
3
Issues
3
List
Boards
Labels
Milestones
Merge Requests
4
Merge Requests
4
Wiki
Wiki
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Commits
Issue Boards
Open sidebar
antik
gsll
Commits
74aed234
Commit
74aed234
authored
May 26, 2011
by
Liam M. Healy
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Use grid:aref instead of grid:gref
parent
fcc1723d
Changes
27
Hide whitespace changes
Inline
Side-by-side
Showing
27 changed files
with
158 additions
and
158 deletions
+158
-158
basis-splines.lisp
basis-splines.lisp
+6
-6
data/both.lisp
data/both.lisp
+2
-2
data/permutation.lisp
data/permutation.lisp
+2
-2
fast-fourier-transforms/example.lisp
fast-fourier-transforms/example.lisp
+10
-10
fast-fourier-transforms/extras.lisp
fast-fourier-transforms/extras.lisp
+8
-8
hankel.lisp
hankel.lisp
+4
-4
histogram/ntuple.lisp
histogram/ntuple.lisp
+2
-2
histogram/updating-accessing.lisp
histogram/updating-accessing.lisp
+7
-7
interpolation/spline-example.lisp
interpolation/spline-example.lisp
+2
-2
linear-algebra/blas1.lisp
linear-algebra/blas1.lisp
+3
-3
linear-algebra/cholesky.lisp
linear-algebra/cholesky.lisp
+2
-2
linear-algebra/diagonal.lisp
linear-algebra/diagonal.lisp
+7
-7
linear-algebra/qr.lisp
linear-algebra/qr.lisp
+2
-2
ordinary-differential-equations/ode-system.lisp
ordinary-differential-equations/ode-system.lisp
+4
-4
series-acceleration.lisp
series-acceleration.lisp
+3
-3
solve-minimize-fit/linear-least-squares.lisp
solve-minimize-fit/linear-least-squares.lisp
+17
-17
solve-minimize-fit/minimization-multi.lisp
solve-minimize-fit/minimization-multi.lisp
+15
-15
solve-minimize-fit/nonlinear-least-squares.lisp
solve-minimize-fit/nonlinear-least-squares.lisp
+16
-16
solve-minimize-fit/roots-multi.lisp
solve-minimize-fit/roots-multi.lisp
+17
-17
solve-minimize-fit/simulated-annealing.lisp
solve-minimize-fit/simulated-annealing.lisp
+6
-6
statistics/mean-variance.lisp
statistics/mean-variance.lisp
+2
-2
tests/fast-fourier-transform.lisp
tests/fast-fourier-transform.lisp
+3
-3
tests/givens.lisp
tests/givens.lisp
+6
-6
tests/hankel.lisp
tests/hankel.lisp
+3
-3
tests/histogram.lisp
tests/histogram.lisp
+4
-4
tests/permutation.lisp
tests/permutation.lisp
+1
-1
wavelet.lisp
wavelet.lisp
+4
-4
No files found.
basis-splines.lisp
View file @
74aed234
;; Basis splines.
;; Liam Healy 2008-02-18 14:43:20EST basis-splines.lisp
;; Time-stamp: <2011-0
1-13 10:24:59ES
T basis-splines.lisp>
;; Time-stamp: <2011-0
5-26 12:37:29ED
T basis-splines.lisp>
;;
;; Copyright 2008, 2009, 2011 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
...
...
@@ -125,18 +125,18 @@
(
let*
((
xi
(
coerce
(
*
i
(
/
15
(
1-
ndata
)))
'double-float
))
(
yi
(
+
(
*
(
cos
xi
)
(
exp
(
*
-0.1d0
xi
)))
(
sample
rng
:gaussian
:sigma
sigma
))))
(
setf
(
grid:
g
ref
x
i
)
xi
(
grid:
g
ref
y
i
)
yi
(
grid:
g
ref
w
i
)
(
/
(
expt
sigma
2
)))))
(
setf
(
grid:
a
ref
x
i
)
xi
(
grid:
a
ref
y
i
)
yi
(
grid:
a
ref
w
i
)
(
/
(
expt
sigma
2
)))))
;; Uniform breakpoints [0, 15]
(
uniform-knots
0.0d0
15.0d0
bw
)
;; Fit matrix
(
dotimes
(
i
ndata
)
;; Compute B_j
(
evaluate
bw
(
grid:
g
ref
x
i
)
:b
B
)
(
evaluate
bw
(
grid:
a
ref
x
i
)
:b
B
)
;; Fill in row i of X
(
dotimes
(
j
ncoeffs
)
(
setf
(
grid:
gref
Xmatrix
i
j
)
(
grid:g
ref
B
j
))))
(
setf
(
grid:
aref
Xmatrix
i
j
)
(
grid:a
ref
B
j
))))
;; Do the fit
(
linear-mfit
Xmatrix
y
c
w
nil
cov
mw
)
;; Return the smoothed curve
...
...
data/both.lisp
View file @
74aed234
;; Functions for both vectors and matrices.
;; Liam Healy 2008-04-26 20:48:44EDT both.lisp
;; Time-stamp: <2011-0
1-12 00:38:30ES
T both.lisp>
;; Time-stamp: <2011-0
5-26 12:37:36ED
T both.lisp>
;;
;; Copyright 2008, 2009, 2010, 2011 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
...
...
@@ -81,7 +81,7 @@
;;;;****************************************************************************
;;;; Array elements; used in callbacks scalarsp=T only
;;;;****************************************************************************
;;; Normal foreign array access is with grid:
g
ref, but in order to
;;; Normal foreign array access is with grid:
a
ref, but in order to
;;; avoid the overhead of instantiating a foreign-array object to
;;; access components, we use these macros which expand to gsl_*_get
;;; and gsl_*_set.
...
...
data/permutation.lisp
View file @
74aed234
;; Permutations
;; Liam Healy, Sun Mar 26 2006 - 11:51
;; Time-stamp: <2011-0
1-10 18:16:26ES
T permutation.lisp>
;; Time-stamp: <2011-0
5-26 12:37:36ED
T permutation.lisp>
;;
;; Copyright 2006, 2007, 2008, 2009, 2010, 2011 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
...
...
@@ -339,7 +339,7 @@
(
save-test
permutation
(
let
((
perm-1
(
make-permutation
4
t
)))
(
grid:
g
ref
perm-1
2
))
(
grid:
a
ref
perm-1
2
))
(
let
((
perm-1
(
make-permutation
4
t
)))
;grid:contents
(
grid:contents
perm-1
))
(
let
((
perm-1
(
make-permutation
4
t
)))
;permutation-reverse
...
...
fast-fourier-transforms/example.lisp
View file @
74aed234
;; Example FFT: transform a pulse (using the "clean" fft interface)
;; Sumant Oemrawsingh, Sat Oct 31 2009 - 00:24
;; Time-stamp: <2011-0
1-11 23:32:17ES
T example.lisp>
;; Time-stamp: <2011-0
5-26 12:37:35ED
T example.lisp>
;;
;; Copyright 2009, 2010, 2011 Sumant Oemrawsingh, Liam M. Healy
;; Distributed under the terms of the GNU General Public License
...
...
@@ -42,10 +42,10 @@
(
assert
(
and
(
integerp
dimension
)
(
>
dimension
20
)))
(
let
((
pulse
(
grid:make-foreign-array
element-type
:dimensions
dimension
))
(
init-value
(
coerce
1
element-type
)))
(
setf
(
grid:
g
ref
pulse
0
)
init-value
)
(
setf
(
grid:
a
ref
pulse
0
)
init-value
)
(
loop
for
i
from
1
to
10
do
(
setf
(
grid:
g
ref
pulse
i
)
init-value
(
grid:
g
ref
pulse
(
-
dimension
i
))
init-value
))
do
(
setf
(
grid:
a
ref
pulse
i
)
init-value
(
grid:
a
ref
pulse
(
-
dimension
i
))
init-value
))
(
forward-fourier-transform
pulse
)))
(
save-test
...
...
@@ -82,7 +82,7 @@
(
when
init-offset
(
loop
for
i
from
0
below
size
do
(
setf
(
grid:
g
ref
vec
i
)
(
setf
(
grid:
a
ref
vec
i
)
(
if
(
subtypep
element-type
'complex
)
(
coerce
(
complex
(
+
(
*
2
i
)
init-offset
)
(
+
(
*
2
i
)
init-offset
1
))
...
...
@@ -97,7 +97,7 @@
(
*
stride
dimension
)
:init-offset
init-offset
)))
(
loop
for
i
from
0
below
(
*
stride
dimension
)
by
stride
do
(
setf
(
grid:
g
ref
vec
i
)
(
setf
(
grid:
a
ref
vec
i
)
(
if
(
subtypep
element-type
'complex
)
(
coerce
(
complex
(
urand
)
(
urand
))
element-type
)
(
complex
(
coerce
(
urand
)
element-type
)))))
...
...
@@ -112,8 +112,8 @@
:init-offset
init-offset
)))
(
loop
for
i
below
(
size
complex-vector
)
by
stride
do
(
setf
(
grid:
g
ref
real-vector
i
)
(
realpart
(
grid:
g
ref
complex-vector
i
))))
(
setf
(
grid:
a
ref
real-vector
i
)
(
realpart
(
grid:
a
ref
complex-vector
i
))))
real-vector
))
(
defun
copy-with-stride
(
vector
&key
(
stride
1
)
init-offset
)
...
...
@@ -125,7 +125,7 @@
:init-offset
init-offset
)))
(
loop
for
i
below
(
size
vector
)
by
stride
do
(
setf
(
grid:
gref
vec
i
)
(
grid:g
ref
vector
i
)))
(
setf
(
grid:
aref
vec
i
)
(
grid:a
ref
vector
i
)))
vec
))
(
defun
size-vector-scalar
(
vector
&key
(
stride
1
))
...
...
@@ -144,7 +144,7 @@
(
loop
with
length
=
(
size-vector-scalar
vector
:stride
stride
)
for
i
from
0
below
(
size
vector
)
by
stride
do
(
setf
(
grid:
gref
vector
i
)
(
coerce
(
/
(
grid:g
ref
vector
i
)
length
)
element-type
)))
(
setf
(
grid:
aref
vector
i
)
(
coerce
(
/
(
grid:a
ref
vector
i
)
length
)
element-type
)))
vector
))
(
defun
test-real-fft-noise
(
vector
&key
(
stride
1
)
non-radix-2
)
...
...
fast-fourier-transforms/extras.lisp
View file @
74aed234
...
...
@@ -76,12 +76,12 @@
(
zero-pos
(
if
(
evenp
n
)
(
-
split
1
)
split
)))
;; Positive frequencies
(
loop
for
i
from
zero-pos
to
(
-
n
1
)
do
(
setf
(
grid:
g
ref
shifted
(
*
i
stride
))
(
grid:
g
ref
vector
(
*
(
-
i
zero-pos
)
stride
))))
do
(
setf
(
grid:
a
ref
shifted
(
*
i
stride
))
(
grid:
a
ref
vector
(
*
(
-
i
zero-pos
)
stride
))))
;; Negative frequencies
(
loop
for
i
from
(
+
split
1
)
to
(
-
n
1
)
do
(
setf
(
grid:
g
ref
shifted
(
*
(
-
i
split
1
)
stride
))
(
grid:
g
ref
vector
(
*
i
stride
))))
do
(
setf
(
grid:
a
ref
shifted
(
*
(
-
i
split
1
)
stride
))
(
grid:
a
ref
vector
(
*
i
stride
))))
shifted
))
(
export
'fft-inverse-shift
)
...
...
@@ -96,10 +96,10 @@
(
zero-pos
(
if
(
evenp
n
)
(
-
split
1
)
split
)))
;; Positive frequencies
(
loop
for
i
from
zero-pos
to
(
-
n
1
)
do
(
setf
(
grid:
g
ref
inv-shifted
(
*
(
-
i
zero-pos
)
stride
))
(
grid:
g
ref
vector
(
*
i
stride
))))
do
(
setf
(
grid:
a
ref
inv-shifted
(
*
(
-
i
zero-pos
)
stride
))
(
grid:
a
ref
vector
(
*
i
stride
))))
;; Negative frequencies
(
loop
for
i
from
(
+
split
1
)
to
(
-
n
1
)
do
(
setf
(
grid:
g
ref
inv-shifted
(
*
i
stride
))
(
grid:
g
ref
vector
(
*
(
-
i
split
1
)
stride
))))
do
(
setf
(
grid:
a
ref
inv-shifted
(
*
i
stride
))
(
grid:
a
ref
vector
(
*
(
-
i
split
1
)
stride
))))
inv-shifted
))
hankel.lisp
View file @
74aed234
;; Discrete Hankel Transforms.
;; Liam Healy, Sat Dec 8 2007 - 16:50
;; Time-stamp: <2011-0
1-10 18:16:23ES
T hankel.lisp>
;; Time-stamp: <2011-0
5-26 12:37:29ED
T hankel.lisp>
;;
;; Copyright 2007, 2008, 2009, 2011 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
...
...
@@ -81,7 +81,7 @@
(
let
((
hank
(
make-hankel
128
0.0d0
100.0d0
))
(
in
(
grid:make-foreign-array
'double-float
:dimensions
128
)))
(
loop
for
n
from
0
below
128
do
(
setf
(
grid:
g
ref
in
n
)
do
(
setf
(
grid:
a
ref
in
n
)
(
/
(
1+
(
expt
(
sample-x-hankel
hank
n
)
2
)))))
(
grid:copy-to
(
apply-hankel
hank
in
)))
;; Integrate[ x exp(-x) J_1(a x), {x,0,Inf}] = a F(3/2, 2; 2; -a^2)
...
...
@@ -89,13 +89,13 @@
(
let
((
hank
(
make-hankel
128
1.0d0
20.0d0
))
(
in
(
grid:make-foreign-array
'double-float
:dimensions
128
)))
(
loop
for
n
from
0
below
128
do
(
setf
(
grid:
g
ref
in
n
)
(
exp
(
-
(
sample-x-hankel
hank
n
)))))
do
(
setf
(
grid:
a
ref
in
n
)
(
exp
(
-
(
sample-x-hankel
hank
n
)))))
(
grid:copy-to
(
apply-hankel
hank
in
)))
;; Integrate[ x^2 (1-x^2) J_1(a x), {x,0,1}] = 2/a^2 J_3(a)
(
let
((
hank
(
make-hankel
128
1.0d0
1.0d0
))
(
in
(
grid:make-foreign-array
'double-float
:dimensions
128
)))
(
loop
for
n
from
0
below
128
do
(
setf
(
grid:
g
ref
in
n
)
do
(
setf
(
grid:
a
ref
in
n
)
(
let
((
x
(
sample-x-hankel
hank
n
)))
(
*
x
(
-
1
(
expt
x
2
))))))
(
grid:copy-to
(
apply-hankel
hank
in
))))
histogram/ntuple.lisp
View file @
74aed234
;; N-tuples
;; Liam Healy Sat Feb 3 2007 - 12:53
;; Time-stamp: <201
0-06-30 19:57:28
EDT ntuple.lisp>
;; Time-stamp: <201
1-05-26 12:37:35
EDT ntuple.lisp>
;;
;; Copyright 2007, 2008, 2009 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
...
...
@@ -235,7 +235,7 @@
(
close-ntuple
ntuple
)
;; Check the histogram to see if it matches ntuple-example-values
(
dotimes
(
row
100
t
)
(
unless
(
=
(
grid:
g
ref
histo
row
)
(
aref
answer
row
))
(
unless
(
=
(
grid:
a
ref
histo
row
)
(
aref
answer
row
))
(
return
nil
))))))
(
save-test
ntuple
...
...
histogram/updating-accessing.lisp
View file @
74aed234
;; Updating and accessing histogram elements.
;; Liam Healy, Mon Jan 1 2007 - 14:43
;; Time-stamp: <201
0-11-14 17:46:45ES
T updating-accessing.lisp>
;; Time-stamp: <201
1-05-26 12:37:35ED
T updating-accessing.lisp>
;;
;; Copyright 2007, 2008, 2009 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
...
...
@@ -42,12 +42,12 @@
histograms for a small range of a larger dataset, ignoring the values
outside the range of interest."
)
(
defmfun
grid:
g
ref
((
histogram
histogram
)
&rest
indices
)
(
defmfun
grid:
a
ref
((
histogram
histogram
)
&rest
indices
)
"gsl_histogram_get"
(((
mpointer
histogram
)
:pointer
)
((
first
indices
)
sizet
))
:definition
:method
:c-return
:double
:index
grid:
g
ref
:index
grid:
a
ref
:documentation
; FDL
"Return the contents of the i-th bin of the histogram.
If i lies outside the valid range of index for the
...
...
@@ -128,22 +128,22 @@
(
set-ranges-uniform
histo
0.0d0
10.0d0
)
(
increment
histo
2.7d0
)
(
increment
histo
6.9d0
2.0d0
)
(
grid:
g
ref
histo
1
))
(
grid:
a
ref
histo
1
))
(
let
((
histo
(
make-histogram
10
)))
(
set-ranges-uniform
histo
0.0d0
10.0d0
)
(
increment
histo
2.7d0
)
(
increment
histo
6.9d0
2.0d0
)
(
grid:
g
ref
histo
2
))
(
grid:
a
ref
histo
2
))
(
let
((
histo
(
make-histogram
10
)))
(
set-ranges-uniform
histo
0.0d0
10.0d0
)
(
increment
histo
2.7d0
)
(
increment
histo
6.9d0
2.0d0
)
(
grid:
g
ref
histo
6
))
(
grid:
a
ref
histo
6
))
(
let
((
histo
(
make-histogram
10
)))
(
set-ranges-uniform
histo
0.0d0
10.0d0
)
(
increment
histo
2.7d0
)
(
increment
histo
6.9d0
2.0d0
)
(
grid:
g
ref
histo
16
))
(
grid:
a
ref
histo
16
))
(
let
((
histo
(
make-histogram
10
)))
(
set-ranges-uniform
histo
0.0d0
10.0d0
)
(
increment
histo
2.7d0
)
...
...
interpolation/spline-example.lisp
View file @
74aed234
;; Example spline
;; Liam Healy, Sat Nov 10 2007 - 21:18
;; Time-stamp: <201
0-08-07 21:37:07
EDT spline-example.lisp>
;; Time-stamp: <201
1-05-26 12:37:34
EDT spline-example.lisp>
;;
;; Copyright 2007, 2008, 2009 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
...
...
@@ -35,7 +35,7 @@
(
loop
for
i
from
0.0d0
below
10.0d0
collect
(
+
i
(
cos
(
expt
i
2
))))))
(
spline
(
make-spline
+cubic-spline-interpolation+
xarr
yarr
)))
(
loop
for
xi
from
(
grid:
gref
xarr
0
)
below
(
grid:g
ref
xarr
9
)
by
step
(
loop
for
xi
from
(
grid:
aref
xarr
0
)
below
(
grid:a
ref
xarr
9
)
by
step
collect
(
list
xi
(
evaluate
spline
xi
)))))
(
defun
evaluate-integral-example
(
&optional
(
intervals
4
))
...
...
linear-algebra/blas1.lisp
View file @
74aed234
;; BLAS level 1, Vector operations
;; Liam Healy, Wed Apr 26 2006 - 15:23
;; Time-stamp: <2011-0
4-23 17:04:06
EDT blas1.lisp>
;; Time-stamp: <2011-0
5-26 12:37:34
EDT blas1.lisp>
;;
;; Copyright 2006, 2007, 2008, 2009, 2011 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
...
...
@@ -264,7 +264,7 @@
(
sines
(
array-default
8
t
))
(
cosines
(
array-default
8
t
)))
(
loop
for
i
below
8
do
(
setf
(
grid:
gref
sines
i
)
(
sin
(
grid:g
ref
angles
i
)))
(
setf
(
grid:
gref
cosines
i
)
(
cos
(
grid:g
ref
angles
i
))))
(
setf
(
grid:
aref
sines
i
)
(
sin
(
grid:a
ref
angles
i
)))
(
setf
(
grid:
aref
cosines
i
)
(
cos
(
grid:a
ref
angles
i
))))
(
givens-rotation
v1
v2
cosines
sines
)
(
list
(
grid:copy-to
v1
)
(
grid:copy-to
v2
))))
linear-algebra/cholesky.lisp
View file @
74aed234
;; Cholesky Decomposition
;; Liam Healy, Wed May 3 2006 - 16:38
;; Time-stamp: <2011-0
4-23 17:13:59
EDT cholesky.lisp>
;; Time-stamp: <2011-0
5-26 12:37:33
EDT cholesky.lisp>
;;
;; Copyright 2006, 2007, 2008, 2009, 2011 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
...
...
@@ -98,7 +98,7 @@
(
let
((
decomp
(
cholesky-decomposition
(
copy
matrix
))))
(
dotimes
(
row
(
dim0
matrix
)
decomp
)
(
loop
for
col
from
(
1+
row
)
below
(
dim1
matrix
)
do
(
setf
(
grid:
g
ref
decomp
row
col
)
0.0d0
)))
(
setf
(
grid:
a
ref
decomp
row
col
)
0.0d0
)))
(
matrix-product
decomp
decomp
nil
1.0d0
0.0d0
:notrans
:trans
)))
(
defun
test-cholesky-invert-dim
(
matrix
)
...
...
linear-algebra/diagonal.lisp
View file @
74aed234
;; Tridiagonal and Bidiagonal matrices
;; Liam Healy, Thu May 4 2006 - 15:43
;; Time-stamp: <2011-0
1-12 00:49:45ES
T diagonal.lisp>
;; Time-stamp: <2011-0
5-26 12:37:34ED
T diagonal.lisp>
;;
;; Copyright 2006, 2007, 2008, 2009, 2011 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
...
...
@@ -255,11 +255,11 @@
(
subdiag
(
mvec
(
1-
n
)
:initial-element
0.5d0
)))
(
setf
;; i=0 matrix elements
(
grid:
g
ref
diag
0
)
1d0
(
grid:
g
ref
superdiag
0
)
0d0
(
grid:
g
ref
b
0
)
(
coerce
(
expt
(
1-
n
)
2
)
'double-float
)
(
grid:
a
ref
diag
0
)
1d0
(
grid:
a
ref
superdiag
0
)
0d0
(
grid:
a
ref
b
0
)
(
coerce
(
expt
(
1-
n
)
2
)
'double-float
)
;; i=n-1 matrix elements
(
grid:
g
ref
diag
(
1-
n
))
1d0
(
grid:
g
ref
subdiag
(
-
n
2
))
0d0
(
grid:
g
ref
b
(
1-
n
))
0d0
)
(
grid:
a
ref
diag
(
1-
n
))
1d0
(
grid:
a
ref
subdiag
(
-
n
2
))
0d0
(
grid:
a
ref
b
(
1-
n
))
0d0
)
(
solve-tridiagonal
diag
superdiag
subdiag
b
x
))))
linear-algebra/qr.lisp
View file @
74aed234
;; QR decomposition
;; Liam Healy 2008-02-17 11:05:20EST qr.lisp
;; Time-stamp: <2011-0
4-23 17:14:30
EDT qr.lisp>
;; Time-stamp: <2011-0
5-26 12:37:33
EDT qr.lisp>
;;
;; Copyright 2008, 2009, 2011 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
...
...
@@ -258,7 +258,7 @@
dim1
nil
))
(
qr1
(
create-matrix
(
lambda
(
i
j
)
(
+
(
grid:
gref
matrix
i
j
)
(
*
(
grid:gref
u
i
)
(
grid:g
ref
v
j
))))
(
lambda
(
i
j
)
(
+
(
grid:
aref
matrix
i
j
)
(
*
(
grid:aref
u
i
)
(
grid:a
ref
v
j
))))
dim0
dim1
))
(
qr2
(
copy
matrix
))
(
w
(
grid:make-foreign-array
'double-float
:dimensions
dim0
:initial-element
0
)))
...
...
ordinary-differential-equations/ode-system.lisp
View file @
74aed234
;; ODE system setup
;; Liam Healy, Sun Apr 15 2007 - 14:19
;; Time-stamp: <2011-05-
04 10:25:19
EDT ode-system.lisp>
;; Time-stamp: <2011-05-
26 12:37:33
EDT ode-system.lisp>
;;
;; Copyright 2007, 2008, 2009, 2010, 2011 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
...
...
@@ -47,11 +47,11 @@
(
,
ctime
(
grid:make-foreign-array
'double-float
:dimensions
1
))
(
,
cstep
(
grid:make-foreign-array
'double-float
:dimensions
1
)))
(
symbol-macrolet
((
,
time
(
grid:
g
ref
,
ctime
0
))
(
,
step-size
(
grid:
g
ref
,
cstep
0
))
((
,
time
(
grid:
a
ref
,
ctime
0
))
(
,
step-size
(
grid:
a
ref
,
cstep
0
))
,@
(
loop
for
symb
in
dependent
for
i
from
0
collect
`
(
,
symb
(
grid:
g
ref
,
dep
,
i
))))
collect
`
(
,
symb
(
grid:
a
ref
,
dep
,
i
))))
(
flet
((
next-step
()
(
apply-evolution
evolve
,
ctime
,
dep
,
cstep
control
stepperobj
,
max-time
)))
...
...
series-acceleration.lisp
View file @
74aed234
;; Series acceleration.
;; Liam Healy, Wed Nov 21 2007 - 18:41
;; Time-stamp: <2011-0
1-10 17:59:30ES
T series-acceleration.lisp>
;; Time-stamp: <2011-0
5-26 12:37:29ED
T series-acceleration.lisp>
;;
;; Copyright 2007, 2008, 2009, 2011 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
...
...
@@ -95,8 +95,8 @@
(
let
((
levin
(
make-levin
maxterms
))
(
array
(
grid:make-foreign-array
'double-float
:dimensions
maxterms
)))
(
dotimes
(
n
maxterms
)
(
setf
(
grid:
g
ref
array
n
)
(
coerce
(
/
(
expt
(
1+
n
)
2
))
'double-float
))
(
incf
sum
(
grid:
g
ref
array
n
)))
(
setf
(
grid:
a
ref
array
n
)
(
coerce
(
/
(
expt
(
1+
n
)
2
))
'double-float
))
(
incf
sum
(
grid:
a
ref
array
n
)))
(
multiple-value-bind
(
accelerated-sum
error
)
(
accelerate
array
levin
)
(
when
print-explanation
...
...
solve-minimize-fit/linear-least-squares.lisp
View file @
74aed234
;; Linear least squares, or linear regression
;; Liam Healy <2008-01-21 12:41:46EST linear-least-squares.lisp>
;; Time-stamp: <2011-0
1-10 18:16:18ES
T linear-least-squares.lisp>
;; Time-stamp: <2011-0
5-26 12:37:31ED
T linear-least-squares.lisp>
;;
;; Copyright 2008, 2009, 2011 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
...
...
@@ -315,15 +315,15 @@
(
loop
for
i
from
0
below
(
dim0
x
)
do
(
format
t
"data: ~12,5f ~12,5f ~12,5f~&"
(
grid:
g
ref
x
i
)
(
grid:
g
ref
y
i
)
(
/
(
grid:
g
ref
w
i
))))
(
grid:
a
ref
x
i
)
(
grid:
a
ref
y
i
)
(
/
(
grid:
a
ref
w
i
))))
(
loop
for
i
from
-30
below
130
by
10
; don't print everything
for
xf
=
(
+
(
grid:
g
ref
x
0
)
xf
=
(
+
(
grid:
a
ref
x
0
)
(
*
(
/
i
100
)
(
-
(
grid:
g
ref
x
(
1-
(
dim0
x
)))
(
grid:
g
ref
x
0
))))
(
-
(
grid:
a
ref
x
(
1-
(
dim0
x
)))
(
grid:
a
ref
x
0
))))
do
(
multiple-value-bind
(
yf
yferr
)
(
linear-estimate
xf
c0
c1
cov00
cov01
cov11
)
...
...
@@ -353,26 +353,26 @@
(
w
(
grid:make-foreign-array
'double-float
:dimensions
n
)))
(
loop
for
i
from
0
for
row
in
data
do
(
setf
(
grid:
g
ref
X
i
0
)
1.0d0
(
grid:
g
ref
X
i
1
)
(
first
row
)
(
grid:
g
ref
X
i
2
)
(
expt
(
first
row
)
2
)
(
grid:
g
ref
y
i
)
(
second
row
)
(
grid:
g
ref
w
i
)
(
/
(
expt
(
third
row
)
2
))))
(
setf
(
grid:
a
ref
X
i
0
)
1.0d0
(
grid:
a
ref
X
i
1
)
(
first
row
)
(
grid:
a
ref
X
i
2
)
(
expt
(
first
row
)
2
)
(
grid:
a
ref
y
i
)
(
second
row
)
(
grid:
a
ref
w
i
)
(
/
(
expt
(
third
row
)
2
))))
(
multiple-value-bind
(
parameters
cov
chisq
)
(
linear-mfit
X
y
3
w
)
(
when
print-details
(
format
t
"Best fit: Y = ~10,8f + ~10,8f X + ~10,8f X^2~&"
(
grid:
gref
parameters
0
)
(
grid:gref
parameters
1
)
(
grid:g
ref
parameters
2
))
(
grid:
aref
parameters
0
)
(
grid:aref
parameters
1
)
(
grid:a
ref
parameters
2
))
(
format
t
"Covariance matrix:~&"
)
(
format
t
"~10,8f ~10,8f ~10,8f~&"
(
grid:
gref
cov
0
0
)
(
grid:gref
cov
0
1
)
(
grid:g
ref
cov
0
2
))
(
grid:
aref
cov
0
0
)
(
grid:aref
cov
0
1
)
(
grid:a
ref
cov
0
2
))
(
format
t
"~10,8f ~10,8f ~10,8f~&"
(
grid:
gref
cov
1
0
)
(
grid:gref
cov
1
1
)
(
grid:g
ref
cov
1
2
))
(
grid:
aref
cov
1
0
)
(
grid:aref
cov
1
1
)
(
grid:a
ref
cov
1
2
))
(
format
t
"~10,8f ~10,8f ~10,8f~&"
(
grid:
gref
cov
2
0
)
(
grid:gref
cov
2
1
)
(
grid:g
ref
cov
2
2
))
(
grid:
aref
cov
2
0
)
(
grid:aref
cov
2
1
)
(
grid:a
ref
cov
2
2
))
(
format
t
"Chisq = ~10,6f~&"
chisq
))
(
values
(
grid:
gref
parameters
0
)
(
grid:gref
parameters
1
)
(
grid:g
ref
parameters
2
)
(
grid:
aref
parameters
0
)
(
grid:aref
parameters
1
)
(
grid:a
ref
parameters
2
)
chisq
))))
(
save-test
linear-least-squares
...
...
solve-minimize-fit/minimization-multi.lisp
View file @
74aed234
;; Multivariate minimization.
;; Liam Healy <Tue Jan 8 2008 - 21:28>
;; Time-stamp: <201
0-07-13 11:45:28
EDT minimization-multi.lisp>
;; Time-stamp: <201
1-05-26 12:37:32
EDT minimization-multi.lisp>
;;
;; Copyright 2008, 2009 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
...
...
@@ -384,13 +384,13 @@
(
when
print-steps
(
let
((
x
(
solution
minimizer
)))
(
format
t
"~d~6t~10,6f~18t~10,6f~28t~12,9f~40t~8,3f~&"
iter
(
grid:
gref
x
0
)
(
grid:g
ref
x
1
)
iter
(
grid:
aref
x
0
)
(
grid:a
ref
x
1
)
(
function-value
minimizer
)
size
)))
finally
(
return
(
let
((
x
(
solution
minimizer
)))
(
values
(
grid:
gref
x
0
)
(
grid:g
ref
x
1
)
(
function-value
minimizer
))))))))
(
values
(
grid:
aref
x
0
)
(
grid:a
ref
x
1
)
(
function-value
minimizer
))))))))
;;; Example using derivatives, taking a vector argument.
;;; Note that these functions are written to read mpointers to
...
...
@@ -403,9 +403,9 @@
;; 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:
g
ref on it.
(
let
((
x
(
grid:
g
ref
xy
0
))
(
y
(
grid:
g
ref
xy
1
))
;; and then call grid:
a
ref on it.
(
let
((
x
(
grid:
a
ref
xy
0
))
(
y
(
grid:
a
ref
xy
1
))
(
dp0
(
aref
*paraboloid-center*
0
))
(
dp1
(
aref
*paraboloid-center*
1
)))
(
+
(
*
10
(
expt
(
-
x
dp0
)
2
))
...
...
@@ -413,19 +413,19 @@
30
)))
(
defun
paraboloid-derivative
(
xy
output
)
(
let
((
x
(
grid:
g
ref
xy
0
))
(
y
(
grid:
g
ref
xy
1
))
(
let
((
x
(
grid:
a
ref
xy
0
))
(
y
(
grid:
a
ref
xy
1
))
(
dp0
(
aref
*paraboloid-center*
0
))
(
dp1
(
aref
*paraboloid-center*
1
)))
(
setf
(
grid:
g
ref
output
0
)
(
setf
(
grid:
a
ref
output
0
)
(
*
20
(
-
x
dp0
))
(
grid:
g
ref
output
1
)
(
grid:
a
ref
output
1
)
(
*
40
(
-
y
dp1
)))))
(
defun
paraboloid-and-derivative
(
arguments-gv-pointer
value-pointer
derivative-gv-pointer
)
(
prog1
(
setf
(
grid:
g
ref
value-pointer
0
)
(
setf
(
grid:
a
ref
value-pointer
0
)
(
paraboloid-vector
arguments-gv-pointer
))
(
paraboloid-derivative
arguments-gv-pointer
derivative-gv-pointer
)))
...
...
@@ -455,12 +455,12 @@
(
when
print-steps
(
let
((
x
(
solution
minimizer
)))
(
format
t
"~d~6t~10,6f~18t~10,6f~28t~12,9f~&"
iter
(
grid:
gref
x
0
)
(
grid:g
ref
x
1
)
iter
(
grid:
aref
x
0
)
(
grid:a
ref
x
1
)
(
function-value
minimizer
))))
finally
(
return
(
let
((
x
(
solution
minimizer
)))
(
values
(
grid:
gref
x
0
)
(
grid:g
ref
x
1
)
(
function-value
minimizer
)))))))
(
values
(
grid:
aref
x
0
)
(
grid:a
ref
x
1
)
(
function-value
minimizer
)))))))
(
defun
paraboloid-derivative-scalar
(
x
y
)
(
let
((
dp0
(
aref
*paraboloid-center*
0
))
...
...
@@ -499,12 +499,12 @@
(
when
print-steps
(
let
((
x
(
solution
minimizer
)))
(
format
t
"~d~6t~10,6f~18t~10,6f~28t~12,9f~&"
iter
(
grid:
gref
x
0
)
(
grid:g
ref
x
1
)
iter
(
grid:
aref
x
0
)
(
grid:a
ref
x
1
)
(
function-value
minimizer
))))
finally
(
return
(
let
((
x
(
solution
minimizer
)))
(
values
(
grid:
gref
x
0
)
(
grid:g
ref
x
1
)
(
function-value
minimizer
)))))))
(
values
(
grid:
aref
x
0
)
(
grid:a
ref
x
1
)
(
function-value
minimizer
)))))))
(
save-test
minimization-multi
(
multimin-example-no-derivative
+simplex-nelder-mead-on2+
nil
)
...
...
solve-minimize-fit/nonlinear-least-squares.lisp
View file @
74aed234
;; Nonlinear least squares fitting.
;; Liam Healy, 2008-02-09 12:59:16EST nonlinear-least-squares.lisp
;; Time-stamp: <201
0-06-30 19:57:28
EDT nonlinear-least-squares.lisp>
;; Time-stamp: <201
1-05-26 12:37:32
EDT nonlinear-least-squares.lisp>
;;
;; Copyright 2008, 2009 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
...
...
@@ -301,7 +301,7 @@
(
let
((
arr
(
grid:make-foreign-array
'double-float
:dimensions
number-of-observations
))
(
rng
(
make-random-number-generator
+mt19937+
0
)))
(
dotimes
(
i
number-of-observations
arr
)
(
setf
(
grid:
g
ref
arr
i
)
(
setf
(
grid:
a
ref
arr
i
)
(
+
1
(
*
5
(
exp
(
*
-1/10
i
)))
(
sample
rng
:gaussian
:sigma
0.1d0
)))))
:sigma
...
...
@@ -311,32 +311,32 @@
(
defun
exponential-residual
(
x
f
)
"Compute the negative of the residuals with the exponential model
for the nonlinear least squares example."
(
let
((
A
(
grid:
g
ref
x
0
))
(
lambda
(
grid:
g
ref
x
1
))
(
b
(
grid:
g
ref
x
2
)))
(
let
((
A
(
grid:
a
ref
x
0
))
(
lambda
(
grid:
a
ref
x
1
))
(
b
(
grid:
a
ref
x
2
)))
(
symbol-macrolet
((
y
(
exponent-fit-data-y
*nlls-example-data*
))
(
sigma
(
exponent-fit-data-sigma
*nlls-example-data*
)))
(
dotimes
(
i
(
exponent-fit-data-n
*nlls-example-data*
))
(
setf
(
grid:
g
ref
f
i
)
(
setf
(
grid:
a
ref
f
i
)
;; the difference model - observation = - residual
(
/
(
-
(
+
(
*
A
(
exp
(
*
(
-
lambda
)
i
)))
b
)
(
grid:
g
ref
y
i
))
(
grid:
g
ref
sigma
i
)))))))
(
/
(
-
(
+
(
*
A
(
exp
(
*
(
-
lambda
)
i
)))
b
)
(
grid:
a
ref
y
i
))
(
grid:
a
ref
sigma
i
)))))))
(
defun
exponential-residual-derivative
(
x
jacobian
)
"Compute the partial derivatives of the negative of the
residuals with the exponential model
for the nonlinear least squares example."
(
let
((
A
(
grid:
g
ref
x
0
))
(
lambda
(
grid:
g
ref
x
1
)))
(
let
((
A
(
grid:
a
ref
x
0
))
(
lambda
(
grid:
a
ref
x
1
)))
(
symbol-macrolet
((
sigma
(
exponent-fit-data-sigma
*nlls-example-data*
)))
(
dotimes
(
i
(
exponent-fit-data-n
*nlls-example-data*
))
(
let
((
e
(
exp
(
*
(
-
lambda
)
i
)))
(
s
(
grid:
g
ref
sigma
i
)))
(
setf
(
grid:
g
ref
jacobian
i
0
)
(
/
e
s
)
(
grid:
g
ref
jacobian
i
1
)
(
*
-1
i
A
(
/
e
s
))
(
grid:
g
ref
jacobian
i
2
)
(
/
s
)))))))
(
s
(
grid:
a
ref
sigma
i
)))
(
setf
(
grid:
a
ref
jacobian
i
0
)
(
/
e
s
)
(
grid:
a
ref
jacobian
i
1
)
(
*
-1
i
A
(
/
e
s
))
(
grid:
a
ref
jacobian
i
2
)
(
/
s
)))))))
(
defun
exponential-residual-fdf
(
x
f
jacobian
)
"Compute the function and partial derivatives of the negative of the
...
...
@@ -363,8 +363,8 @@
'
(
exponential-residual
exponential-residual-derivative
exponential-residual-fdf
)
init
nil
)))
(
macrolet
((
fitx
(
i
)
`
(
grid:
g
ref
(
solution
fit
)
,
i
))
(
err
(
i
)
`
(
sqrt
(
grid:
g
ref
covariance
,
i
,
i
))))
(
macrolet
((
fitx
(
i
)
`
(
grid:
a
ref
(
solution
fit
)
,
i
))
(
err
(
i
)
`
(
sqrt
(
grid:
a
ref
covariance
,
i
,
i
))))
(
when
print-steps
(
format
t
"iter: ~d x = ~15,8f ~15,8f ~15,8f |f(x)|=~7,6g~&"
0
(
fitx
0
)
(
fitx
1
)
(
fitx
2
)
...
...
solve-minimize-fit/roots-multi.lisp
View file @
74aed234
;;; Multivariate roots.
;;; Liam Healy 2008-01-12 12:49:08
;;; Time-stamp: <2011-0
1-10 18:19:07ES
T roots-multi.lisp>
;;; Time-stamp: <2011-0
5-26 12:37:31ED
T roots-multi.lisp>
;;
;; Copyright 2008, 2009, 2011 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
...
...
@@ -418,15 +418,15 @@
(
when
print-steps
(
format
t
"iter=~d~8tx0=~12,8g~24tx1=~12,8g~38tf0=~12,8g~52tf1=~12,8g~&"
iter
(
grid:
g
ref
argval
0
)
(
grid:
g
ref
argval
1
)
(
grid:
g
ref
fnval
0
)
(
grid:
g
ref
fnval
1
)))
(
grid:
a
ref
argval
0
)
(
grid:
a
ref
argval
1
)
(
grid:
a
ref
fnval
0
)
(
grid:
a
ref
fnval
1
)))
finally
(
return
(
values
(
grid:
g
ref
argval
0
)
(
grid:
g
ref
argval
1
)
(
grid:
g
ref
fnval
0
)
(
grid:
g
ref
fnval
1
))))))
(
values
(
grid:
a
ref
argval
0
)
(
grid:
a
ref
argval
1
)
(
grid:
a
ref
fnval
0
)
(
grid:
a
ref
fnval
1
))))))
(
defun
rosenbrock-df
(
arg0
arg1
)
"The partial derivatives of the Rosenbrock functions."
...
...
@@ -452,10 +452,10 @@
(
when
print-steps
(
format
t
"iter=~d~8tx0=~12,8g~24tx1=~12,8g~38tf0=~12,8g~52tf1=~12,8g~&"
iter
(
grid:
g
ref
argval
0
)
(
grid:
g
ref
argval
1
)
(
grid:
g
ref
fnval
0
)
(
grid:
g
ref
fnval
1
)))))
(
grid:
a
ref
argval
0
)
(
grid:
a
ref
argval
1
)
(
grid:
a
ref
fnval
0
)
(
grid:
a
ref
fnval
1
)))))
(
let
((
max-iter
1000
)
(
solver
(
make-multi-dimensional-root-solver-fdf
method
...
...
@@ -473,10 +473,10 @@
argval
(
solution
solver
))
(
print-state
iter
argval
fnval
)
finally
(
return
(
values
(
grid:
g
ref
argval
0
)
(
grid:
g
ref
argval
1
)
(
grid:
g
ref
fnval
0
)
(
grid:
g
ref
fnval
1
)))))))
(
values
(
grid:
a
ref
argval
0
)
(
grid:
a
ref
argval
1
)
(
grid:
a
ref
fnval
0
)
(
grid:
a
ref
fnval
1
)))))))
;; To see step-by-step information as the solution progresses, make
;; the last argument T.
...
...
solve-minimize-fit/simulated-annealing.lisp
View file @
74aed234
;; Simulated Annealing