gsl 1.12.108
This diff represents the content of publicly available package versions that have been released to one of the supported registries. The information contained in this diff is provided for informational purposes only and reflects changes between package versions as they appear in their respective public registries.
- data/README.rdoc +29 -0
- data/Rakefile +54 -0
- data/VERSION +2 -0
- data/ext/MANIFEST +119 -0
- data/ext/alf.c +206 -0
- data/ext/array.c +666 -0
- data/ext/array_complex.c +247 -0
- data/ext/blas.c +29 -0
- data/ext/blas1.c +731 -0
- data/ext/blas2.c +1093 -0
- data/ext/blas3.c +881 -0
- data/ext/block.c +44 -0
- data/ext/block_source.c +886 -0
- data/ext/bspline.c +130 -0
- data/ext/bundle.c +3 -0
- data/ext/cdf.c +754 -0
- data/ext/cheb.c +542 -0
- data/ext/combination.c +283 -0
- data/ext/common.c +325 -0
- data/ext/complex.c +1004 -0
- data/ext/const.c +673 -0
- data/ext/const_additional.c +120 -0
- data/ext/cqp.c +283 -0
- data/ext/deriv.c +195 -0
- data/ext/dht.c +361 -0
- data/ext/diff.c +166 -0
- data/ext/dirac.c +395 -0
- data/ext/eigen.c +2373 -0
- data/ext/error.c +194 -0
- data/ext/extconf.rb +281 -0
- data/ext/fcmp.c +66 -0
- data/ext/fft.c +1092 -0
- data/ext/fit.c +205 -0
- data/ext/fresnel.c +312 -0
- data/ext/function.c +524 -0
- data/ext/geometry.c +139 -0
- data/ext/graph.c +1638 -0
- data/ext/gsl.c +271 -0
- data/ext/gsl_narray.c +653 -0
- data/ext/histogram.c +1995 -0
- data/ext/histogram2d.c +1068 -0
- data/ext/histogram3d.c +884 -0
- data/ext/histogram3d_source.c +750 -0
- data/ext/histogram_find.c +101 -0
- data/ext/histogram_oper.c +159 -0
- data/ext/ieee.c +98 -0
- data/ext/integration.c +1138 -0
- data/ext/interp.c +512 -0
- data/ext/jacobi.c +739 -0
- data/ext/linalg.c +4047 -0
- data/ext/linalg_complex.c +741 -0
- data/ext/math.c +725 -0
- data/ext/matrix.c +39 -0
- data/ext/matrix_complex.c +1732 -0
- data/ext/matrix_double.c +560 -0
- data/ext/matrix_int.c +256 -0
- data/ext/matrix_source.c +2733 -0
- data/ext/min.c +250 -0
- data/ext/monte.c +992 -0
- data/ext/multifit.c +1879 -0
- data/ext/multimin.c +808 -0
- data/ext/multimin_fsdf.c +156 -0
- data/ext/multiroots.c +955 -0
- data/ext/ndlinear.c +321 -0
- data/ext/nmf.c +167 -0
- data/ext/nmf_wrap.c +72 -0
- data/ext/ntuple.c +469 -0
- data/ext/odeiv.c +959 -0
- data/ext/ool.c +879 -0
- data/ext/oper_complex_source.c +253 -0
- data/ext/permutation.c +596 -0
- data/ext/poly.c +42 -0
- data/ext/poly2.c +265 -0
- data/ext/poly_source.c +1885 -0
- data/ext/qrng.c +171 -0
- data/ext/randist.c +1873 -0
- data/ext/rational.c +480 -0
- data/ext/rng.c +612 -0
- data/ext/root.c +408 -0
- data/ext/sf.c +1494 -0
- data/ext/sf_airy.c +200 -0
- data/ext/sf_bessel.c +867 -0
- data/ext/sf_clausen.c +28 -0
- data/ext/sf_coulomb.c +206 -0
- data/ext/sf_coupling.c +118 -0
- data/ext/sf_dawson.c +29 -0
- data/ext/sf_debye.c +157 -0
- data/ext/sf_dilog.c +42 -0
- data/ext/sf_elementary.c +44 -0
- data/ext/sf_ellint.c +206 -0
- data/ext/sf_elljac.c +29 -0
- data/ext/sf_erfc.c +93 -0
- data/ext/sf_exp.c +164 -0
- data/ext/sf_expint.c +211 -0
- data/ext/sf_fermi_dirac.c +148 -0
- data/ext/sf_gamma.c +344 -0
- data/ext/sf_gegenbauer.c +96 -0
- data/ext/sf_hyperg.c +197 -0
- data/ext/sf_laguerre.c +112 -0
- data/ext/sf_lambert.c +47 -0
- data/ext/sf_legendre.c +367 -0
- data/ext/sf_log.c +104 -0
- data/ext/sf_mathieu.c +238 -0
- data/ext/sf_power.c +46 -0
- data/ext/sf_psi.c +98 -0
- data/ext/sf_synchrotron.c +48 -0
- data/ext/sf_transport.c +76 -0
- data/ext/sf_trigonometric.c +207 -0
- data/ext/sf_zeta.c +119 -0
- data/ext/signal.c +310 -0
- data/ext/siman.c +718 -0
- data/ext/sort.c +208 -0
- data/ext/spline.c +395 -0
- data/ext/stats.c +799 -0
- data/ext/sum.c +168 -0
- data/ext/tamu_anova.c +56 -0
- data/ext/tensor.c +38 -0
- data/ext/tensor_source.c +1123 -0
- data/ext/vector.c +38 -0
- data/ext/vector_complex.c +2236 -0
- data/ext/vector_double.c +1433 -0
- data/ext/vector_int.c +204 -0
- data/ext/vector_source.c +3329 -0
- data/ext/wavelet.c +937 -0
- data/include/rb_gsl.h +151 -0
- data/include/rb_gsl_array.h +238 -0
- data/include/rb_gsl_cheb.h +21 -0
- data/include/rb_gsl_common.h +343 -0
- data/include/rb_gsl_complex.h +25 -0
- data/include/rb_gsl_const.h +29 -0
- data/include/rb_gsl_dirac.h +13 -0
- data/include/rb_gsl_eigen.h +17 -0
- data/include/rb_gsl_fft.h +62 -0
- data/include/rb_gsl_fit.h +25 -0
- data/include/rb_gsl_function.h +27 -0
- data/include/rb_gsl_graph.h +70 -0
- data/include/rb_gsl_histogram.h +63 -0
- data/include/rb_gsl_histogram3d.h +97 -0
- data/include/rb_gsl_integration.h +17 -0
- data/include/rb_gsl_interp.h +46 -0
- data/include/rb_gsl_linalg.h +25 -0
- data/include/rb_gsl_math.h +26 -0
- data/include/rb_gsl_odeiv.h +21 -0
- data/include/rb_gsl_poly.h +71 -0
- data/include/rb_gsl_rational.h +37 -0
- data/include/rb_gsl_rng.h +21 -0
- data/include/rb_gsl_root.h +22 -0
- data/include/rb_gsl_sf.h +119 -0
- data/include/rb_gsl_statistics.h +17 -0
- data/include/rb_gsl_tensor.h +45 -0
- data/include/rb_gsl_with_narray.h +22 -0
- data/include/templates_off.h +87 -0
- data/include/templates_on.h +241 -0
- data/lib/gsl/gnuplot.rb +41 -0
- data/lib/gsl/oper.rb +68 -0
- data/lib/ool.rb +22 -0
- data/lib/ool/conmin.rb +30 -0
- metadata +224 -0
|
@@ -0,0 +1,101 @@
|
|
|
1
|
+
/* histogram/find.c
|
|
2
|
+
*
|
|
3
|
+
* Copyright (C) 1996, 1997, 1998, 1999, 2000 Brian Gough
|
|
4
|
+
*
|
|
5
|
+
* This program is free software; you can redistribute it and/or modify
|
|
6
|
+
* it under the terms of the GNU General Public License as published by
|
|
7
|
+
* the Free Software Foundation; either version 2 of the License, or (at
|
|
8
|
+
* your option) any later version.
|
|
9
|
+
*
|
|
10
|
+
* This program is distributed in the hope that it will be useful, but
|
|
11
|
+
* WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
12
|
+
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
13
|
+
* General Public License for more details.
|
|
14
|
+
*
|
|
15
|
+
* You should have received a copy of the GNU General Public License
|
|
16
|
+
* along with this program; if not, write to the Free Software
|
|
17
|
+
* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
|
|
18
|
+
*/
|
|
19
|
+
|
|
20
|
+
#include "rb_gsl_histogram.h"
|
|
21
|
+
/* determines whether to optimize for linear ranges */
|
|
22
|
+
#define LINEAR_OPT 1
|
|
23
|
+
|
|
24
|
+
int mygsl_find (const size_t n, const double range[], const double x, size_t * i)
|
|
25
|
+
{
|
|
26
|
+
size_t i_linear, lower, upper, mid;
|
|
27
|
+
if (x < range[0]) return -1;
|
|
28
|
+
if (x >= range[n]) return +1;
|
|
29
|
+
|
|
30
|
+
/* optimize for linear case */
|
|
31
|
+
|
|
32
|
+
#ifdef LINEAR_OPT
|
|
33
|
+
{
|
|
34
|
+
double u = (x - range[0]) / (range[n] - range[0]);
|
|
35
|
+
i_linear = (size_t) (n*u);
|
|
36
|
+
}
|
|
37
|
+
|
|
38
|
+
if (x >= range[i_linear] && x < range[i_linear + 1])
|
|
39
|
+
{
|
|
40
|
+
*i = i_linear;
|
|
41
|
+
return 0;
|
|
42
|
+
}
|
|
43
|
+
#endif
|
|
44
|
+
|
|
45
|
+
/* perform binary search */
|
|
46
|
+
|
|
47
|
+
upper = n ;
|
|
48
|
+
lower = 0 ;
|
|
49
|
+
|
|
50
|
+
while (upper - lower > 1)
|
|
51
|
+
{
|
|
52
|
+
mid = (upper + lower) / 2 ;
|
|
53
|
+
|
|
54
|
+
if (x >= range[mid])
|
|
55
|
+
{
|
|
56
|
+
lower = mid ;
|
|
57
|
+
}
|
|
58
|
+
else
|
|
59
|
+
{
|
|
60
|
+
upper = mid ;
|
|
61
|
+
}
|
|
62
|
+
}
|
|
63
|
+
|
|
64
|
+
*i = lower ;
|
|
65
|
+
|
|
66
|
+
/* sanity check the result */
|
|
67
|
+
|
|
68
|
+
if (x < range[lower] || x >= range[lower + 1])
|
|
69
|
+
{
|
|
70
|
+
GSL_ERROR ("x not found in range", GSL_ESANITY);
|
|
71
|
+
}
|
|
72
|
+
|
|
73
|
+
return 0;
|
|
74
|
+
}
|
|
75
|
+
|
|
76
|
+
int mygsl_find2d (const size_t nx, const double xrange[],
|
|
77
|
+
const size_t ny, const double yrange[],
|
|
78
|
+
const double x, const double y,
|
|
79
|
+
size_t * i, size_t * j)
|
|
80
|
+
{
|
|
81
|
+
int status = mygsl_find (nx, xrange, x, i);
|
|
82
|
+
if (status) return status;
|
|
83
|
+
status = mygsl_find (ny, yrange, y, j);
|
|
84
|
+
if (status) return status;
|
|
85
|
+
return 0;
|
|
86
|
+
}
|
|
87
|
+
|
|
88
|
+
int mygsl_find3d (const size_t nx, const double xrange[],
|
|
89
|
+
const size_t ny, const double yrange[],
|
|
90
|
+
const size_t nz, const double zrange[],
|
|
91
|
+
const double x, const double y, const double z,
|
|
92
|
+
size_t * i, size_t * j, size_t *k)
|
|
93
|
+
{
|
|
94
|
+
int status = mygsl_find (nx, xrange, x, i);
|
|
95
|
+
if (status) return status;
|
|
96
|
+
status = mygsl_find (ny, yrange, y, j);
|
|
97
|
+
if (status) return status;
|
|
98
|
+
status = mygsl_find (nz, zrange, z, k);
|
|
99
|
+
if (status) return status;
|
|
100
|
+
return 0;
|
|
101
|
+
}
|
|
@@ -0,0 +1,159 @@
|
|
|
1
|
+
/* gsl_histogram_oper.c
|
|
2
|
+
* Copyright (C) 2000 Simone Piccardi
|
|
3
|
+
*
|
|
4
|
+
* This library is free software; you can redistribute it and/or
|
|
5
|
+
* modify it under the terms of the GNU General Public License as
|
|
6
|
+
* published by the Free Software Foundation; either version 2 of the
|
|
7
|
+
* License, or (at your option) any later version.
|
|
8
|
+
*
|
|
9
|
+
* This program is distributed in the hope that it will be useful,
|
|
10
|
+
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
11
|
+
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
12
|
+
* General Public License for more details.
|
|
13
|
+
*
|
|
14
|
+
* You should have received a copy of the GNU General Public
|
|
15
|
+
* License along with this library; if not, write to the
|
|
16
|
+
* Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
17
|
+
* Boston, MA 02111-1307, USA.
|
|
18
|
+
*/
|
|
19
|
+
/***************************************************************
|
|
20
|
+
*
|
|
21
|
+
* File gsl_histogram_oper.c:
|
|
22
|
+
* Routine to make operation on histograms.
|
|
23
|
+
* Need GSL library and header.
|
|
24
|
+
* Contains the routines:
|
|
25
|
+
* gsl_histogram_same_binning check if two histograms have the same binning
|
|
26
|
+
* gsl_histogram_add add two histograms
|
|
27
|
+
* gsl_histogram_sub subctract two histograms
|
|
28
|
+
* gsl_histogram_mult multiply two histograms
|
|
29
|
+
* gsl_histogram_div divide two histograms
|
|
30
|
+
* gsl_histogram_scale scale histogram contents
|
|
31
|
+
*
|
|
32
|
+
* Author: S. Piccardi
|
|
33
|
+
* Jan. 2000
|
|
34
|
+
*
|
|
35
|
+
***************************************************************/
|
|
36
|
+
#include <stdlib.h>
|
|
37
|
+
#include <gsl/gsl_errno.h>
|
|
38
|
+
#include <gsl/gsl_math.h>
|
|
39
|
+
#include <gsl/gsl_histogram.h>
|
|
40
|
+
|
|
41
|
+
/*
|
|
42
|
+
* gsl_histogram_same_binning:
|
|
43
|
+
* control if two histograms have the
|
|
44
|
+
* same binning
|
|
45
|
+
*/
|
|
46
|
+
|
|
47
|
+
int
|
|
48
|
+
mygsl_histogram_equal_bins_p (const gsl_histogram * h1, const gsl_histogram * h2)
|
|
49
|
+
{
|
|
50
|
+
if (h1->n != h2->n)
|
|
51
|
+
{
|
|
52
|
+
return 0;
|
|
53
|
+
}
|
|
54
|
+
|
|
55
|
+
{
|
|
56
|
+
size_t i;
|
|
57
|
+
/* init ranges */
|
|
58
|
+
|
|
59
|
+
for (i = 0; i <= h1->n; i++)
|
|
60
|
+
{
|
|
61
|
+
if (gsl_fcmp(h1->range[i],h2->range[i], 1e-12))
|
|
62
|
+
{
|
|
63
|
+
return 0;
|
|
64
|
+
}
|
|
65
|
+
}
|
|
66
|
+
}
|
|
67
|
+
|
|
68
|
+
return 1;
|
|
69
|
+
}
|
|
70
|
+
|
|
71
|
+
/*
|
|
72
|
+
* gsl_histogram_add:
|
|
73
|
+
* add two histograms
|
|
74
|
+
*/
|
|
75
|
+
int
|
|
76
|
+
mygsl_histogram_add (gsl_histogram * h1, const gsl_histogram * h2)
|
|
77
|
+
{
|
|
78
|
+
size_t i;
|
|
79
|
+
|
|
80
|
+
if (!mygsl_histogram_equal_bins_p (h1, h2))
|
|
81
|
+
{
|
|
82
|
+
GSL_ERROR ("histograms have different binning", GSL_EINVAL);
|
|
83
|
+
}
|
|
84
|
+
|
|
85
|
+
for (i = 0; i < h1->n; i++)
|
|
86
|
+
{
|
|
87
|
+
h1->bin[i] += h2->bin[i];
|
|
88
|
+
}
|
|
89
|
+
|
|
90
|
+
return GSL_SUCCESS;
|
|
91
|
+
}
|
|
92
|
+
|
|
93
|
+
/*
|
|
94
|
+
* gsl_histogram_sub:
|
|
95
|
+
* subtract two histograms
|
|
96
|
+
*/
|
|
97
|
+
|
|
98
|
+
int
|
|
99
|
+
mygsl_histogram_sub (gsl_histogram * h1, const gsl_histogram * h2)
|
|
100
|
+
{
|
|
101
|
+
size_t i;
|
|
102
|
+
|
|
103
|
+
if (!mygsl_histogram_equal_bins_p (h1, h2))
|
|
104
|
+
{
|
|
105
|
+
GSL_ERROR ("histograms have different binning", GSL_EINVAL);
|
|
106
|
+
}
|
|
107
|
+
|
|
108
|
+
for (i = 0; i < h1->n; i++)
|
|
109
|
+
{
|
|
110
|
+
h1->bin[i] -= h2->bin[i];
|
|
111
|
+
}
|
|
112
|
+
|
|
113
|
+
return GSL_SUCCESS;
|
|
114
|
+
|
|
115
|
+
}
|
|
116
|
+
|
|
117
|
+
/*
|
|
118
|
+
* gsl_histogram_mult:
|
|
119
|
+
* multiply two histograms
|
|
120
|
+
*/
|
|
121
|
+
|
|
122
|
+
int
|
|
123
|
+
mygsl_histogram_mul (gsl_histogram * h1, const gsl_histogram * h2)
|
|
124
|
+
{
|
|
125
|
+
size_t i;
|
|
126
|
+
|
|
127
|
+
if (!mygsl_histogram_equal_bins_p (h1, h2))
|
|
128
|
+
{
|
|
129
|
+
GSL_ERROR ("histograms have different binning", GSL_EINVAL);
|
|
130
|
+
}
|
|
131
|
+
|
|
132
|
+
for (i = 0; i < h1->n; i++)
|
|
133
|
+
{
|
|
134
|
+
h1->bin[i] *= h2->bin[i];
|
|
135
|
+
}
|
|
136
|
+
|
|
137
|
+
return GSL_SUCCESS;
|
|
138
|
+
}
|
|
139
|
+
/*
|
|
140
|
+
* gsl_histogram_div:
|
|
141
|
+
* divide two histograms
|
|
142
|
+
*/
|
|
143
|
+
int
|
|
144
|
+
mygsl_histogram_div (gsl_histogram * h1, const gsl_histogram * h2)
|
|
145
|
+
{
|
|
146
|
+
size_t i;
|
|
147
|
+
|
|
148
|
+
if (!mygsl_histogram_equal_bins_p (h1, h2))
|
|
149
|
+
{
|
|
150
|
+
GSL_ERROR ("histograms have different binning", GSL_EINVAL);
|
|
151
|
+
}
|
|
152
|
+
|
|
153
|
+
for (i = 0; i < h1->n; i++)
|
|
154
|
+
{
|
|
155
|
+
h1->bin[i] /= h2->bin[i];
|
|
156
|
+
}
|
|
157
|
+
|
|
158
|
+
return GSL_SUCCESS;
|
|
159
|
+
}
|
data/ext/ieee.c
ADDED
|
@@ -0,0 +1,98 @@
|
|
|
1
|
+
/*
|
|
2
|
+
ieee.c
|
|
3
|
+
Ruby/GSL: Ruby extension library for GSL (GNU Scientific Library)
|
|
4
|
+
(C) Copyright 2001-2006 by Yoshiki Tsunesada
|
|
5
|
+
|
|
6
|
+
Ruby/GSL is free software: you can redistribute it and/or modify it
|
|
7
|
+
under the terms of the GNU General Public License.
|
|
8
|
+
This library is distributed in the hope that it will be useful, but
|
|
9
|
+
WITHOUT ANY WARRANTY.
|
|
10
|
+
*/
|
|
11
|
+
|
|
12
|
+
#include "rb_gsl.h"
|
|
13
|
+
|
|
14
|
+
static VALUE rb_gsl_ieee_env_setup(VALUE obj)
|
|
15
|
+
{
|
|
16
|
+
gsl_ieee_env_setup();
|
|
17
|
+
return obj;
|
|
18
|
+
}
|
|
19
|
+
|
|
20
|
+
static VALUE rb_gsl_ieee_fprintf_double(int argc, VALUE *argv, VALUE obj)
|
|
21
|
+
{
|
|
22
|
+
#ifdef RUBY_1_9_LATER
|
|
23
|
+
rb_io_t *fptr = NULL;
|
|
24
|
+
#else
|
|
25
|
+
OpenFile *fptr = NULL;
|
|
26
|
+
#endif
|
|
27
|
+
FILE *fp = NULL;
|
|
28
|
+
int flag = 0;
|
|
29
|
+
VALUE vtmp;
|
|
30
|
+
|
|
31
|
+
switch (argc) {
|
|
32
|
+
case 2:
|
|
33
|
+
switch (TYPE(argv[0])) {
|
|
34
|
+
case T_STRING:
|
|
35
|
+
fp = fopen(RSTRING_PTR(argv[0]), "w");
|
|
36
|
+
flag = 1;
|
|
37
|
+
break;
|
|
38
|
+
case T_FILE:
|
|
39
|
+
GetOpenFile(argv[0], fptr);
|
|
40
|
+
rb_io_check_writable(fptr);
|
|
41
|
+
#ifdef RUBY_1_9_LATER
|
|
42
|
+
fp = rb_io_stdio_file(fptr);
|
|
43
|
+
#else
|
|
44
|
+
fp = GetWriteFile(fptr);
|
|
45
|
+
#endif
|
|
46
|
+
break;
|
|
47
|
+
default:
|
|
48
|
+
rb_raise(rb_eTypeError, "wrong type argument %s (IO or String expected)",
|
|
49
|
+
rb_class2name(CLASS_OF(argv[0])));
|
|
50
|
+
}
|
|
51
|
+
vtmp = argv[1];
|
|
52
|
+
break;
|
|
53
|
+
case 1:
|
|
54
|
+
vtmp = argv[0];
|
|
55
|
+
fp = stdout;
|
|
56
|
+
break;
|
|
57
|
+
default:
|
|
58
|
+
rb_raise(rb_eArgError, "wrong number of arguments (%d for 1 or 2)", argc);
|
|
59
|
+
}
|
|
60
|
+
if (TYPE(vtmp) != T_FLOAT)
|
|
61
|
+
rb_raise(rb_eTypeError, "wrong argument type %s (Float expected)",
|
|
62
|
+
rb_class2name(CLASS_OF(vtmp)));
|
|
63
|
+
#ifdef RUBY_1_9_LATER
|
|
64
|
+
gsl_ieee_fprintf_double(fp, &(RFLOAT_VALUE(vtmp)));
|
|
65
|
+
#else
|
|
66
|
+
gsl_ieee_fprintf_double(fp, &(RFLOAT(vtmp)->value));
|
|
67
|
+
#endif
|
|
68
|
+
if (fp == stdout) fprintf(stdout, "\n");
|
|
69
|
+
if (flag == 1) fclose(fp);
|
|
70
|
+
return obj;
|
|
71
|
+
}
|
|
72
|
+
|
|
73
|
+
static VALUE rb_gsl_ieee_printf_double(VALUE obj, VALUE xx)
|
|
74
|
+
{
|
|
75
|
+
double x;
|
|
76
|
+
x = NUM2DBL(xx);
|
|
77
|
+
gsl_ieee_printf_double(&x);
|
|
78
|
+
return xx;
|
|
79
|
+
}
|
|
80
|
+
|
|
81
|
+
void Init_gsl_ieee(VALUE module)
|
|
82
|
+
{
|
|
83
|
+
VALUE mgsl_ieee;
|
|
84
|
+
mgsl_ieee = rb_define_module_under(module, "IEEE");
|
|
85
|
+
|
|
86
|
+
rb_define_singleton_method(mgsl_ieee, "env_setup",
|
|
87
|
+
rb_gsl_ieee_env_setup, 0);
|
|
88
|
+
rb_define_module_function(module, "ieee_env_setup", rb_gsl_ieee_env_setup, 0);
|
|
89
|
+
rb_define_singleton_method(mgsl_ieee, "fprintf_double",
|
|
90
|
+
rb_gsl_ieee_fprintf_double, -1);
|
|
91
|
+
rb_define_singleton_method(mgsl_ieee, "fprintf",
|
|
92
|
+
rb_gsl_ieee_fprintf_double, -1);
|
|
93
|
+
rb_define_singleton_method(mgsl_ieee, "printf",
|
|
94
|
+
rb_gsl_ieee_printf_double, -1);
|
|
95
|
+
rb_define_singleton_method(mgsl_ieee, "printf_double",
|
|
96
|
+
rb_gsl_ieee_printf_double, -1);
|
|
97
|
+
|
|
98
|
+
}
|
data/ext/integration.c
ADDED
|
@@ -0,0 +1,1138 @@
|
|
|
1
|
+
/*
|
|
2
|
+
integration.c
|
|
3
|
+
Ruby/GSL: Ruby extension library for GSL (GNU Scientific Library)
|
|
4
|
+
(C) Copyright 2001-2006 by Yoshiki Tsunesada
|
|
5
|
+
|
|
6
|
+
Ruby/GSL is free software: you can redistribute it and/or modify it
|
|
7
|
+
under the terms of the GNU General Public License.
|
|
8
|
+
This library is distributed in the hope that it will be useful, but
|
|
9
|
+
WITHOUT ANY WARRANTY.
|
|
10
|
+
*/
|
|
11
|
+
|
|
12
|
+
#include "rb_gsl_config.h"
|
|
13
|
+
|
|
14
|
+
#include "rb_gsl_array.h"
|
|
15
|
+
#include "rb_gsl_function.h"
|
|
16
|
+
#include "rb_gsl_integration.h"
|
|
17
|
+
#include "rb_gsl_common.h"
|
|
18
|
+
|
|
19
|
+
#ifndef CHECK_WORKSPACE
|
|
20
|
+
#define CHECK_WORKSPACE(x) if(CLASS_OF(x)!=cgsl_integration_workspace)\
|
|
21
|
+
rb_raise(rb_eTypeError,\
|
|
22
|
+
"wrong argument type %s (Integration::Workspace expected)",\
|
|
23
|
+
rb_class2name(CLASS_OF(x)));
|
|
24
|
+
#endif
|
|
25
|
+
|
|
26
|
+
#define EPSABS_DEFAULT 0.0
|
|
27
|
+
#define EPSREL_DEFAULT 1e-10
|
|
28
|
+
#define LIMIT_DEFAULT 1000
|
|
29
|
+
#define KEY_DEFAULT GSL_INTEG_GAUSS61
|
|
30
|
+
|
|
31
|
+
static VALUE cgsl_integration_qaws_table, cgsl_integration_qawo_table;
|
|
32
|
+
|
|
33
|
+
static VALUE cgsl_integration_workspace;
|
|
34
|
+
|
|
35
|
+
static int get_a_b(int argc, VALUE *argv, int argstart, double *a, double *b);
|
|
36
|
+
static int get_epsabs_epsrel(int argc, VALUE *argv, int argstart,
|
|
37
|
+
double *epsabs, double *epsrel);
|
|
38
|
+
static int get_a_b_epsabs_epsrel(int argc, VALUE *argv, int argstart,
|
|
39
|
+
double *a, double *b, double *epsabs,
|
|
40
|
+
double *epsrel);
|
|
41
|
+
static int get_limit_key_workspace(int argc, VALUE *argv, int argstart,
|
|
42
|
+
size_t *limit, int *key,
|
|
43
|
+
gsl_integration_workspace **w);
|
|
44
|
+
static int get_limit_workspace(int argc, VALUE *argv, int argstart,
|
|
45
|
+
size_t *limit,
|
|
46
|
+
gsl_integration_workspace **w);
|
|
47
|
+
static int get_epsabs_epsrel_limit_workspace(int argc, VALUE *argv, int argstart,
|
|
48
|
+
double *epsabs, double *epsrel,
|
|
49
|
+
size_t *limit,
|
|
50
|
+
gsl_integration_workspace **w);
|
|
51
|
+
|
|
52
|
+
static int get_a_b(int argc, VALUE *argv, int argstart, double *a, double *b)
|
|
53
|
+
{
|
|
54
|
+
int itmp;
|
|
55
|
+
VALUE aa, bb;
|
|
56
|
+
if (argstart >= argc) return argstart;
|
|
57
|
+
if (TYPE(argv[argstart]) == T_ARRAY) {
|
|
58
|
+
aa = rb_ary_entry(argv[argstart], 0);
|
|
59
|
+
bb = rb_ary_entry(argv[argstart], 1);
|
|
60
|
+
Need_Float(aa); Need_Float(bb);
|
|
61
|
+
// *a = RFLOAT(aa)->value;
|
|
62
|
+
// *b = RFLOAT(bb)->value;
|
|
63
|
+
*a = NUM2DBL(aa);
|
|
64
|
+
*b = NUM2DBL(bb);
|
|
65
|
+
itmp = argstart + 1;
|
|
66
|
+
} else {
|
|
67
|
+
Need_Float(argv[argstart]); Need_Float(argv[argstart+1]);
|
|
68
|
+
*a = NUM2DBL(argv[argstart]);
|
|
69
|
+
*b = NUM2DBL(argv[argstart+1]);
|
|
70
|
+
itmp = argstart + 2;
|
|
71
|
+
}
|
|
72
|
+
return itmp;
|
|
73
|
+
}
|
|
74
|
+
|
|
75
|
+
static int get_epsabs_epsrel(int argc, VALUE *argv, int argstart,
|
|
76
|
+
double *epsabs, double *epsrel)
|
|
77
|
+
{
|
|
78
|
+
int itmp;
|
|
79
|
+
VALUE aa, bb;
|
|
80
|
+
*epsabs = EPSABS_DEFAULT;
|
|
81
|
+
*epsrel = EPSREL_DEFAULT;
|
|
82
|
+
if (argstart >= argc) return argstart;
|
|
83
|
+
if (TYPE(argv[argstart]) == T_ARRAY) {
|
|
84
|
+
aa = rb_ary_entry(argv[argstart], 0);
|
|
85
|
+
bb = rb_ary_entry(argv[argstart], 1);
|
|
86
|
+
Need_Float(aa); Need_Float(bb);
|
|
87
|
+
*epsabs = NUM2DBL(aa);
|
|
88
|
+
*epsrel = NUM2DBL(bb);
|
|
89
|
+
itmp = 1;
|
|
90
|
+
} else {
|
|
91
|
+
Need_Float(argv[argstart]); Need_Float(argv[argstart+1]);
|
|
92
|
+
*epsabs = NUM2DBL(argv[argstart]);
|
|
93
|
+
*epsrel = NUM2DBL(argv[argstart+1]);
|
|
94
|
+
itmp = 2;
|
|
95
|
+
}
|
|
96
|
+
return argstart + itmp;
|
|
97
|
+
}
|
|
98
|
+
|
|
99
|
+
static int get_a_b_epsabs_epsrel(int argc, VALUE *argv, int argstart,
|
|
100
|
+
double *a, double *b, double *epsabs,
|
|
101
|
+
double *epsrel)
|
|
102
|
+
{
|
|
103
|
+
int itmp;
|
|
104
|
+
*epsabs = EPSABS_DEFAULT;
|
|
105
|
+
*epsrel = EPSREL_DEFAULT;
|
|
106
|
+
itmp = get_a_b(argc, argv, argstart, a, b);
|
|
107
|
+
itmp = get_epsabs_epsrel(argc, argv, itmp, epsabs, epsrel);
|
|
108
|
+
return itmp;
|
|
109
|
+
}
|
|
110
|
+
|
|
111
|
+
static int get_limit_key_workspace(int argc, VALUE *argv, int argstart,
|
|
112
|
+
size_t *limit, int *key,
|
|
113
|
+
gsl_integration_workspace **w)
|
|
114
|
+
{
|
|
115
|
+
int flag = 0;
|
|
116
|
+
switch (argc-argstart) {
|
|
117
|
+
case 3:
|
|
118
|
+
CHECK_FIXNUM(argv[argstart]);
|
|
119
|
+
CHECK_FIXNUM(argv[argstart+1]);
|
|
120
|
+
CHECK_WORKSPACE(argv[argstart+2]);
|
|
121
|
+
*limit = FIX2INT(argv[argstart]);
|
|
122
|
+
*key = FIX2INT(argv[argstart+1]);
|
|
123
|
+
Data_Get_Struct(argv[argstart+2], gsl_integration_workspace, *w);
|
|
124
|
+
flag = 0;
|
|
125
|
+
break;
|
|
126
|
+
case 1:
|
|
127
|
+
CHECK_FIXNUM(argv[argstart]);
|
|
128
|
+
*key = FIX2INT(argv[argstart]);
|
|
129
|
+
*limit = LIMIT_DEFAULT;
|
|
130
|
+
*w = gsl_integration_workspace_alloc(*limit);
|
|
131
|
+
flag = 1;
|
|
132
|
+
break;
|
|
133
|
+
case 2:
|
|
134
|
+
if (TYPE(argv[argc-1]) == T_FIXNUM) {
|
|
135
|
+
CHECK_FIXNUM(argv[argc-2]);
|
|
136
|
+
*limit = FIX2INT(argv[argc-2]);
|
|
137
|
+
*key = FIX2INT(argv[argc-1]);
|
|
138
|
+
*w = gsl_integration_workspace_alloc(*limit);
|
|
139
|
+
flag = 1;
|
|
140
|
+
} else {
|
|
141
|
+
CHECK_FIXNUM(argv[argc-2]);
|
|
142
|
+
CHECK_WORKSPACE(argv[argc-1]);
|
|
143
|
+
*key = FIX2INT(argv[argc-2]);
|
|
144
|
+
Data_Get_Struct(argv[argc-1], gsl_integration_workspace, *w);
|
|
145
|
+
*limit = (*w)->limit;
|
|
146
|
+
flag = 0;
|
|
147
|
+
}
|
|
148
|
+
break;
|
|
149
|
+
case 0:
|
|
150
|
+
*key = KEY_DEFAULT;
|
|
151
|
+
*limit = LIMIT_DEFAULT;
|
|
152
|
+
*w = gsl_integration_workspace_alloc(*limit);
|
|
153
|
+
flag = 1;
|
|
154
|
+
break;
|
|
155
|
+
default:
|
|
156
|
+
rb_raise(rb_eArgError, "wrong number of arguments");
|
|
157
|
+
break;
|
|
158
|
+
}
|
|
159
|
+
if (*w == NULL) rb_raise(rb_eRuntimeError, "something wrong with workspace");
|
|
160
|
+
return flag;
|
|
161
|
+
}
|
|
162
|
+
|
|
163
|
+
static int get_limit_workspace(int argc, VALUE *argv, int argstart,
|
|
164
|
+
size_t *limit,
|
|
165
|
+
gsl_integration_workspace **w)
|
|
166
|
+
{
|
|
167
|
+
int flag = 0;
|
|
168
|
+
|
|
169
|
+
switch (argc-argstart) {
|
|
170
|
+
case 2:
|
|
171
|
+
CHECK_FIXNUM(argv[argstart]);
|
|
172
|
+
*limit = FIX2INT(argv[argstart]);
|
|
173
|
+
CHECK_WORKSPACE(argv[argstart+1]);
|
|
174
|
+
Data_Get_Struct(argv[argstart+1], gsl_integration_workspace, *w);
|
|
175
|
+
flag = 0;
|
|
176
|
+
break;
|
|
177
|
+
case 0:
|
|
178
|
+
*limit = LIMIT_DEFAULT;
|
|
179
|
+
*w = gsl_integration_workspace_alloc(*limit);
|
|
180
|
+
flag = 1;
|
|
181
|
+
break;
|
|
182
|
+
case 1:
|
|
183
|
+
switch (TYPE(argv[argstart])) {
|
|
184
|
+
case T_FIXNUM:
|
|
185
|
+
case T_BIGNUM:
|
|
186
|
+
CHECK_FIXNUM(argv[argstart]);
|
|
187
|
+
*limit = FIX2INT(argv[argstart]);
|
|
188
|
+
*w = gsl_integration_workspace_alloc(*limit);
|
|
189
|
+
flag = 1;
|
|
190
|
+
break;
|
|
191
|
+
default:
|
|
192
|
+
CHECK_WORKSPACE(argv[argc-1]);
|
|
193
|
+
Data_Get_Struct(argv[argc-1], gsl_integration_workspace, *w);
|
|
194
|
+
*limit = (*w)->limit;
|
|
195
|
+
flag = 0;
|
|
196
|
+
break;
|
|
197
|
+
}
|
|
198
|
+
break;
|
|
199
|
+
default:
|
|
200
|
+
rb_raise(rb_eArgError, "wrong number of arguments");
|
|
201
|
+
break;
|
|
202
|
+
}
|
|
203
|
+
if (*w == NULL) rb_raise(rb_eRuntimeError, "something wrong with workspace");
|
|
204
|
+
return flag;
|
|
205
|
+
}
|
|
206
|
+
|
|
207
|
+
static int get_epsabs_epsrel_limit_workspace(int argc, VALUE *argv, int argstart,
|
|
208
|
+
double *epsabs, double *epsrel,
|
|
209
|
+
size_t *limit,
|
|
210
|
+
gsl_integration_workspace **w)
|
|
211
|
+
{
|
|
212
|
+
int flag = 0, itmp;
|
|
213
|
+
itmp = argstart;
|
|
214
|
+
*epsabs = EPSABS_DEFAULT;
|
|
215
|
+
*epsrel = EPSREL_DEFAULT;
|
|
216
|
+
*limit = LIMIT_DEFAULT;
|
|
217
|
+
switch (argc-itmp) {
|
|
218
|
+
case 0:
|
|
219
|
+
*w = gsl_integration_workspace_alloc(*limit);
|
|
220
|
+
flag = 1;
|
|
221
|
+
break;
|
|
222
|
+
case 1:
|
|
223
|
+
if (TYPE(argv[itmp]) == T_ARRAY) {
|
|
224
|
+
get_epsabs_epsrel(argc, argv, itmp, epsabs, epsrel);
|
|
225
|
+
*w = gsl_integration_workspace_alloc(*limit);
|
|
226
|
+
flag = 1;
|
|
227
|
+
} else {
|
|
228
|
+
flag = get_limit_workspace(argc, argv, itmp, limit, w);
|
|
229
|
+
}
|
|
230
|
+
break;
|
|
231
|
+
case 2:
|
|
232
|
+
case 3:
|
|
233
|
+
switch (TYPE(argv[itmp])) {
|
|
234
|
+
case T_ARRAY:
|
|
235
|
+
itmp = get_epsabs_epsrel(argc, argv, itmp, epsabs, epsrel);
|
|
236
|
+
flag = get_limit_workspace(argc, argv, itmp, limit, w);
|
|
237
|
+
break;
|
|
238
|
+
case T_FLOAT:
|
|
239
|
+
get_epsabs_epsrel(argc, argv, itmp, epsabs, epsrel);
|
|
240
|
+
*w = gsl_integration_workspace_alloc(*limit);
|
|
241
|
+
flag = 1;
|
|
242
|
+
break;
|
|
243
|
+
default:
|
|
244
|
+
flag = get_limit_workspace(argc, argv, itmp, limit, w);
|
|
245
|
+
break;
|
|
246
|
+
}
|
|
247
|
+
break;
|
|
248
|
+
case 4:
|
|
249
|
+
itmp = get_epsabs_epsrel(argc, argv, itmp, epsabs, epsrel);
|
|
250
|
+
flag = get_limit_workspace(argc, argv, itmp, limit, w);
|
|
251
|
+
break;
|
|
252
|
+
default:
|
|
253
|
+
rb_raise(rb_eArgError, "wrong number of arguments");
|
|
254
|
+
break;
|
|
255
|
+
}
|
|
256
|
+
if (*w == NULL) rb_raise(rb_eRuntimeError, "something wrong with workspace");
|
|
257
|
+
return flag;
|
|
258
|
+
}
|
|
259
|
+
|
|
260
|
+
static VALUE rb_gsl_integration_qng(int argc, VALUE *argv, VALUE obj)
|
|
261
|
+
{
|
|
262
|
+
double a, b, epsabs = EPSABS_DEFAULT, epsrel = EPSREL_DEFAULT;
|
|
263
|
+
double result, abserr;
|
|
264
|
+
size_t neval;
|
|
265
|
+
gsl_function *F = NULL;
|
|
266
|
+
int status, itmp;
|
|
267
|
+
|
|
268
|
+
if (argc < 1) rb_raise(rb_eArgError,
|
|
269
|
+
"wrong number of arguments (%d for >= 1)", argc);
|
|
270
|
+
|
|
271
|
+
switch (TYPE(obj)) {
|
|
272
|
+
case T_MODULE: case T_CLASS: case T_OBJECT:
|
|
273
|
+
CHECK_FUNCTION(argv[0]);
|
|
274
|
+
Data_Get_Struct(argv[0], gsl_function, F);
|
|
275
|
+
itmp = get_a_b_epsabs_epsrel(argc, argv, 1, &a, &b, &epsabs, &epsrel);
|
|
276
|
+
break;
|
|
277
|
+
default:
|
|
278
|
+
itmp = get_a_b_epsabs_epsrel(argc, argv, 0, &a, &b, &epsabs, &epsrel);
|
|
279
|
+
Data_Get_Struct(obj, gsl_function, F);
|
|
280
|
+
break;
|
|
281
|
+
}
|
|
282
|
+
status = gsl_integration_qng(F, a, b, epsabs, epsrel,
|
|
283
|
+
&result, &abserr, &neval);
|
|
284
|
+
|
|
285
|
+
return rb_ary_new3(4, rb_float_new(result), rb_float_new(abserr),
|
|
286
|
+
INT2FIX(neval), INT2FIX(status));
|
|
287
|
+
}
|
|
288
|
+
|
|
289
|
+
static VALUE rb_gsl_integration_qag(int argc, VALUE *argv, VALUE obj)
|
|
290
|
+
{
|
|
291
|
+
double a, b, epsabs = EPSABS_DEFAULT, epsrel = EPSREL_DEFAULT;
|
|
292
|
+
double result, abserr;
|
|
293
|
+
size_t limit = LIMIT_DEFAULT;
|
|
294
|
+
gsl_function *F = NULL;
|
|
295
|
+
gsl_integration_workspace *w = NULL;
|
|
296
|
+
int key = KEY_DEFAULT, status, intervals, itmp, flag = 0;
|
|
297
|
+
if (argc < 1) rb_raise(rb_eArgError,
|
|
298
|
+
"wrong number of arguments (%d for >= 1)", argc);
|
|
299
|
+
|
|
300
|
+
switch (TYPE(obj)) {
|
|
301
|
+
case T_MODULE: case T_CLASS: case T_OBJECT:
|
|
302
|
+
CHECK_FUNCTION(argv[0]);
|
|
303
|
+
Data_Get_Struct(argv[0], gsl_function, F);
|
|
304
|
+
if (argc == 3) {
|
|
305
|
+
CHECK_FIXNUM(argv[2]);
|
|
306
|
+
get_a_b(argc, argv, 1, &a, &b);
|
|
307
|
+
key = FIX2INT(argv[2]);
|
|
308
|
+
w = gsl_integration_workspace_alloc(limit);
|
|
309
|
+
flag = 1;
|
|
310
|
+
} else if (argc == 4) {
|
|
311
|
+
CHECK_FIXNUM(argv[3]);
|
|
312
|
+
get_a_b(argc, argv, 1, &a, &b);
|
|
313
|
+
key = FIX2INT(argv[3]);
|
|
314
|
+
w = gsl_integration_workspace_alloc(limit);
|
|
315
|
+
flag = 1;
|
|
316
|
+
} else {
|
|
317
|
+
itmp = get_a_b_epsabs_epsrel(argc, argv, 1, &a, &b, &epsabs, &epsrel);
|
|
318
|
+
flag = get_limit_key_workspace(argc, argv, itmp, &limit, &key, &w);
|
|
319
|
+
}
|
|
320
|
+
break;
|
|
321
|
+
default:
|
|
322
|
+
if (argc == 2) {
|
|
323
|
+
if (FIXNUM_P(argv[1])) {
|
|
324
|
+
key = FIX2INT(argv[1]);
|
|
325
|
+
w = gsl_integration_workspace_alloc(limit);
|
|
326
|
+
flag = 1;
|
|
327
|
+
} else if (rb_obj_is_kind_of(argv[1], cgsl_integration_workspace)) {
|
|
328
|
+
Data_Get_Struct(argv[1], gsl_integration_workspace, w);
|
|
329
|
+
flag = 0;
|
|
330
|
+
} else {
|
|
331
|
+
rb_raise(rb_eTypeError, "Key or Workspace expected");
|
|
332
|
+
}
|
|
333
|
+
itmp = get_a_b(argc, argv, 0, &a, &b);
|
|
334
|
+
} else if (argc == 3) {
|
|
335
|
+
if (FIXNUM_P(argv[2])) {
|
|
336
|
+
key = FIX2INT(argv[2]);
|
|
337
|
+
w = gsl_integration_workspace_alloc(limit);
|
|
338
|
+
flag = 1;
|
|
339
|
+
} else if (rb_obj_is_kind_of(argv[2], cgsl_integration_workspace)) {
|
|
340
|
+
Data_Get_Struct(argv[2], gsl_integration_workspace, w);
|
|
341
|
+
flag = 0;
|
|
342
|
+
} else {
|
|
343
|
+
rb_raise(rb_eTypeError, "Key or Workspace expected");
|
|
344
|
+
}
|
|
345
|
+
itmp = get_a_b(argc, argv, 0, &a, &b);
|
|
346
|
+
} else {
|
|
347
|
+
itmp = get_a_b_epsabs_epsrel(argc, argv, 0, &a, &b, &epsabs, &epsrel);
|
|
348
|
+
flag = get_limit_key_workspace(argc, argv, itmp, &limit, &key, &w);
|
|
349
|
+
}
|
|
350
|
+
Data_Get_Struct(obj, gsl_function, F);
|
|
351
|
+
break;
|
|
352
|
+
}
|
|
353
|
+
status = gsl_integration_qag(F, a, b, epsabs, epsrel, limit, key, w,
|
|
354
|
+
&result, &abserr);
|
|
355
|
+
intervals = w->size;
|
|
356
|
+
if (flag == 1) gsl_integration_workspace_free(w);
|
|
357
|
+
|
|
358
|
+
return rb_ary_new3(4, rb_float_new(result), rb_float_new(abserr),
|
|
359
|
+
INT2FIX(intervals), INT2FIX(status));
|
|
360
|
+
}
|
|
361
|
+
|
|
362
|
+
static VALUE rb_gsl_integration_qags(int argc, VALUE *argv, VALUE obj)
|
|
363
|
+
{
|
|
364
|
+
double a, b, epsabs = EPSABS_DEFAULT, epsrel = EPSREL_DEFAULT;
|
|
365
|
+
double result, abserr;
|
|
366
|
+
size_t limit = LIMIT_DEFAULT;
|
|
367
|
+
gsl_function *F = NULL;
|
|
368
|
+
gsl_integration_workspace *w = NULL;
|
|
369
|
+
int status, intervals, flag = 0, itmp;
|
|
370
|
+
switch (TYPE(obj)) {
|
|
371
|
+
case T_MODULE: case T_CLASS: case T_OBJECT:
|
|
372
|
+
CHECK_FUNCTION(argv[0]);
|
|
373
|
+
Data_Get_Struct(argv[0], gsl_function, F);
|
|
374
|
+
itmp = get_a_b(argc, argv, 1, &a, &b);
|
|
375
|
+
break;
|
|
376
|
+
default:
|
|
377
|
+
Data_Get_Struct(obj, gsl_function, F);
|
|
378
|
+
itmp = get_a_b(argc, argv, 0, &a, &b);
|
|
379
|
+
break;
|
|
380
|
+
}
|
|
381
|
+
flag = get_epsabs_epsrel_limit_workspace(argc, argv, itmp, &epsabs, &epsrel,
|
|
382
|
+
&limit, &w);
|
|
383
|
+
|
|
384
|
+
status = gsl_integration_qags(F, a, b, epsabs, epsrel, limit, w,
|
|
385
|
+
&result, &abserr);
|
|
386
|
+
intervals = w->size;
|
|
387
|
+
if (flag == 1) gsl_integration_workspace_free(w);
|
|
388
|
+
|
|
389
|
+
return rb_ary_new3(4, rb_float_new(result), rb_float_new(abserr),
|
|
390
|
+
INT2FIX(intervals), INT2FIX(status));
|
|
391
|
+
}
|
|
392
|
+
|
|
393
|
+
static VALUE rb_gsl_integration_qagp(int argc, VALUE *argv, VALUE obj)
|
|
394
|
+
{
|
|
395
|
+
double epsabs, epsrel;
|
|
396
|
+
double result, abserr;
|
|
397
|
+
size_t limit;
|
|
398
|
+
gsl_function *F = NULL;
|
|
399
|
+
gsl_vector *v = NULL;
|
|
400
|
+
gsl_integration_workspace *w = NULL;
|
|
401
|
+
int status, intervals, flag = 0, flag2 = 0, itmp;
|
|
402
|
+
switch (TYPE(obj)) {
|
|
403
|
+
case T_MODULE: case T_CLASS: case T_OBJECT:
|
|
404
|
+
CHECK_FUNCTION(argv[0]);
|
|
405
|
+
Data_Get_Struct(argv[0], gsl_function, F);
|
|
406
|
+
itmp = 1;
|
|
407
|
+
break;
|
|
408
|
+
default:
|
|
409
|
+
Data_Get_Struct(obj, gsl_function, F);
|
|
410
|
+
itmp = 0;
|
|
411
|
+
break;
|
|
412
|
+
}
|
|
413
|
+
if (TYPE(argv[itmp]) == T_ARRAY) {
|
|
414
|
+
v = make_cvector_from_rarray(argv[itmp]);
|
|
415
|
+
flag2 = 1;
|
|
416
|
+
} else {
|
|
417
|
+
Data_Get_Vector(argv[itmp], v);
|
|
418
|
+
flag2 = 0;
|
|
419
|
+
}
|
|
420
|
+
itmp += 1;
|
|
421
|
+
flag = get_epsabs_epsrel_limit_workspace(argc, argv, itmp, &epsabs, &epsrel,
|
|
422
|
+
&limit, &w);
|
|
423
|
+
|
|
424
|
+
status = gsl_integration_qagp(F, v->data, v->size, epsabs, epsrel, limit, w,
|
|
425
|
+
&result, &abserr);
|
|
426
|
+
intervals = w->size;
|
|
427
|
+
if (flag == 1) gsl_integration_workspace_free(w);
|
|
428
|
+
if (flag2 == 1) gsl_vector_free(v);
|
|
429
|
+
|
|
430
|
+
return rb_ary_new3(4, rb_float_new(result), rb_float_new(abserr),
|
|
431
|
+
INT2FIX(intervals), INT2FIX(status));
|
|
432
|
+
}
|
|
433
|
+
|
|
434
|
+
/* (-infty --- +infty) */
|
|
435
|
+
static VALUE rb_gsl_integration_qagi(int argc, VALUE *argv, VALUE obj)
|
|
436
|
+
{
|
|
437
|
+
double epsabs, epsrel;
|
|
438
|
+
double result, abserr;
|
|
439
|
+
size_t limit;
|
|
440
|
+
gsl_function *F = NULL;
|
|
441
|
+
gsl_integration_workspace *w = NULL;
|
|
442
|
+
int status, intervals, flag = 0, itmp;
|
|
443
|
+
switch (TYPE(obj)) {
|
|
444
|
+
case T_MODULE: case T_CLASS: case T_OBJECT:
|
|
445
|
+
CHECK_FUNCTION(argv[0]);
|
|
446
|
+
Data_Get_Struct(argv[0], gsl_function, F);
|
|
447
|
+
itmp = 1;
|
|
448
|
+
break;
|
|
449
|
+
default:
|
|
450
|
+
Data_Get_Struct(obj, gsl_function, F);
|
|
451
|
+
itmp = 0;
|
|
452
|
+
break;
|
|
453
|
+
}
|
|
454
|
+
flag = get_epsabs_epsrel_limit_workspace(argc, argv, itmp, &epsabs, &epsrel,
|
|
455
|
+
&limit, &w);
|
|
456
|
+
status = gsl_integration_qagi(F, epsabs, epsrel, limit, w,
|
|
457
|
+
&result, &abserr);
|
|
458
|
+
intervals = w->size;
|
|
459
|
+
if (flag == 1) gsl_integration_workspace_free(w);
|
|
460
|
+
|
|
461
|
+
return rb_ary_new3(4, rb_float_new(result), rb_float_new(abserr),
|
|
462
|
+
INT2FIX(intervals), INT2FIX(status));
|
|
463
|
+
}
|
|
464
|
+
|
|
465
|
+
/* (a --- +infty) */
|
|
466
|
+
static VALUE rb_gsl_integration_qagiu(int argc, VALUE *argv, VALUE obj)
|
|
467
|
+
{
|
|
468
|
+
double a, epsabs, epsrel;
|
|
469
|
+
double result, abserr;
|
|
470
|
+
size_t limit;
|
|
471
|
+
gsl_function *F = NULL;
|
|
472
|
+
gsl_integration_workspace *w = NULL;
|
|
473
|
+
int status, intervals, flag = 0, itmp;
|
|
474
|
+
switch (TYPE(obj)) {
|
|
475
|
+
case T_MODULE: case T_CLASS: case T_OBJECT:
|
|
476
|
+
CHECK_FUNCTION(argv[0]);
|
|
477
|
+
Data_Get_Struct(argv[0], gsl_function, F);
|
|
478
|
+
itmp = 1;
|
|
479
|
+
break;
|
|
480
|
+
default:
|
|
481
|
+
Data_Get_Struct(obj, gsl_function, F);
|
|
482
|
+
itmp = 0;
|
|
483
|
+
break;
|
|
484
|
+
}
|
|
485
|
+
Need_Float(argv[itmp]);
|
|
486
|
+
a = NUM2DBL(argv[itmp]);
|
|
487
|
+
itmp += 1;
|
|
488
|
+
flag = get_epsabs_epsrel_limit_workspace(argc, argv, itmp, &epsabs, &epsrel,
|
|
489
|
+
&limit, &w);
|
|
490
|
+
status = gsl_integration_qagiu(F, a, epsabs, epsrel, limit, w,
|
|
491
|
+
&result, &abserr);
|
|
492
|
+
intervals = w->size;
|
|
493
|
+
if (flag == 1) gsl_integration_workspace_free(w);
|
|
494
|
+
|
|
495
|
+
return rb_ary_new3(4, rb_float_new(result), rb_float_new(abserr),
|
|
496
|
+
INT2FIX(intervals), INT2FIX(status));
|
|
497
|
+
}
|
|
498
|
+
|
|
499
|
+
/* (-infty --- b) */
|
|
500
|
+
static VALUE rb_gsl_integration_qagil(int argc, VALUE *argv, VALUE obj)
|
|
501
|
+
{
|
|
502
|
+
double b, epsabs, epsrel;
|
|
503
|
+
double result, abserr;
|
|
504
|
+
size_t limit;
|
|
505
|
+
gsl_function *F = NULL;
|
|
506
|
+
gsl_integration_workspace *w = NULL;
|
|
507
|
+
int status, intervals, flag = 0, itmp;
|
|
508
|
+
switch (TYPE(obj)) {
|
|
509
|
+
case T_MODULE: case T_CLASS: case T_OBJECT:
|
|
510
|
+
CHECK_FUNCTION(argv[0]);
|
|
511
|
+
Data_Get_Struct(argv[0], gsl_function, F);
|
|
512
|
+
itmp = 1;
|
|
513
|
+
break;
|
|
514
|
+
default:
|
|
515
|
+
Data_Get_Struct(obj, gsl_function, F);
|
|
516
|
+
itmp = 0;
|
|
517
|
+
break;
|
|
518
|
+
}
|
|
519
|
+
Need_Float(argv[itmp]);
|
|
520
|
+
b = NUM2DBL(argv[itmp]);
|
|
521
|
+
flag = get_epsabs_epsrel_limit_workspace(argc, argv, itmp+1, &epsabs, &epsrel,
|
|
522
|
+
&limit, &w);
|
|
523
|
+
Data_Get_Struct(obj, gsl_function, F);
|
|
524
|
+
|
|
525
|
+
status = gsl_integration_qagil(F, b, epsabs, epsrel, limit, w,
|
|
526
|
+
&result, &abserr);
|
|
527
|
+
intervals = w->size;
|
|
528
|
+
if (flag == 1) gsl_integration_workspace_free(w);
|
|
529
|
+
|
|
530
|
+
return rb_ary_new3(4, rb_float_new(result), rb_float_new(abserr),
|
|
531
|
+
INT2FIX(intervals), INT2FIX(status));
|
|
532
|
+
}
|
|
533
|
+
|
|
534
|
+
static VALUE rb_gsl_integration_qawc(int argc, VALUE *argv, VALUE obj)
|
|
535
|
+
{
|
|
536
|
+
double a, b, c, epsabs, epsrel;
|
|
537
|
+
double result, abserr;
|
|
538
|
+
size_t limit;
|
|
539
|
+
gsl_function *F = NULL;
|
|
540
|
+
gsl_integration_workspace *w = NULL;
|
|
541
|
+
int status, intervals, itmp, flag = 0;
|
|
542
|
+
switch (TYPE(obj)) {
|
|
543
|
+
case T_MODULE: case T_CLASS: case T_OBJECT:
|
|
544
|
+
CHECK_FUNCTION(argv[0]);
|
|
545
|
+
Data_Get_Struct(argv[0], gsl_function, F);
|
|
546
|
+
itmp = 1;
|
|
547
|
+
break;
|
|
548
|
+
default:
|
|
549
|
+
Data_Get_Struct(obj, gsl_function, F);
|
|
550
|
+
itmp = 0;
|
|
551
|
+
break;
|
|
552
|
+
}
|
|
553
|
+
itmp = get_a_b(argc, argv, itmp, &a, &b);
|
|
554
|
+
if (argc-itmp <= 0) rb_raise(rb_eArgError, "The pole is not given");
|
|
555
|
+
Need_Float(argv[itmp]);
|
|
556
|
+
c = NUM2DBL(argv[itmp]);
|
|
557
|
+
flag = get_epsabs_epsrel_limit_workspace(argc, argv, itmp+1, &epsabs, &epsrel,
|
|
558
|
+
&limit, &w);
|
|
559
|
+
status = gsl_integration_qawc(F, a, b, c, epsabs, epsrel, limit, w, &result, &abserr);
|
|
560
|
+
intervals = w->size;
|
|
561
|
+
if (flag == 1) gsl_integration_workspace_free(w);
|
|
562
|
+
|
|
563
|
+
return rb_ary_new3(4, rb_float_new(result), rb_float_new(abserr), INT2FIX(intervals),
|
|
564
|
+
INT2FIX(status));
|
|
565
|
+
}
|
|
566
|
+
|
|
567
|
+
VALUE rb_gsl_integration_qaws_table_alloc(int argc, VALUE *argv, VALUE klass)
|
|
568
|
+
{
|
|
569
|
+
gsl_integration_qaws_table *t = NULL;
|
|
570
|
+
VALUE alpha, beta, mu, nu;
|
|
571
|
+
|
|
572
|
+
if (TYPE(argv[0]) == T_ARRAY) {
|
|
573
|
+
alpha = rb_ary_entry(argv[0], 0);
|
|
574
|
+
beta = rb_ary_entry(argv[0], 1);
|
|
575
|
+
mu = rb_ary_entry(argv[0], 2);
|
|
576
|
+
nu = rb_ary_entry(argv[0], 3);
|
|
577
|
+
} else {
|
|
578
|
+
Need_Float(argv[0]); Need_Float(argv[1]);
|
|
579
|
+
CHECK_FIXNUM(argv[2]); CHECK_FIXNUM(argv[3]);
|
|
580
|
+
alpha = argv[0];
|
|
581
|
+
beta = argv[1];
|
|
582
|
+
mu = argv[2];
|
|
583
|
+
nu = argv[3];
|
|
584
|
+
}
|
|
585
|
+
t = gsl_integration_qaws_table_alloc(NUM2DBL(alpha), NUM2DBL(beta),
|
|
586
|
+
FIX2INT(mu), FIX2INT(nu));
|
|
587
|
+
return Data_Wrap_Struct(klass, 0, gsl_integration_qaws_table_free, t);
|
|
588
|
+
}
|
|
589
|
+
|
|
590
|
+
static VALUE rb_gsl_integration_qaws_table_set(int argc, VALUE *argv, VALUE obj)
|
|
591
|
+
{
|
|
592
|
+
gsl_integration_qaws_table *t = NULL;
|
|
593
|
+
double alpha, beta;
|
|
594
|
+
int mu, nu, type;
|
|
595
|
+
if (argc != 1 && argc != 4)
|
|
596
|
+
rb_raise(rb_eArgError, "wrong number of argument (%d for 1 or 3)", argc);
|
|
597
|
+
type = TYPE(argv[0]);
|
|
598
|
+
Data_Get_Struct(obj, gsl_integration_qaws_table, t);
|
|
599
|
+
|
|
600
|
+
if (type == T_FIXNUM || type == T_BIGNUM || type == T_FLOAT) {
|
|
601
|
+
alpha = NUM2DBL(argv[0]);
|
|
602
|
+
beta = NUM2DBL(argv[1]);
|
|
603
|
+
mu = FIX2INT(argv[2]);
|
|
604
|
+
nu = FIX2INT(argv[3]);
|
|
605
|
+
} else if (type == T_ARRAY) {
|
|
606
|
+
alpha = NUM2DBL(rb_ary_entry(argv[0], 0));
|
|
607
|
+
beta = NUM2DBL(rb_ary_entry(argv[0], 1));
|
|
608
|
+
mu = FIX2INT(rb_ary_entry(argv[0], 2));
|
|
609
|
+
nu = FIX2INT(rb_ary_entry(argv[0], 3));
|
|
610
|
+
} else {
|
|
611
|
+
rb_raise(rb_eTypeError, "wrong argument type %s", rb_class2name(CLASS_OF(argv[0])));
|
|
612
|
+
}
|
|
613
|
+
|
|
614
|
+
gsl_integration_qaws_table_set(t, alpha, beta, mu, nu);
|
|
615
|
+
return obj;
|
|
616
|
+
}
|
|
617
|
+
|
|
618
|
+
static VALUE rb_gsl_integration_qaws_table_to_a(VALUE obj)
|
|
619
|
+
{
|
|
620
|
+
gsl_integration_qaws_table *t = NULL;
|
|
621
|
+
VALUE ary;
|
|
622
|
+
Data_Get_Struct(obj, gsl_integration_qaws_table, t);
|
|
623
|
+
ary = rb_ary_new2(4);
|
|
624
|
+
rb_ary_store(ary, 0, rb_float_new(t->alpha));
|
|
625
|
+
rb_ary_store(ary, 1, rb_float_new(t->beta));
|
|
626
|
+
rb_ary_store(ary, 2, INT2FIX(t->mu));
|
|
627
|
+
rb_ary_store(ary, 3, INT2FIX(t->nu));
|
|
628
|
+
return ary;
|
|
629
|
+
}
|
|
630
|
+
|
|
631
|
+
static gsl_integration_qaws_table* make_qaws_table(VALUE ary);
|
|
632
|
+
static VALUE rb_gsl_ary_to_integration_qaws_table(VALUE ary)
|
|
633
|
+
{
|
|
634
|
+
gsl_integration_qaws_table *t = NULL;
|
|
635
|
+
t = make_qaws_table(ary);
|
|
636
|
+
return Data_Wrap_Struct(cgsl_integration_qaws_table,
|
|
637
|
+
0, gsl_integration_qaws_table_free, t);
|
|
638
|
+
}
|
|
639
|
+
|
|
640
|
+
static gsl_integration_qaws_table* make_qaws_table(VALUE ary)
|
|
641
|
+
{
|
|
642
|
+
double alpha, beta;
|
|
643
|
+
int mu, nu;
|
|
644
|
+
alpha = NUM2DBL(rb_ary_entry(ary, 0));
|
|
645
|
+
beta = NUM2DBL(rb_ary_entry(ary, 1));
|
|
646
|
+
mu = FIX2INT(rb_ary_entry(ary, 2));
|
|
647
|
+
nu = FIX2INT(rb_ary_entry(ary, 3));
|
|
648
|
+
return gsl_integration_qaws_table_alloc(alpha, beta, mu, nu);
|
|
649
|
+
}
|
|
650
|
+
|
|
651
|
+
static VALUE rb_gsl_integration_qaws(int argc, VALUE *argv, VALUE obj)
|
|
652
|
+
{
|
|
653
|
+
double a, b, epsabs, epsrel;
|
|
654
|
+
double result, abserr;
|
|
655
|
+
size_t limit;
|
|
656
|
+
gsl_function *F = NULL;
|
|
657
|
+
gsl_integration_workspace *w = NULL;
|
|
658
|
+
gsl_integration_qaws_table *t = NULL;
|
|
659
|
+
int status, intervals, itmp, flag = 0, flagt = 0;
|
|
660
|
+
switch (TYPE(obj)) {
|
|
661
|
+
case T_MODULE: case T_CLASS: case T_OBJECT:
|
|
662
|
+
if (argc < 2) rb_raise(rb_eArgError, "too few arguments");
|
|
663
|
+
CHECK_FUNCTION(argv[0]);
|
|
664
|
+
Data_Get_Struct(argv[0], gsl_function, F);
|
|
665
|
+
itmp = 1;
|
|
666
|
+
break;
|
|
667
|
+
default:
|
|
668
|
+
if (argc < 1) rb_raise(rb_eArgError, "too few arguments");
|
|
669
|
+
Data_Get_Struct(obj, gsl_function, F);
|
|
670
|
+
itmp = 0;
|
|
671
|
+
break;
|
|
672
|
+
}
|
|
673
|
+
itmp = get_a_b(argc, argv, itmp, &a, &b);
|
|
674
|
+
|
|
675
|
+
if (TYPE(argv[itmp]) == T_ARRAY) {
|
|
676
|
+
flagt = 1;
|
|
677
|
+
t = make_qaws_table(argv[itmp]);
|
|
678
|
+
} else {
|
|
679
|
+
flagt = 0;
|
|
680
|
+
if (!rb_obj_is_kind_of(argv[itmp], cgsl_integration_qaws_table))
|
|
681
|
+
rb_raise(rb_eTypeError, "Integration::QAWS_Table expected");
|
|
682
|
+
|
|
683
|
+
Data_Get_Struct(argv[itmp], gsl_integration_qaws_table, t);
|
|
684
|
+
}
|
|
685
|
+
flag = get_epsabs_epsrel_limit_workspace(argc, argv, itmp+1, &epsabs, &epsrel,
|
|
686
|
+
&limit, &w);
|
|
687
|
+
status = gsl_integration_qaws(F, a, b, t, epsabs, epsrel, limit, w, &result, &abserr);
|
|
688
|
+
intervals = w->size;
|
|
689
|
+
if (flag == 1) gsl_integration_workspace_free(w);
|
|
690
|
+
if (flagt == 1) gsl_integration_qaws_table_free(t);
|
|
691
|
+
|
|
692
|
+
return rb_ary_new3(4, rb_float_new(result), rb_float_new(abserr), INT2FIX(intervals),
|
|
693
|
+
INT2FIX(status));
|
|
694
|
+
}
|
|
695
|
+
|
|
696
|
+
static gsl_integration_qawo_table* make_qawo_table(VALUE ary);
|
|
697
|
+
|
|
698
|
+
static VALUE rb_gsl_integration_qawo_table_alloc(int argc, VALUE *argv,
|
|
699
|
+
VALUE klass)
|
|
700
|
+
{
|
|
701
|
+
gsl_integration_qawo_table *t = NULL;
|
|
702
|
+
double omega, L;
|
|
703
|
+
enum gsl_integration_qawo_enum sine;
|
|
704
|
+
size_t n;
|
|
705
|
+
if (argc != 1 && argc != 4)
|
|
706
|
+
rb_raise(rb_eArgError, "wrong nubmer of arguments (%d for 1 or 4)", argc);
|
|
707
|
+
|
|
708
|
+
if (TYPE(argv[0]) == T_ARRAY) {
|
|
709
|
+
omega = NUM2DBL(rb_ary_entry(argv[0], 0));
|
|
710
|
+
L = NUM2DBL(rb_ary_entry(argv[0], 1));
|
|
711
|
+
sine = FIX2INT(rb_ary_entry(argv[0], 2));
|
|
712
|
+
n = FIX2INT(rb_ary_entry(argv[0], 3));
|
|
713
|
+
} else {
|
|
714
|
+
omega = NUM2DBL(argv[0]);
|
|
715
|
+
L = NUM2DBL(argv[1]);
|
|
716
|
+
sine = FIX2INT(argv[2]);
|
|
717
|
+
n = FIX2INT(argv[3]);
|
|
718
|
+
}
|
|
719
|
+
|
|
720
|
+
t = gsl_integration_qawo_table_alloc(omega, L, sine, n);
|
|
721
|
+
|
|
722
|
+
return Data_Wrap_Struct(klass, 0, gsl_integration_qawo_table_free, t);
|
|
723
|
+
}
|
|
724
|
+
|
|
725
|
+
static VALUE rb_gsl_integration_qawo_table_to_a(VALUE obj)
|
|
726
|
+
{
|
|
727
|
+
gsl_integration_qawo_table *t = NULL;
|
|
728
|
+
VALUE ary;
|
|
729
|
+
Data_Get_Struct(obj, gsl_integration_qawo_table, t);
|
|
730
|
+
ary = rb_ary_new2(4);
|
|
731
|
+
rb_ary_store(ary, 0, rb_float_new(t->omega));
|
|
732
|
+
rb_ary_store(ary, 1, rb_float_new(t->L));
|
|
733
|
+
rb_ary_store(ary, 2, INT2FIX(t->sine));
|
|
734
|
+
rb_ary_store(ary, 3, INT2FIX(t->n));
|
|
735
|
+
return ary;
|
|
736
|
+
}
|
|
737
|
+
|
|
738
|
+
static VALUE rb_gsl_ary_to_integration_qawo_table(VALUE ary)
|
|
739
|
+
{
|
|
740
|
+
gsl_integration_qawo_table *t = NULL;
|
|
741
|
+
t = make_qawo_table(ary);
|
|
742
|
+
return Data_Wrap_Struct(cgsl_integration_qawo_table,
|
|
743
|
+
0, gsl_integration_qawo_table_free, t);
|
|
744
|
+
}
|
|
745
|
+
|
|
746
|
+
static gsl_integration_qawo_table* make_qawo_table(VALUE ary)
|
|
747
|
+
{
|
|
748
|
+
double omega, L;
|
|
749
|
+
enum gsl_integration_qawo_enum sine;
|
|
750
|
+
size_t n;
|
|
751
|
+
omega = NUM2DBL(rb_ary_entry(ary, 0));
|
|
752
|
+
L = NUM2DBL(rb_ary_entry(ary, 1));
|
|
753
|
+
sine = FIX2INT(rb_ary_entry(ary, 2));
|
|
754
|
+
n = FIX2INT(rb_ary_entry(ary, 3));
|
|
755
|
+
return gsl_integration_qawo_table_alloc(omega, L, sine, n);
|
|
756
|
+
}
|
|
757
|
+
|
|
758
|
+
static VALUE rb_gsl_integration_qawo_table_set(int argc, VALUE *argv, VALUE obj)
|
|
759
|
+
{
|
|
760
|
+
gsl_integration_qawo_table *t = NULL;
|
|
761
|
+
double omega, L;
|
|
762
|
+
enum gsl_integration_qawo_enum sine;
|
|
763
|
+
int type;
|
|
764
|
+
if (argc != 1 && argc != 3)
|
|
765
|
+
rb_raise(rb_eArgError, "wrong number of argument (%d for 1 or 3)", argc);
|
|
766
|
+
type = TYPE(argv[0]);
|
|
767
|
+
Data_Get_Struct(obj, gsl_integration_qawo_table, t);
|
|
768
|
+
if (type == T_FIXNUM || type == T_BIGNUM || type == T_FLOAT) {
|
|
769
|
+
omega = NUM2DBL(argv[0]);
|
|
770
|
+
L = NUM2DBL(argv[1]);
|
|
771
|
+
sine = FIX2INT(argv[2]);
|
|
772
|
+
} else if (type == T_ARRAY) {
|
|
773
|
+
omega = NUM2DBL(rb_ary_entry(argv[0], 0));
|
|
774
|
+
L = NUM2DBL(rb_ary_entry(argv[0], 1));
|
|
775
|
+
sine = FIX2INT(rb_ary_entry(argv[0], 2));
|
|
776
|
+
} else {
|
|
777
|
+
rb_raise(rb_eTypeError, "wrong argument type %s", rb_class2name(CLASS_OF(argv[0])));
|
|
778
|
+
}
|
|
779
|
+
gsl_integration_qawo_table_set(t, omega, L, sine);
|
|
780
|
+
return obj;
|
|
781
|
+
}
|
|
782
|
+
|
|
783
|
+
static VALUE rb_gsl_integration_qawo_table_set_length(VALUE obj, VALUE L)
|
|
784
|
+
{
|
|
785
|
+
gsl_integration_qawo_table *t = NULL;
|
|
786
|
+
Need_Float(L);
|
|
787
|
+
Data_Get_Struct(obj, gsl_integration_qawo_table, t);
|
|
788
|
+
gsl_integration_qawo_table_set_length(t, NUM2DBL(L));
|
|
789
|
+
return obj;
|
|
790
|
+
}
|
|
791
|
+
|
|
792
|
+
static int get_qawo_table(VALUE tt, gsl_integration_qawo_table **t);
|
|
793
|
+
|
|
794
|
+
static VALUE rb_gsl_integration_qawo(int argc, VALUE *argv, VALUE obj)
|
|
795
|
+
{
|
|
796
|
+
double a, epsabs, epsrel;
|
|
797
|
+
double result, abserr;
|
|
798
|
+
size_t limit;
|
|
799
|
+
gsl_function *F = NULL;
|
|
800
|
+
gsl_integration_workspace *w = NULL;
|
|
801
|
+
gsl_integration_qawo_table *t = NULL;
|
|
802
|
+
int status, intervals, itmp, flag = 0, flagt = 0;
|
|
803
|
+
switch (TYPE(obj)) {
|
|
804
|
+
case T_MODULE: case T_CLASS: case T_OBJECT:
|
|
805
|
+
if (argc < 2) rb_raise(rb_eArgError, "too few arguments");
|
|
806
|
+
CHECK_FUNCTION(argv[0]);
|
|
807
|
+
Data_Get_Struct(argv[0], gsl_function, F);
|
|
808
|
+
itmp = 1;
|
|
809
|
+
break;
|
|
810
|
+
default:
|
|
811
|
+
if (argc < 1) rb_raise(rb_eArgError, "too few arguments");
|
|
812
|
+
Data_Get_Struct(obj, gsl_function, F);
|
|
813
|
+
itmp = 0;
|
|
814
|
+
break;
|
|
815
|
+
}
|
|
816
|
+
Need_Float(argv[itmp]);
|
|
817
|
+
a = NUM2DBL(argv[itmp]);
|
|
818
|
+
flagt = get_qawo_table(argv[argc-1], &t);
|
|
819
|
+
flag = get_epsabs_epsrel_limit_workspace(argc-1, argv, itmp+1, &epsabs, &epsrel,
|
|
820
|
+
&limit, &w);
|
|
821
|
+
status = gsl_integration_qawo(F, a, epsabs, epsrel, limit, w, t, &result, &abserr);
|
|
822
|
+
intervals = w->size;
|
|
823
|
+
if (flag == 1) gsl_integration_workspace_free(w);
|
|
824
|
+
if (flagt == 1) gsl_integration_qawo_table_free(t);
|
|
825
|
+
|
|
826
|
+
return rb_ary_new3(4, rb_float_new(result), rb_float_new(abserr), INT2FIX(intervals),
|
|
827
|
+
INT2FIX(status));
|
|
828
|
+
}
|
|
829
|
+
|
|
830
|
+
static int get_qawo_table(VALUE tt,
|
|
831
|
+
gsl_integration_qawo_table **t)
|
|
832
|
+
{
|
|
833
|
+
int flagt;
|
|
834
|
+
|
|
835
|
+
if (TYPE(tt) == T_ARRAY) {
|
|
836
|
+
flagt = 1;
|
|
837
|
+
*t = make_qawo_table(tt);
|
|
838
|
+
} else {
|
|
839
|
+
flagt = 0;
|
|
840
|
+
if (!rb_obj_is_kind_of(tt, cgsl_integration_qawo_table))
|
|
841
|
+
rb_raise(rb_eTypeError, "Integration::QAWO_Table expected");
|
|
842
|
+
Data_Get_Struct(tt, gsl_integration_qawo_table, *t);
|
|
843
|
+
}
|
|
844
|
+
return flagt;
|
|
845
|
+
}
|
|
846
|
+
|
|
847
|
+
static VALUE rb_gsl_integration_qawf(int argc, VALUE *argv, VALUE obj)
|
|
848
|
+
{
|
|
849
|
+
double a, epsabs = EPSREL_DEFAULT;
|
|
850
|
+
double result, abserr;
|
|
851
|
+
size_t limit = LIMIT_DEFAULT;
|
|
852
|
+
gsl_function *F = NULL;
|
|
853
|
+
gsl_integration_workspace *w = NULL, *cw = NULL;
|
|
854
|
+
gsl_integration_qawo_table *t = NULL;
|
|
855
|
+
int status, intervals, flag = 0, flagt = 0, itmp;
|
|
856
|
+
VALUE *vtmp;
|
|
857
|
+
switch (TYPE(obj)) {
|
|
858
|
+
case T_MODULE: case T_CLASS: case T_OBJECT:
|
|
859
|
+
if (argc < 2) rb_raise(rb_eArgError, "too few arguments");
|
|
860
|
+
CHECK_FUNCTION(argv[0]);
|
|
861
|
+
Data_Get_Struct(argv[0], gsl_function, F);
|
|
862
|
+
itmp = 1;
|
|
863
|
+
break;
|
|
864
|
+
default:
|
|
865
|
+
if (argc < 1) rb_raise(rb_eArgError, "too few arguments");
|
|
866
|
+
Data_Get_Struct(obj, gsl_function, F);
|
|
867
|
+
itmp = 0;
|
|
868
|
+
break;
|
|
869
|
+
}
|
|
870
|
+
Need_Float(argv[itmp]);
|
|
871
|
+
a = NUM2DBL(argv[itmp]);
|
|
872
|
+
itmp += 1;
|
|
873
|
+
if (TYPE(argv[itmp]) == T_FLOAT) {
|
|
874
|
+
epsabs = NUM2DBL(argv[itmp]);
|
|
875
|
+
itmp += 1;
|
|
876
|
+
}
|
|
877
|
+
vtmp = argv + itmp;
|
|
878
|
+
flagt = get_qawo_table(argv[argc-1], &t);
|
|
879
|
+
|
|
880
|
+
switch (argc - 1 - itmp) {
|
|
881
|
+
case 0:
|
|
882
|
+
w = gsl_integration_workspace_alloc(limit);
|
|
883
|
+
cw = gsl_integration_workspace_alloc(limit);
|
|
884
|
+
flag = 1;
|
|
885
|
+
break;
|
|
886
|
+
case 1:
|
|
887
|
+
CHECK_FIXNUM(vtmp[0]);
|
|
888
|
+
limit = FIX2INT(vtmp[0]);
|
|
889
|
+
w = gsl_integration_workspace_alloc(limit);
|
|
890
|
+
cw = gsl_integration_workspace_alloc(limit);
|
|
891
|
+
flag = 1;
|
|
892
|
+
break;
|
|
893
|
+
case 2:
|
|
894
|
+
CHECK_WORKSPACE(vtmp[0]); CHECK_WORKSPACE(vtmp[1]);
|
|
895
|
+
Data_Get_Struct(vtmp[0], gsl_integration_workspace, w);
|
|
896
|
+
Data_Get_Struct(vtmp[1], gsl_integration_workspace, cw);
|
|
897
|
+
flag = 0;
|
|
898
|
+
break;
|
|
899
|
+
case 3:
|
|
900
|
+
CHECK_FIXNUM(vtmp[0]);
|
|
901
|
+
CHECK_WORKSPACE(vtmp[1]); CHECK_WORKSPACE(vtmp[2]);
|
|
902
|
+
limit = FIX2INT(vtmp[0]);
|
|
903
|
+
Data_Get_Struct(vtmp[1], gsl_integration_workspace, w);
|
|
904
|
+
Data_Get_Struct(vtmp[2], gsl_integration_workspace, cw);
|
|
905
|
+
flag = 0;
|
|
906
|
+
break;
|
|
907
|
+
default:
|
|
908
|
+
rb_raise(rb_eArgError, "wrong number of arguments");
|
|
909
|
+
break;
|
|
910
|
+
}
|
|
911
|
+
|
|
912
|
+
status = gsl_integration_qawf(F, a, epsabs, limit, w, cw, t, &result, &abserr);
|
|
913
|
+
intervals = w->size;
|
|
914
|
+
if (flag == 1) {
|
|
915
|
+
gsl_integration_workspace_free(w);
|
|
916
|
+
gsl_integration_workspace_free(cw);
|
|
917
|
+
}
|
|
918
|
+
if (flagt == 1) gsl_integration_qawo_table_free(t);
|
|
919
|
+
|
|
920
|
+
return rb_ary_new3(4, rb_float_new(result), rb_float_new(abserr),
|
|
921
|
+
INT2FIX(intervals), INT2FIX(status));
|
|
922
|
+
}
|
|
923
|
+
|
|
924
|
+
|
|
925
|
+
static void rb_gsl_integration_define_symbols(VALUE module)
|
|
926
|
+
{
|
|
927
|
+
rb_define_const(module, "GAUSS15", INT2FIX(GSL_INTEG_GAUSS15));
|
|
928
|
+
rb_define_const(module, "GAUSS21", INT2FIX(GSL_INTEG_GAUSS21));
|
|
929
|
+
rb_define_const(module, "GAUSS31", INT2FIX(GSL_INTEG_GAUSS31));
|
|
930
|
+
rb_define_const(module, "GAUSS41", INT2FIX(GSL_INTEG_GAUSS41));
|
|
931
|
+
rb_define_const(module, "GAUSS51", INT2FIX(GSL_INTEG_GAUSS51));
|
|
932
|
+
rb_define_const(module, "GAUSS61", INT2FIX(GSL_INTEG_GAUSS61));
|
|
933
|
+
rb_define_const(module, "COSINE", INT2FIX(GSL_INTEG_COSINE));
|
|
934
|
+
rb_define_const(module, "SINE", INT2FIX(GSL_INTEG_SINE));
|
|
935
|
+
}
|
|
936
|
+
|
|
937
|
+
static VALUE rb_gsl_integration_workspace_alloc(int argc, VALUE *argv,
|
|
938
|
+
VALUE klass)
|
|
939
|
+
{
|
|
940
|
+
size_t limit;
|
|
941
|
+
if (argc == 1) limit = FIX2INT(argv[0]);
|
|
942
|
+
else limit = LIMIT_DEFAULT;
|
|
943
|
+
return Data_Wrap_Struct(klass, 0,
|
|
944
|
+
gsl_integration_workspace_free,
|
|
945
|
+
gsl_integration_workspace_alloc(limit));
|
|
946
|
+
}
|
|
947
|
+
|
|
948
|
+
static VALUE rb_gsl_integration_workspace_limit(VALUE obj)
|
|
949
|
+
{
|
|
950
|
+
gsl_integration_workspace *w = NULL;
|
|
951
|
+
Data_Get_Struct(obj, gsl_integration_workspace, w);
|
|
952
|
+
return INT2FIX(w->limit);
|
|
953
|
+
}
|
|
954
|
+
|
|
955
|
+
static VALUE rb_gsl_integration_workspace_size(VALUE obj)
|
|
956
|
+
{
|
|
957
|
+
gsl_integration_workspace *w = NULL;
|
|
958
|
+
Data_Get_Struct(obj, gsl_integration_workspace, w);
|
|
959
|
+
return INT2FIX(w->size);
|
|
960
|
+
}
|
|
961
|
+
|
|
962
|
+
static VALUE rb_gsl_integration_workspace_nrmax(VALUE obj)
|
|
963
|
+
{
|
|
964
|
+
gsl_integration_workspace *w = NULL;
|
|
965
|
+
Data_Get_Struct(obj, gsl_integration_workspace, w);
|
|
966
|
+
return INT2FIX(w->nrmax);
|
|
967
|
+
}
|
|
968
|
+
|
|
969
|
+
static VALUE rb_gsl_integration_workspace_i(VALUE obj)
|
|
970
|
+
{
|
|
971
|
+
gsl_integration_workspace *w = NULL;
|
|
972
|
+
Data_Get_Struct(obj, gsl_integration_workspace, w);
|
|
973
|
+
return INT2FIX(w->i);
|
|
974
|
+
}
|
|
975
|
+
|
|
976
|
+
static VALUE rb_gsl_integration_workspace_maximum_level(VALUE obj)
|
|
977
|
+
{
|
|
978
|
+
gsl_integration_workspace *w = NULL;
|
|
979
|
+
Data_Get_Struct(obj, gsl_integration_workspace, w);
|
|
980
|
+
return INT2FIX(w->maximum_level);
|
|
981
|
+
}
|
|
982
|
+
|
|
983
|
+
static VALUE rb_gsl_integration_workspace_to_a(VALUE obj)
|
|
984
|
+
{
|
|
985
|
+
gsl_integration_workspace *w = NULL;
|
|
986
|
+
Data_Get_Struct(obj, gsl_integration_workspace, w);
|
|
987
|
+
return rb_ary_new3(5, INT2FIX(w->limit), INT2FIX(w->size), INT2FIX(w->nrmax),
|
|
988
|
+
INT2FIX(w->i), INT2FIX(w->maximum_level));
|
|
989
|
+
}
|
|
990
|
+
|
|
991
|
+
static VALUE rb_gsl_integration_workspace_alist(VALUE obj)
|
|
992
|
+
{
|
|
993
|
+
gsl_integration_workspace *w = NULL;
|
|
994
|
+
gsl_vector_view *v = NULL;
|
|
995
|
+
Data_Get_Struct(obj, gsl_integration_workspace, w);
|
|
996
|
+
v = rb_gsl_make_vector_view(w->alist, w->limit, 1);
|
|
997
|
+
return Data_Wrap_Struct(cgsl_vector_view_ro, 0, free, v);
|
|
998
|
+
}
|
|
999
|
+
|
|
1000
|
+
static VALUE rb_gsl_integration_workspace_blist(VALUE obj)
|
|
1001
|
+
{
|
|
1002
|
+
gsl_integration_workspace *w = NULL;
|
|
1003
|
+
gsl_vector_view *v = NULL;
|
|
1004
|
+
|
|
1005
|
+
Data_Get_Struct(obj, gsl_integration_workspace, w);
|
|
1006
|
+
v = rb_gsl_make_vector_view(w->blist, w->limit, 1);
|
|
1007
|
+
return Data_Wrap_Struct(cgsl_vector_view_ro, 0, free, v);
|
|
1008
|
+
}
|
|
1009
|
+
|
|
1010
|
+
static VALUE rb_gsl_integration_workspace_rlist(VALUE obj)
|
|
1011
|
+
{
|
|
1012
|
+
gsl_integration_workspace *w = NULL;
|
|
1013
|
+
gsl_vector_view *v = NULL;
|
|
1014
|
+
Data_Get_Struct(obj, gsl_integration_workspace, w);
|
|
1015
|
+
v = rb_gsl_make_vector_view(w->rlist, w->limit, 1);
|
|
1016
|
+
return Data_Wrap_Struct(cgsl_vector_view_ro, 0, free, v);
|
|
1017
|
+
}
|
|
1018
|
+
|
|
1019
|
+
static VALUE rb_gsl_integration_workspace_elist(VALUE obj)
|
|
1020
|
+
{
|
|
1021
|
+
gsl_integration_workspace *w = NULL;
|
|
1022
|
+
gsl_vector_view *v = NULL;
|
|
1023
|
+
Data_Get_Struct(obj, gsl_integration_workspace, w);
|
|
1024
|
+
v = rb_gsl_make_vector_view(w->elist, w->limit, 1);
|
|
1025
|
+
return Data_Wrap_Struct(cgsl_vector_view_ro, 0, free, v);
|
|
1026
|
+
}
|
|
1027
|
+
|
|
1028
|
+
void Init_gsl_integration(VALUE module)
|
|
1029
|
+
{
|
|
1030
|
+
VALUE mgsl_integ;
|
|
1031
|
+
|
|
1032
|
+
mgsl_integ = rb_define_module_under(module, "Integration");
|
|
1033
|
+
rb_gsl_integration_define_symbols(mgsl_integ);
|
|
1034
|
+
|
|
1035
|
+
rb_define_method(cgsl_function, "integration_qng", rb_gsl_integration_qng, -1);
|
|
1036
|
+
rb_define_method(cgsl_function, "integration_qag", rb_gsl_integration_qag, -1);
|
|
1037
|
+
rb_define_method(cgsl_function, "integration_qags", rb_gsl_integration_qags, -1);
|
|
1038
|
+
rb_define_method(cgsl_function, "integration_qagp", rb_gsl_integration_qagp, -1);
|
|
1039
|
+
rb_define_method(cgsl_function, "integration_qagi", rb_gsl_integration_qagi, -1);
|
|
1040
|
+
rb_define_method(cgsl_function, "integration_qagiu", rb_gsl_integration_qagiu, -1);
|
|
1041
|
+
rb_define_method(cgsl_function, "integration_qagil", rb_gsl_integration_qagil, -1);
|
|
1042
|
+
rb_define_method(cgsl_function, "integration_qawc", rb_gsl_integration_qawc, -1);
|
|
1043
|
+
rb_define_alias(cgsl_function, "qng", "integration_qng");
|
|
1044
|
+
rb_define_alias(cgsl_function, "qag", "integration_qag");
|
|
1045
|
+
rb_define_alias(cgsl_function, "qags", "integration_qags");
|
|
1046
|
+
rb_define_alias(cgsl_function, "qagp", "integration_qagp");
|
|
1047
|
+
rb_define_alias(cgsl_function, "qagi", "integration_qagi");
|
|
1048
|
+
rb_define_alias(cgsl_function, "qagiu", "integration_qagiu");
|
|
1049
|
+
rb_define_alias(cgsl_function, "qagil", "integration_qagil");
|
|
1050
|
+
rb_define_alias(cgsl_function, "qawc", "integration_qawc");
|
|
1051
|
+
|
|
1052
|
+
cgsl_integration_qaws_table = rb_define_class_under(mgsl_integ, "QAWS_Table",
|
|
1053
|
+
cGSL_Object);
|
|
1054
|
+
rb_define_singleton_method(cgsl_integration_qaws_table, "alloc",
|
|
1055
|
+
rb_gsl_integration_qaws_table_alloc, -1);
|
|
1056
|
+
/* rb_define_singleton_method(cgsl_integration_qaws_table, "new",
|
|
1057
|
+
rb_gsl_integration_qaws_table_alloc, -1);*/
|
|
1058
|
+
rb_define_method(cgsl_integration_qaws_table, "to_a",
|
|
1059
|
+
rb_gsl_integration_qaws_table_to_a, 0);
|
|
1060
|
+
rb_define_method(cgsl_integration_qaws_table, "set",
|
|
1061
|
+
rb_gsl_integration_qaws_table_set, -1);
|
|
1062
|
+
rb_define_method(rb_cArray, "to_gsl_integration_qaws_table",
|
|
1063
|
+
rb_gsl_ary_to_integration_qaws_table, 0);
|
|
1064
|
+
rb_define_alias(rb_cArray, "to_qaws_table", "to_gsl_integration_qaws_table");
|
|
1065
|
+
rb_define_method(cgsl_function, "integration_qaws", rb_gsl_integration_qaws, -1);
|
|
1066
|
+
rb_define_alias(cgsl_function, "qaws", "integration_qaws");
|
|
1067
|
+
|
|
1068
|
+
cgsl_integration_qawo_table = rb_define_class_under(mgsl_integ, "QAWO_Table",
|
|
1069
|
+
cGSL_Object);
|
|
1070
|
+
rb_define_singleton_method(cgsl_integration_qawo_table, "alloc",
|
|
1071
|
+
rb_gsl_integration_qawo_table_alloc, -1);
|
|
1072
|
+
/* rb_define_singleton_method(cgsl_integration_qawo_table, "new",
|
|
1073
|
+
rb_gsl_integration_qawo_table_alloc, -1);*/
|
|
1074
|
+
rb_define_method(cgsl_integration_qawo_table, "to_a",
|
|
1075
|
+
rb_gsl_integration_qawo_table_to_a, 0);
|
|
1076
|
+
rb_define_method(rb_cArray, "to_gsl_integration_qawo_table",
|
|
1077
|
+
rb_gsl_ary_to_integration_qawo_table, 0);
|
|
1078
|
+
rb_define_method(cgsl_integration_qawo_table, "set",
|
|
1079
|
+
rb_gsl_integration_qawo_table_set, -1);
|
|
1080
|
+
rb_define_method(cgsl_integration_qawo_table, "set_length",
|
|
1081
|
+
rb_gsl_integration_qawo_table_set_length, 1);
|
|
1082
|
+
rb_define_method(cgsl_function, "integration_qawo", rb_gsl_integration_qawo, -1);
|
|
1083
|
+
rb_define_method(cgsl_function, "integration_qawf", rb_gsl_integration_qawf, -1);
|
|
1084
|
+
rb_define_alias(cgsl_function, "qawo", "integration_qawo");
|
|
1085
|
+
rb_define_alias(cgsl_function, "qawf", "integration_qawf");
|
|
1086
|
+
|
|
1087
|
+
cgsl_integration_workspace = rb_define_class_under(mgsl_integ,
|
|
1088
|
+
"Workspace", cGSL_Object);
|
|
1089
|
+
|
|
1090
|
+
/* rb_define_singleton_method(cgsl_integration_workspace, "new",
|
|
1091
|
+
rb_gsl_integration_workspace_alloc, -1);*/
|
|
1092
|
+
rb_define_singleton_method(cgsl_integration_workspace, "alloc",
|
|
1093
|
+
rb_gsl_integration_workspace_alloc, -1);
|
|
1094
|
+
|
|
1095
|
+
rb_define_method(cgsl_integration_workspace, "limit",
|
|
1096
|
+
rb_gsl_integration_workspace_limit, 0);
|
|
1097
|
+
rb_define_method(cgsl_integration_workspace, "size",
|
|
1098
|
+
rb_gsl_integration_workspace_size, 0);
|
|
1099
|
+
rb_define_method(cgsl_integration_workspace, "nrmax",
|
|
1100
|
+
rb_gsl_integration_workspace_nrmax, 0);
|
|
1101
|
+
rb_define_method(cgsl_integration_workspace, "i",
|
|
1102
|
+
rb_gsl_integration_workspace_i, 0);
|
|
1103
|
+
rb_define_method(cgsl_integration_workspace, "maximum_level",
|
|
1104
|
+
rb_gsl_integration_workspace_maximum_level, 0);
|
|
1105
|
+
rb_define_method(cgsl_integration_workspace, "to_a",
|
|
1106
|
+
rb_gsl_integration_workspace_to_a, 0);
|
|
1107
|
+
rb_define_method(cgsl_integration_workspace, "alist",
|
|
1108
|
+
rb_gsl_integration_workspace_alist, 0);
|
|
1109
|
+
rb_define_method(cgsl_integration_workspace, "blist",
|
|
1110
|
+
rb_gsl_integration_workspace_blist, 0);
|
|
1111
|
+
rb_define_method(cgsl_integration_workspace, "rlist",
|
|
1112
|
+
rb_gsl_integration_workspace_rlist, 0);
|
|
1113
|
+
rb_define_method(cgsl_integration_workspace, "elist",
|
|
1114
|
+
rb_gsl_integration_workspace_elist, 0);
|
|
1115
|
+
|
|
1116
|
+
/*****/
|
|
1117
|
+
rb_define_module_function(mgsl_integ, "qng", rb_gsl_integration_qng, -1);
|
|
1118
|
+
rb_define_module_function(mgsl_integ, "qag", rb_gsl_integration_qag, -1);
|
|
1119
|
+
rb_define_module_function(mgsl_integ, "qags", rb_gsl_integration_qags, -1);
|
|
1120
|
+
rb_define_module_function(mgsl_integ, "qagp", rb_gsl_integration_qagp, -1);
|
|
1121
|
+
rb_define_module_function(mgsl_integ, "qagi", rb_gsl_integration_qagi, -1);
|
|
1122
|
+
rb_define_module_function(mgsl_integ, "qagiu", rb_gsl_integration_qagiu, -1);
|
|
1123
|
+
rb_define_module_function(mgsl_integ, "qagil", rb_gsl_integration_qagil, -1);
|
|
1124
|
+
rb_define_module_function(mgsl_integ, "qawc", rb_gsl_integration_qawc, -1);
|
|
1125
|
+
rb_define_module_function(mgsl_integ, "qaws", rb_gsl_integration_qaws, -1);
|
|
1126
|
+
rb_define_module_function(mgsl_integ, "qawo", rb_gsl_integration_qawo, -1);
|
|
1127
|
+
rb_define_module_function(mgsl_integ, "qawf", rb_gsl_integration_qawf, -1);
|
|
1128
|
+
}
|
|
1129
|
+
|
|
1130
|
+
#undef EPSABS_DEFAULT
|
|
1131
|
+
#undef EPSREL_DEFAULT
|
|
1132
|
+
#undef LIMIT_DEFAULT
|
|
1133
|
+
#undef KEY_DEFAULT
|
|
1134
|
+
|
|
1135
|
+
#ifdef CHECK_WORKSPACE
|
|
1136
|
+
#undef CHECK_WORKSPACE
|
|
1137
|
+
#endif
|
|
1138
|
+
|