gsl 1.12.108

Sign up to get free protection for your applications and to get access to all the features.
Files changed (158) hide show
  1. data/README.rdoc +29 -0
  2. data/Rakefile +54 -0
  3. data/VERSION +2 -0
  4. data/ext/MANIFEST +119 -0
  5. data/ext/alf.c +206 -0
  6. data/ext/array.c +666 -0
  7. data/ext/array_complex.c +247 -0
  8. data/ext/blas.c +29 -0
  9. data/ext/blas1.c +731 -0
  10. data/ext/blas2.c +1093 -0
  11. data/ext/blas3.c +881 -0
  12. data/ext/block.c +44 -0
  13. data/ext/block_source.c +886 -0
  14. data/ext/bspline.c +130 -0
  15. data/ext/bundle.c +3 -0
  16. data/ext/cdf.c +754 -0
  17. data/ext/cheb.c +542 -0
  18. data/ext/combination.c +283 -0
  19. data/ext/common.c +325 -0
  20. data/ext/complex.c +1004 -0
  21. data/ext/const.c +673 -0
  22. data/ext/const_additional.c +120 -0
  23. data/ext/cqp.c +283 -0
  24. data/ext/deriv.c +195 -0
  25. data/ext/dht.c +361 -0
  26. data/ext/diff.c +166 -0
  27. data/ext/dirac.c +395 -0
  28. data/ext/eigen.c +2373 -0
  29. data/ext/error.c +194 -0
  30. data/ext/extconf.rb +281 -0
  31. data/ext/fcmp.c +66 -0
  32. data/ext/fft.c +1092 -0
  33. data/ext/fit.c +205 -0
  34. data/ext/fresnel.c +312 -0
  35. data/ext/function.c +524 -0
  36. data/ext/geometry.c +139 -0
  37. data/ext/graph.c +1638 -0
  38. data/ext/gsl.c +271 -0
  39. data/ext/gsl_narray.c +653 -0
  40. data/ext/histogram.c +1995 -0
  41. data/ext/histogram2d.c +1068 -0
  42. data/ext/histogram3d.c +884 -0
  43. data/ext/histogram3d_source.c +750 -0
  44. data/ext/histogram_find.c +101 -0
  45. data/ext/histogram_oper.c +159 -0
  46. data/ext/ieee.c +98 -0
  47. data/ext/integration.c +1138 -0
  48. data/ext/interp.c +512 -0
  49. data/ext/jacobi.c +739 -0
  50. data/ext/linalg.c +4047 -0
  51. data/ext/linalg_complex.c +741 -0
  52. data/ext/math.c +725 -0
  53. data/ext/matrix.c +39 -0
  54. data/ext/matrix_complex.c +1732 -0
  55. data/ext/matrix_double.c +560 -0
  56. data/ext/matrix_int.c +256 -0
  57. data/ext/matrix_source.c +2733 -0
  58. data/ext/min.c +250 -0
  59. data/ext/monte.c +992 -0
  60. data/ext/multifit.c +1879 -0
  61. data/ext/multimin.c +808 -0
  62. data/ext/multimin_fsdf.c +156 -0
  63. data/ext/multiroots.c +955 -0
  64. data/ext/ndlinear.c +321 -0
  65. data/ext/nmf.c +167 -0
  66. data/ext/nmf_wrap.c +72 -0
  67. data/ext/ntuple.c +469 -0
  68. data/ext/odeiv.c +959 -0
  69. data/ext/ool.c +879 -0
  70. data/ext/oper_complex_source.c +253 -0
  71. data/ext/permutation.c +596 -0
  72. data/ext/poly.c +42 -0
  73. data/ext/poly2.c +265 -0
  74. data/ext/poly_source.c +1885 -0
  75. data/ext/qrng.c +171 -0
  76. data/ext/randist.c +1873 -0
  77. data/ext/rational.c +480 -0
  78. data/ext/rng.c +612 -0
  79. data/ext/root.c +408 -0
  80. data/ext/sf.c +1494 -0
  81. data/ext/sf_airy.c +200 -0
  82. data/ext/sf_bessel.c +867 -0
  83. data/ext/sf_clausen.c +28 -0
  84. data/ext/sf_coulomb.c +206 -0
  85. data/ext/sf_coupling.c +118 -0
  86. data/ext/sf_dawson.c +29 -0
  87. data/ext/sf_debye.c +157 -0
  88. data/ext/sf_dilog.c +42 -0
  89. data/ext/sf_elementary.c +44 -0
  90. data/ext/sf_ellint.c +206 -0
  91. data/ext/sf_elljac.c +29 -0
  92. data/ext/sf_erfc.c +93 -0
  93. data/ext/sf_exp.c +164 -0
  94. data/ext/sf_expint.c +211 -0
  95. data/ext/sf_fermi_dirac.c +148 -0
  96. data/ext/sf_gamma.c +344 -0
  97. data/ext/sf_gegenbauer.c +96 -0
  98. data/ext/sf_hyperg.c +197 -0
  99. data/ext/sf_laguerre.c +112 -0
  100. data/ext/sf_lambert.c +47 -0
  101. data/ext/sf_legendre.c +367 -0
  102. data/ext/sf_log.c +104 -0
  103. data/ext/sf_mathieu.c +238 -0
  104. data/ext/sf_power.c +46 -0
  105. data/ext/sf_psi.c +98 -0
  106. data/ext/sf_synchrotron.c +48 -0
  107. data/ext/sf_transport.c +76 -0
  108. data/ext/sf_trigonometric.c +207 -0
  109. data/ext/sf_zeta.c +119 -0
  110. data/ext/signal.c +310 -0
  111. data/ext/siman.c +718 -0
  112. data/ext/sort.c +208 -0
  113. data/ext/spline.c +395 -0
  114. data/ext/stats.c +799 -0
  115. data/ext/sum.c +168 -0
  116. data/ext/tamu_anova.c +56 -0
  117. data/ext/tensor.c +38 -0
  118. data/ext/tensor_source.c +1123 -0
  119. data/ext/vector.c +38 -0
  120. data/ext/vector_complex.c +2236 -0
  121. data/ext/vector_double.c +1433 -0
  122. data/ext/vector_int.c +204 -0
  123. data/ext/vector_source.c +3329 -0
  124. data/ext/wavelet.c +937 -0
  125. data/include/rb_gsl.h +151 -0
  126. data/include/rb_gsl_array.h +238 -0
  127. data/include/rb_gsl_cheb.h +21 -0
  128. data/include/rb_gsl_common.h +343 -0
  129. data/include/rb_gsl_complex.h +25 -0
  130. data/include/rb_gsl_const.h +29 -0
  131. data/include/rb_gsl_dirac.h +13 -0
  132. data/include/rb_gsl_eigen.h +17 -0
  133. data/include/rb_gsl_fft.h +62 -0
  134. data/include/rb_gsl_fit.h +25 -0
  135. data/include/rb_gsl_function.h +27 -0
  136. data/include/rb_gsl_graph.h +70 -0
  137. data/include/rb_gsl_histogram.h +63 -0
  138. data/include/rb_gsl_histogram3d.h +97 -0
  139. data/include/rb_gsl_integration.h +17 -0
  140. data/include/rb_gsl_interp.h +46 -0
  141. data/include/rb_gsl_linalg.h +25 -0
  142. data/include/rb_gsl_math.h +26 -0
  143. data/include/rb_gsl_odeiv.h +21 -0
  144. data/include/rb_gsl_poly.h +71 -0
  145. data/include/rb_gsl_rational.h +37 -0
  146. data/include/rb_gsl_rng.h +21 -0
  147. data/include/rb_gsl_root.h +22 -0
  148. data/include/rb_gsl_sf.h +119 -0
  149. data/include/rb_gsl_statistics.h +17 -0
  150. data/include/rb_gsl_tensor.h +45 -0
  151. data/include/rb_gsl_with_narray.h +22 -0
  152. data/include/templates_off.h +87 -0
  153. data/include/templates_on.h +241 -0
  154. data/lib/gsl/gnuplot.rb +41 -0
  155. data/lib/gsl/oper.rb +68 -0
  156. data/lib/ool.rb +22 -0
  157. data/lib/ool/conmin.rb +30 -0
  158. metadata +224 -0
@@ -0,0 +1,156 @@
1
+ #ifdef HAVE_GSL_GSL_MULTIMIN_FSDF_H
2
+ #include "rb_gsl.h"
3
+ #include "gsl/gsl_multimin_fsdf.h"
4
+
5
+ static VALUE cfsdf;
6
+ #ifndef CHECK_MULTIMIN_FUNCTION_FSDF
7
+ #define CHECK_MULTIMIN_FUNCTION_FSDF(x) if(CLASS_OF(x)!=cfsdf)\
8
+ rb_raise(rb_eTypeError,\
9
+ "wrong argument type %s (GSL::MultiMin::Function_fsdf expected)",\
10
+ rb_class2name(CLASS_OF(x)));
11
+ #endif
12
+ extern VALUE cgsl_multimin_function_fdf;
13
+
14
+ static const gsl_multimin_fsdfminimizer_type* get_fsdfminimizer_type(VALUE t)
15
+ {
16
+ char name[64];
17
+ switch (TYPE(t)) {
18
+ case T_STRING:
19
+ strcpy(name, STR2CSTR(t));
20
+ if (strcmp(name, "bundle") == 0 || strcmp(name, "bundle_method") == 0)
21
+ return gsl_multimin_fsdfminimizer_bundle_method;
22
+ else
23
+ rb_raise(rb_eTypeError, "%s: unknown minimizer type", name);
24
+ break;
25
+ default:
26
+ rb_raise(rb_eTypeError, "type is given by a String or a Fixnum");
27
+ break;
28
+ }
29
+ }
30
+
31
+ static VALUE rb_gsl_fsdfminimizer_alloc(VALUE klass, VALUE t, VALUE n)
32
+ {
33
+ gsl_multimin_fsdfminimizer *gmf = NULL;
34
+ const gsl_multimin_fsdfminimizer_type *T;
35
+ T = get_fsdfminimizer_type(t);
36
+ gmf = gsl_multimin_fsdfminimizer_alloc(T, FIX2INT(n));
37
+ return Data_Wrap_Struct(klass, 0, gsl_multimin_fsdfminimizer_free, gmf);
38
+ }
39
+
40
+ static VALUE rb_gsl_fsdfminimizer_set(VALUE obj, VALUE ff, VALUE xx, VALUE ss)
41
+ {
42
+ gsl_multimin_fsdfminimizer *gmf = NULL;
43
+ gsl_multimin_function_fsdf *F = NULL;
44
+ gsl_vector *x;
45
+ size_t bundle_size;
46
+ int status;
47
+ CHECK_MULTIMIN_FUNCTION_FSDF(ff);
48
+ Data_Get_Struct(obj, gsl_multimin_fsdfminimizer, gmf);
49
+ Data_Get_Struct(ff, gsl_multimin_function_fsdf, F);
50
+ Data_Get_Vector(xx, x);
51
+ bundle_size = (size_t) FIX2INT(ss);
52
+ status = gsl_multimin_fsdfminimizer_set(gmf, F, x, bundle_size);
53
+ return INT2FIX(status);
54
+ }
55
+
56
+ static VALUE rb_gsl_fsdfminimizer_name(VALUE obj)
57
+ {
58
+ gsl_multimin_fsdfminimizer *gmf = NULL;
59
+ Data_Get_Struct(obj, gsl_multimin_fsdfminimizer, gmf);
60
+ return rb_str_new2(gsl_multimin_fsdfminimizer_name(gmf));
61
+ }
62
+
63
+ static VALUE rb_gsl_fsdfminimizer_iterate(VALUE obj)
64
+ {
65
+ gsl_multimin_fsdfminimizer *gmf = NULL;
66
+ Data_Get_Struct(obj, gsl_multimin_fsdfminimizer, gmf);
67
+ return INT2FIX(gsl_multimin_fsdfminimizer_iterate(gmf));
68
+ }
69
+
70
+ static VALUE rb_gsl_fsdfminimizer_x(VALUE obj)
71
+ {
72
+ gsl_multimin_fsdfminimizer *gmf = NULL;
73
+ gsl_vector *x = NULL;
74
+ Data_Get_Struct(obj, gsl_multimin_fsdfminimizer, gmf);
75
+ x = gsl_multimin_fsdfminimizer_x(gmf);
76
+ return Data_Wrap_Struct(cgsl_vector_view_ro, 0, NULL, x);
77
+ }
78
+
79
+ static VALUE rb_gsl_fsdfminimizer_subgradient(VALUE obj)
80
+ {
81
+ gsl_multimin_fsdfminimizer *gmf = NULL;
82
+ gsl_vector *gradient = NULL;
83
+ Data_Get_Struct(obj, gsl_multimin_fsdfminimizer, gmf);
84
+ gradient = gsl_multimin_fsdfminimizer_subgradient(gmf);
85
+ return Data_Wrap_Struct(cgsl_vector_view_ro, 0, NULL, gradient);
86
+ }
87
+
88
+ static VALUE rb_gsl_fsdfminimizer_minimum(VALUE obj)
89
+ {
90
+ gsl_multimin_fsdfminimizer *gmf = NULL;
91
+ double min;
92
+ Data_Get_Struct(obj, gsl_multimin_fsdfminimizer, gmf);
93
+ min = gsl_multimin_fsdfminimizer_minimum(gmf);
94
+ return rb_float_new(min);
95
+ }
96
+
97
+ static VALUE rb_gsl_fsdfminimizer_f(VALUE obj)
98
+ {
99
+ gsl_multimin_fsdfminimizer *gmf = NULL;
100
+ Data_Get_Struct(obj, gsl_multimin_fsdfminimizer, gmf);
101
+ return rb_float_new(gmf->f);
102
+ }
103
+
104
+ static VALUE rb_gsl_fsdfminimizer_restart(VALUE obj)
105
+ {
106
+ gsl_multimin_fsdfminimizer *gmf = NULL;
107
+ Data_Get_Struct(obj, gsl_multimin_fsdfminimizer, gmf);
108
+ return INT2FIX(gsl_multimin_fsdfminimizer_restart(gmf));
109
+ }
110
+
111
+ static VALUE rb_gsl_fsdfminimizer_test_gradient(VALUE obj, VALUE ea)
112
+ {
113
+ gsl_multimin_fsdfminimizer *gmf = NULL;
114
+ gsl_vector *g = NULL;
115
+ Need_Float(ea);
116
+ Data_Get_Struct(obj, gsl_multimin_fsdfminimizer, gmf);
117
+ g = gsl_multimin_fsdfminimizer_subgradient(gmf);
118
+ return INT2FIX(gsl_multimin_test_gradient(g, NUM2DBL(ea)));
119
+ }
120
+
121
+ static VALUE rb_gsl_fsdfminimizer_test_convergence(VALUE obj, VALUE eps)
122
+ {
123
+ gsl_multimin_fsdfminimizer *gmf = NULL;
124
+ Data_Get_Struct(obj, gsl_multimin_fsdfminimizer, gmf);
125
+ return INT2FIX(gsl_multimin_test_convergence(gmf, NUM2DBL(eps)));
126
+ }
127
+
128
+ static VALUE rb_gsl_fsdfminimizer_eps(VALUE obj)
129
+ {
130
+ gsl_multimin_fsdfminimizer *gmf = NULL;
131
+ Data_Get_Struct(obj, gsl_multimin_fsdfminimizer, gmf);
132
+ return rb_float_new(gmf->eps);
133
+ }
134
+
135
+ void Init_multimin_fsdf(VALUE module)
136
+ {
137
+ VALUE cmin;
138
+
139
+ cmin = rb_define_class_under(module, "FsdfMinimizer", cGSL_Object);
140
+ cfsdf = rb_define_class_under(module, "Function_fsdf", cgsl_multimin_function_fdf);
141
+
142
+ rb_define_singleton_method(cmin, "alloc", rb_gsl_fsdfminimizer_alloc, 2);
143
+ rb_define_method(cmin, "set", rb_gsl_fsdfminimizer_set, 3);
144
+ rb_define_method(cmin, "name", rb_gsl_fsdfminimizer_name, 0);
145
+ rb_define_method(cmin, "iterate", rb_gsl_fsdfminimizer_iterate, 0);
146
+ rb_define_method(cmin, "x", rb_gsl_fsdfminimizer_x, 0);
147
+ rb_define_method(cmin, "f", rb_gsl_fsdfminimizer_f, 0);
148
+ rb_define_method(cmin, "subgradient", rb_gsl_fsdfminimizer_subgradient, 0);
149
+ rb_define_method(cmin, "minimum", rb_gsl_fsdfminimizer_minimum, 0);
150
+ rb_define_method(cmin, "restart", rb_gsl_fsdfminimizer_restart, 0);
151
+ rb_define_method(cmin, "test_gradient", rb_gsl_fsdfminimizer_test_gradient, 1);
152
+ rb_define_method(cmin, "test_convergence", rb_gsl_fsdfminimizer_test_convergence, 1);
153
+ rb_define_method(cmin, "eps", rb_gsl_fsdfminimizer_eps, 0);
154
+ }
155
+
156
+ #endif
@@ -0,0 +1,955 @@
1
+ /*
2
+ multiroots.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
+ #include "rb_gsl.h"
12
+ #include "rb_gsl_common.h"
13
+ #include "rb_gsl_array.h"
14
+ #include "rb_gsl_function.h"
15
+ #include <gsl/gsl_multiroots.h>
16
+
17
+ #ifndef CHECK_MULTIROOT_FUNCTION
18
+ #define CHECK_MULTIROOT_FUNCTION(x) if(CLASS_OF(x)!=cgsl_multiroot_function)\
19
+ rb_raise(rb_eTypeError,\
20
+ "wrong argument type %s (GSL::MultiRoot::Function expected)",\
21
+ rb_class2name(CLASS_OF(x)));
22
+ #endif
23
+
24
+ #ifndef CHECK_MULTIROOT_FUNCTION_FDF
25
+ #define CHECK_MULTIROOT_FUNCTION_FDF(x) if(CLASS_OF(x)!=cgsl_multiroot_function_fdf)\
26
+ rb_raise(rb_eTypeError,\
27
+ "wrong argument type %s (GSL::MultiRoot::Function_fdf expected)",\
28
+ rb_class2name(CLASS_OF(x)));
29
+ #endif
30
+
31
+ static VALUE cgsl_multiroot_function;
32
+ static VALUE cgsl_multiroot_function_fdf;
33
+
34
+ enum {
35
+ GSL_MULTIROOT_FDFSOLVER_HYBRIDSJ,
36
+ GSL_MULTIROOT_FDFSOLVER_HYBRIDJ,
37
+ GSL_MULTIROOT_FDFSOLVER_NEWTON,
38
+ GSL_MULTIROOT_FDFSOLVER_GNEWTON,
39
+ GSL_MULTIROOT_FSOLVER_HYBRIDS,
40
+ GSL_MULTIROOT_FSOLVER_HYBRID,
41
+ GSL_MULTIROOT_FSOLVER_DNEWTON,
42
+ GSL_MULTIROOT_FSOLVER_BROYDEN,
43
+ };
44
+
45
+ static void gsl_multiroot_function_fdf_mark(gsl_multiroot_function_fdf *f);
46
+ static void gsl_multiroot_function_mark(gsl_multiroot_function *f);
47
+ static void gsl_multiroot_function_free(gsl_multiroot_function *f);
48
+ static int rb_gsl_multiroot_function_f(const gsl_vector *x, void *p, gsl_vector *f);
49
+ static void set_function(int i, VALUE *argv, gsl_multiroot_function *F);
50
+
51
+ static void gsl_multiroot_function_fdf_free(gsl_multiroot_function_fdf *f);
52
+ static int rb_gsl_multiroot_function_fdf_f(const gsl_vector *x, void *p,
53
+ gsl_vector *f);
54
+ static int rb_gsl_multiroot_function_fdf_df(const gsl_vector *x, void *p,
55
+ gsl_matrix *J);
56
+ static int rb_gsl_multiroot_function_fdf_fdf(const gsl_vector *x, void *p,
57
+ gsl_vector *f, gsl_matrix *J);
58
+ static void set_function_fdf(int i, VALUE *argv, gsl_multiroot_function_fdf *F);
59
+ static const gsl_multiroot_fsolver_type* get_fsolver_type(VALUE t);
60
+ static const gsl_multiroot_fdfsolver_type* get_fdfsolver_type(VALUE t);
61
+
62
+ static VALUE rb_gsl_multiroot_function_new(int argc, VALUE *argv, VALUE klass)
63
+ {
64
+ gsl_multiroot_function *F = NULL;
65
+ VALUE ary;
66
+ size_t i;
67
+ F = ALLOC(gsl_multiroot_function);
68
+ F->f = &rb_gsl_multiroot_function_f;
69
+ ary = rb_ary_new2(2);
70
+ /* (VALUE) F->params = ary;*/
71
+ F->params = (void *) ary;
72
+ if (rb_block_given_p()) rb_ary_store(ary, 0, RB_GSL_MAKE_PROC);
73
+ else rb_ary_store(ary, 0, Qnil);
74
+ rb_ary_store(ary, 1, Qnil);
75
+ switch (argc) {
76
+ case 0:
77
+ break;
78
+ case 1:
79
+ set_function(0, argv, F);
80
+ break;
81
+ case 2:
82
+ case 3:
83
+ for (i = 0; i < argc; i++) set_function(i, argv, F);
84
+ break;
85
+ default:
86
+ rb_raise(rb_eArgError, "wrong number of arguments");
87
+ break;
88
+ }
89
+ return Data_Wrap_Struct(klass, gsl_multiroot_function_mark, gsl_multiroot_function_free, F);
90
+ }
91
+
92
+ static void gsl_multiroot_function_free(gsl_multiroot_function *f)
93
+ {
94
+ free((gsl_multiroot_function *) f);
95
+ }
96
+
97
+ static void gsl_multiroot_function_mark(gsl_multiroot_function *f)
98
+ {
99
+ size_t i;
100
+ rb_gc_mark((VALUE) f->params);
101
+ // for (i = 0; i < RARRAY(f->params)->len; i++)
102
+ for (i = 0; i < RARRAY_LEN(f->params); i++)
103
+ rb_gc_mark(rb_ary_entry((VALUE) f->params, i));
104
+ }
105
+
106
+ static int rb_gsl_multiroot_function_f(const gsl_vector *x, void *p, gsl_vector *f)
107
+ {
108
+ VALUE vx, vf;
109
+ VALUE vp, proc;
110
+ vx = Data_Wrap_Struct(cgsl_vector, 0, NULL, (gsl_vector *) x);
111
+ vf = Data_Wrap_Struct(cgsl_vector, 0, NULL, f);
112
+ proc = rb_ary_entry((VALUE) p, 0);
113
+ vp = rb_ary_entry((VALUE) p, 1);
114
+ if (NIL_P(vp)) rb_funcall(proc, RBGSL_ID_call, 2, vx, vf);
115
+ else rb_funcall(proc, RBGSL_ID_call, 3, vx, vp, vf);
116
+ return GSL_SUCCESS;
117
+ }
118
+
119
+ static VALUE rb_gsl_multiroot_function_eval(VALUE obj, VALUE vx)
120
+ {
121
+ gsl_multiroot_function *F = NULL;
122
+ gsl_vector *f = NULL;
123
+ VALUE vp, proc, vf, ary;
124
+ Data_Get_Struct(obj, gsl_multiroot_function, F);
125
+ ary = (VALUE) F->params;
126
+ f = gsl_vector_alloc(F->n);
127
+ vf = Data_Wrap_Struct(cgsl_vector, 0, gsl_vector_free, f);
128
+ proc = rb_ary_entry(ary, 0);
129
+ vp = rb_ary_entry(ary, 1);
130
+ if (NIL_P(vp)) rb_funcall(proc, RBGSL_ID_call, 2, vx, vf);
131
+ else rb_funcall(proc, RBGSL_ID_call, 3, vx, vp, vf);
132
+ return vf;
133
+ }
134
+
135
+ static void set_function(int i, VALUE *argv, gsl_multiroot_function *F)
136
+ {
137
+ VALUE ary;
138
+ ary = (VALUE) F->params;
139
+ if (TYPE(argv[i]) == T_FIXNUM) F->n = FIX2INT(argv[i]);
140
+ else if (rb_obj_is_kind_of(argv[i], rb_cProc))
141
+ rb_ary_store(ary, 0, argv[i]);
142
+ else if (TYPE(argv[i]) == T_ARRAY || rb_obj_is_kind_of(argv[i], cgsl_vector)
143
+ || TYPE(argv[i]) == T_FIXNUM || TYPE(argv[i]) == T_FLOAT) {
144
+ rb_ary_store(ary, 1, argv[i]);
145
+ } else {
146
+ rb_raise(rb_eTypeError, "wrong type of argument %d (Fixnum or Proc)", i);
147
+ }
148
+ }
149
+
150
+ static VALUE rb_gsl_multiroot_function_set_f(int argc, VALUE *argv, VALUE obj)
151
+ {
152
+ gsl_multiroot_function *F = NULL;
153
+ VALUE ary;
154
+ size_t i;
155
+ Data_Get_Struct(obj, gsl_multiroot_function, F);
156
+ ary = (VALUE) F->params;
157
+ if (rb_block_given_p()) rb_ary_store(ary, 0, RB_GSL_MAKE_PROC);
158
+ switch (argc) {
159
+ case 1:
160
+ set_function(0, argv, F);
161
+ break;
162
+ case 2:
163
+ case 3:
164
+ for (i = 0; i < argc; i++) set_function(i, argv, F);
165
+ break;
166
+ default:
167
+ rb_raise(rb_eArgError, "wrong number of arguments");
168
+ break;
169
+ }
170
+ return obj;
171
+ }
172
+
173
+ static VALUE rb_gsl_multiroot_function_set_params(int argc, VALUE *argv, VALUE obj)
174
+ {
175
+ gsl_multiroot_function *F = NULL;
176
+ VALUE ary, ary2;
177
+ size_t i;
178
+ if (argc == 0) return obj;
179
+ Data_Get_Struct(obj, gsl_multiroot_function, F);
180
+ if (F->params == NULL) {
181
+ ary = rb_ary_new2(4);
182
+ /* (VALUE) F->params = ary;*/
183
+ F->params = (void *) ary;
184
+ } else {
185
+ ary = (VALUE) F->params;
186
+ }
187
+ if (argc == 1) rb_ary_store(ary, 1, argv[0]);
188
+ else {
189
+ ary2 = rb_ary_new2(argc);
190
+ for (i = 0; i < argc; i++) rb_ary_store(ary2, i, argv[i]);
191
+ rb_ary_store(ary, 1, ary2);
192
+ }
193
+ return obj;
194
+ }
195
+
196
+ static VALUE rb_gsl_multiroot_function_params(VALUE obj)
197
+ {
198
+ gsl_multiroot_function *F = NULL;
199
+ Data_Get_Struct(obj, gsl_multiroot_function, F);
200
+ return rb_ary_entry((VALUE) F->params, 1);
201
+ }
202
+
203
+ static VALUE rb_gsl_multiroot_function_n(VALUE obj)
204
+ {
205
+ gsl_multiroot_function *F = NULL;
206
+ Data_Get_Struct(obj, gsl_multiroot_function, F);
207
+ return INT2FIX(F->n);
208
+ }
209
+
210
+ /*** multiroot_function_fdf ***/
211
+ static void set_function_fdf(int argc, VALUE *argv, gsl_multiroot_function_fdf *F);
212
+ static VALUE rb_gsl_multiroot_function_fdf_new(int argc, VALUE *argv, VALUE klass)
213
+ {
214
+ gsl_multiroot_function_fdf *F = NULL;
215
+ VALUE ary;
216
+ F = ALLOC(gsl_multiroot_function_fdf);
217
+ F->f = &rb_gsl_multiroot_function_fdf_f;
218
+ F->df = &rb_gsl_multiroot_function_fdf_df;
219
+ F->fdf = &rb_gsl_multiroot_function_fdf_fdf;
220
+ ary = rb_ary_new2(4);
221
+ /* (VALUE) F->params = ary;*/
222
+ F->params = (void *) ary;
223
+ rb_ary_store(ary, 2, Qnil);
224
+ rb_ary_store(ary, 3, Qnil);
225
+ set_function_fdf(argc, argv, F);
226
+ return Data_Wrap_Struct(klass, gsl_multiroot_function_fdf_mark, gsl_multiroot_function_fdf_free, F);
227
+ }
228
+
229
+ static void gsl_multiroot_function_fdf_free(gsl_multiroot_function_fdf *f)
230
+ {
231
+ free((gsl_multiroot_function_fdf *) f);
232
+ }
233
+
234
+ static void gsl_multiroot_function_fdf_mark(gsl_multiroot_function_fdf *f)
235
+ {
236
+ size_t i;
237
+ rb_gc_mark((VALUE) f->params);
238
+ // for (i = 0; i < RARRAY(f->params)->len; i++)
239
+ for (i = 0; i < RARRAY_LEN(f->params); i++)
240
+ rb_gc_mark(rb_ary_entry((VALUE) f->params, i));
241
+ }
242
+
243
+ static void set_function_fdf(int argc, VALUE *argv, gsl_multiroot_function_fdf *F)
244
+ {
245
+ VALUE ary;
246
+ if (F->params == NULL) {
247
+ ary = rb_ary_new2(4);
248
+ /* (VALUE) F->params = ary;*/
249
+ F->params = (void *) ary;
250
+ } else {
251
+ ary = (VALUE) F->params;
252
+ }
253
+ rb_ary_store(ary, 2, Qnil);
254
+ rb_ary_store(ary, 3, Qnil);
255
+ switch (argc) {
256
+ case 1:
257
+ if (TYPE(argv[0]) != T_FIXNUM) rb_raise(rb_eTypeError, "Fixnum expected");
258
+ F->n = FIX2INT(argv[0]);
259
+ break;
260
+ case 2:
261
+ rb_ary_store(ary, 0, argv[0]);
262
+ rb_ary_store(ary, 1, argv[1]);
263
+ rb_ary_store(ary, 2, Qnil);
264
+ break;
265
+ case 3:
266
+ rb_ary_store(ary, 0, argv[0]);
267
+ rb_ary_store(ary, 1, argv[1]);
268
+ if (TYPE(argv[2]) == T_FIXNUM) {
269
+ F->n = FIX2INT(argv[2]);
270
+ rb_ary_store(ary, 2, Qnil);
271
+ } else {
272
+ rb_ary_store(ary, 2, argv[2]);
273
+ }
274
+ break;
275
+ case 4:
276
+ rb_ary_store(ary, 0, argv[0]);
277
+ rb_ary_store(ary, 1, argv[1]);
278
+ if (TYPE(argv[2]) == T_FIXNUM) {
279
+ F->n = FIX2INT(argv[2]);
280
+ rb_ary_store(ary, 2, Qnil);
281
+ rb_ary_store(ary, 3, argv[3]);
282
+ } else {
283
+ rb_ary_store(ary, 2, argv[2]);
284
+ F->n = FIX2INT(argv[3]);
285
+ rb_ary_store(ary, 3, Qnil);
286
+ }
287
+ break;
288
+ case 5:
289
+ if (TYPE(argv[0]) == T_FIXNUM) {
290
+ F->n = FIX2INT(argv[0]);
291
+ rb_ary_store(ary, 0, argv[1]);
292
+ rb_ary_store(ary, 1, argv[2]);
293
+ rb_ary_store(ary, 2, argv[3]);
294
+ } else {
295
+ rb_ary_store(ary, 0, argv[0]);
296
+ rb_ary_store(ary, 1, argv[1]);
297
+ rb_ary_store(ary, 2, argv[2]);
298
+ F->n = FIX2INT(argv[3]);
299
+ }
300
+ rb_ary_store(ary, 3, argv[4]);
301
+ break;
302
+ default:
303
+ rb_raise(rb_eArgError, "wrong number of arguments (1, 3, or 4)");
304
+ break;
305
+ }
306
+ }
307
+
308
+ static VALUE rb_gsl_multiroot_function_fdf_set_params(int argc, VALUE *argv, VALUE obj)
309
+ {
310
+ gsl_multiroot_function_fdf *F = NULL;
311
+ VALUE ary, ary2;
312
+ size_t i;
313
+ if (argc == 0) return obj;
314
+ Data_Get_Struct(obj, gsl_multiroot_function_fdf, F);
315
+ if (F->params == NULL) {
316
+ ary = rb_ary_new2(4);
317
+ /* (VALUE) F->params = ary;*/
318
+ F->params = (void *) ary;
319
+ } else {
320
+ ary = (VALUE) F->params;
321
+ }
322
+ if (argc == 1) rb_ary_store(ary, 3, argv[0]);
323
+ else {
324
+ ary2 = rb_ary_new2(argc);
325
+ for (i = 0; i < argc; i++) rb_ary_store(ary2, i, argv[i]);
326
+ rb_ary_store(ary, 3, ary2);
327
+ }
328
+ return obj;
329
+ }
330
+
331
+ static VALUE rb_gsl_multiroot_function_fdf_set(int argc, VALUE *argv, VALUE obj)
332
+ {
333
+ gsl_multiroot_function_fdf *F = NULL;
334
+ Data_Get_Struct(obj, gsl_multiroot_function_fdf, F);
335
+ set_function_fdf(argc, argv, F);
336
+ return obj;
337
+ }
338
+
339
+ static int rb_gsl_multiroot_function_fdf_f(const gsl_vector *x, void *p,
340
+ gsl_vector *f)
341
+ {
342
+ VALUE vx, vf, ary;
343
+ VALUE proc, vp;
344
+ vx = Data_Wrap_Struct(cgsl_vector, 0, NULL, (gsl_vector *) x);
345
+ vf = Data_Wrap_Struct(cgsl_vector, 0, NULL, f);
346
+ ary = (VALUE) p;
347
+ proc = rb_ary_entry(ary, 0);
348
+ vp = rb_ary_entry(ary, 3);
349
+ if (NIL_P(vp)) rb_funcall(proc, RBGSL_ID_call, 2, vx, vf);
350
+ else rb_funcall(proc, RBGSL_ID_call, 3, vx, vp, vf);
351
+ return GSL_SUCCESS;
352
+ }
353
+
354
+ static int rb_gsl_multiroot_function_fdf_df(const gsl_vector *x, void *p,
355
+ gsl_matrix *J)
356
+ {
357
+ VALUE vx, vJ, ary;
358
+ VALUE proc, vp;
359
+ vx = Data_Wrap_Struct(cgsl_vector, 0, NULL, (gsl_vector *) x);
360
+ vJ = Data_Wrap_Struct(cgsl_matrix, 0, NULL, J);
361
+ ary = (VALUE) p;
362
+ proc = rb_ary_entry(ary, 1);
363
+ vp = rb_ary_entry(ary, 3);
364
+ if (NIL_P(vp)) rb_funcall(proc, RBGSL_ID_call, 2, vx, vJ);
365
+ else rb_funcall(proc, RBGSL_ID_call, 3, vx, vp, vJ);
366
+ return GSL_SUCCESS;
367
+ }
368
+
369
+ static int rb_gsl_multiroot_function_fdf_fdf(const gsl_vector *x, void *p,
370
+ gsl_vector *f, gsl_matrix *J)
371
+ {
372
+ VALUE vx, vf, vJ, ary;
373
+ VALUE proc_f, proc_df, proc_fdf, vp;
374
+ vx = Data_Wrap_Struct(cgsl_vector, 0, NULL, (gsl_vector *) x);
375
+ vf = Data_Wrap_Struct(cgsl_vector, 0, NULL, f);
376
+ vJ = Data_Wrap_Struct(cgsl_matrix, 0, NULL, J);
377
+ ary = (VALUE) p;
378
+ proc_f = rb_ary_entry(ary, 0);
379
+ proc_df = rb_ary_entry(ary, 1);
380
+ proc_fdf = rb_ary_entry(ary, 2);
381
+ vp = rb_ary_entry(ary, 3);
382
+ if (NIL_P(proc_fdf)) {
383
+ if (NIL_P(vp)) {
384
+ rb_funcall(proc_f, RBGSL_ID_call, 2, vx, vf);
385
+ rb_funcall(proc_df, RBGSL_ID_call, 2, vx, vJ);
386
+ } else {
387
+ rb_funcall(proc_f, RBGSL_ID_call, 3, vx, vp, vf);
388
+ rb_funcall(proc_df, RBGSL_ID_call, 3, vx, vp, vJ);
389
+ }
390
+ } else {
391
+ if (NIL_P(vp)) rb_funcall(proc_fdf, RBGSL_ID_call, 3, vx, vf, vJ);
392
+ else rb_funcall(proc_fdf, RBGSL_ID_call, 4, vx, vp, vf, vJ);
393
+ }
394
+ return GSL_SUCCESS;
395
+ }
396
+
397
+ static VALUE rb_gsl_multiroot_function_fdf_params(VALUE obj)
398
+ {
399
+ gsl_multiroot_function_fdf *F = NULL;
400
+ Data_Get_Struct(obj, gsl_multiroot_function_fdf, F);
401
+ return rb_ary_entry((VALUE) F->params, 3);
402
+ }
403
+
404
+ static VALUE rb_gsl_multiroot_function_fdf_n(VALUE obj)
405
+ {
406
+ gsl_multiroot_function_fdf *F = NULL;
407
+ Data_Get_Struct(obj, gsl_multiroot_function_fdf, F);
408
+ return INT2FIX(F->n);
409
+ }
410
+
411
+ /**********/
412
+
413
+ static void multiroot_define_const(VALUE klass1, VALUE klass2);
414
+ static void multiroot_define_const(VALUE klass1, VALUE klass2)
415
+ {
416
+ rb_define_const(klass1, "HYBRIDSJ", INT2FIX(GSL_MULTIROOT_FDFSOLVER_HYBRIDSJ));
417
+ rb_define_const(klass1, "HYBRIDJ", INT2FIX(GSL_MULTIROOT_FDFSOLVER_HYBRIDJ));
418
+ rb_define_const(klass1, "NEWTON", INT2FIX(GSL_MULTIROOT_FDFSOLVER_NEWTON));
419
+ rb_define_const(klass1, "GNEWTON", INT2FIX(GSL_MULTIROOT_FDFSOLVER_GNEWTON));
420
+
421
+ rb_define_const(klass2, "HYBRIDS", INT2FIX(GSL_MULTIROOT_FSOLVER_HYBRIDS));
422
+ rb_define_const(klass2, "HYBRID", INT2FIX(GSL_MULTIROOT_FSOLVER_HYBRID));
423
+ rb_define_const(klass2, "DNEWTON", INT2FIX(GSL_MULTIROOT_FSOLVER_DNEWTON));
424
+ rb_define_const(klass2, "BROYDEN", INT2FIX(GSL_MULTIROOT_FSOLVER_BROYDEN));
425
+ }
426
+
427
+ #include <string.h>
428
+ static const gsl_multiroot_fsolver_type* get_fsolver_type(VALUE t)
429
+ {
430
+ char name[32];
431
+ switch (TYPE(t)) {
432
+ case T_STRING:
433
+ strcpy(name,STR2CSTR(t));
434
+ if (str_tail_grep(name, "hybrids") == 0) return gsl_multiroot_fsolver_hybrids;
435
+ else if (str_tail_grep(name, "hybrid") == 0) return gsl_multiroot_fsolver_hybrid;
436
+ else if (str_tail_grep(name, "dnewton") == 0) return gsl_multiroot_fsolver_dnewton;
437
+ else if (str_tail_grep(name, "broyden") == 0) return gsl_multiroot_fsolver_broyden;
438
+ else rb_raise(rb_eTypeError, "%s: unknown algorithm", name);
439
+ break;
440
+ case T_FIXNUM:
441
+ switch (FIX2INT(t)) {
442
+ case GSL_MULTIROOT_FSOLVER_HYBRIDS: return gsl_multiroot_fsolver_hybrids; break;
443
+ case GSL_MULTIROOT_FSOLVER_HYBRID: return gsl_multiroot_fsolver_hybrid; break;
444
+ case GSL_MULTIROOT_FSOLVER_DNEWTON: return gsl_multiroot_fsolver_dnewton; break;
445
+ case GSL_MULTIROOT_FSOLVER_BROYDEN: return gsl_multiroot_fsolver_broyden; break;
446
+ default:
447
+ rb_raise(rb_eTypeError, "%d: unknown algorithm", FIX2INT(t));
448
+ break;
449
+ }
450
+ break;
451
+ default:
452
+ rb_raise(rb_eTypeError, "wrong type argument (Fixnum or String expected)");
453
+ break;
454
+ }
455
+ }
456
+
457
+ static const gsl_multiroot_fdfsolver_type* get_fdfsolver_type(VALUE t)
458
+ {
459
+ char name[32];
460
+ switch (TYPE(t)) {
461
+ case T_STRING:
462
+ strcpy(name,STR2CSTR(t));
463
+ if (str_tail_grep(name, "hybridsj") == 0) return gsl_multiroot_fdfsolver_hybridsj;
464
+ else if (str_tail_grep(name, "hybridj") == 0) return gsl_multiroot_fdfsolver_hybridj;
465
+ else if (str_tail_grep(name, "gnewton") == 0) return gsl_multiroot_fdfsolver_gnewton;
466
+ else if (str_tail_grep(name, "newton") == 0) return gsl_multiroot_fdfsolver_newton;
467
+ else rb_raise(rb_eTypeError, "%s: unknown algorithm", name);
468
+ break;
469
+ case T_FIXNUM:
470
+ switch (FIX2INT(t)) {
471
+ case GSL_MULTIROOT_FDFSOLVER_HYBRIDSJ: return gsl_multiroot_fdfsolver_hybridsj; break;
472
+ case GSL_MULTIROOT_FDFSOLVER_HYBRIDJ: return gsl_multiroot_fdfsolver_hybridj; break;
473
+ case GSL_MULTIROOT_FDFSOLVER_NEWTON: return gsl_multiroot_fdfsolver_newton; break;
474
+ case GSL_MULTIROOT_FDFSOLVER_GNEWTON: return gsl_multiroot_fdfsolver_gnewton; break;
475
+ default:
476
+ rb_raise(rb_eTypeError, "%d: unknown algorithm", FIX2INT(t));
477
+ break;
478
+ }
479
+ break;
480
+ default:
481
+ rb_raise(rb_eTypeError, "wrong type argument (Fixnum or String expected)");
482
+ break;
483
+ }
484
+ }
485
+
486
+ static VALUE rb_gsl_multiroot_fsolver_new(VALUE klass, VALUE t, VALUE n)
487
+ {
488
+ gsl_multiroot_fsolver *s = NULL;
489
+ const gsl_multiroot_fsolver_type *T;
490
+ CHECK_FIXNUM(n);
491
+ T = get_fsolver_type(t);
492
+ s = gsl_multiroot_fsolver_alloc(T, FIX2INT(n));
493
+ return Data_Wrap_Struct(klass, 0, gsl_multiroot_fsolver_free, s);
494
+ }
495
+
496
+ static VALUE rb_gsl_multiroot_fsolver_set(VALUE obj, VALUE vf, VALUE vx)
497
+ {
498
+ gsl_multiroot_fsolver *s = NULL;
499
+ gsl_multiroot_function *f = NULL;
500
+ gsl_vector *x = NULL;
501
+ int flag = 0, status;
502
+ CHECK_MULTIROOT_FUNCTION(vf);
503
+ Data_Get_Struct(obj, gsl_multiroot_fsolver, s);
504
+ Data_Get_Struct(vf, gsl_multiroot_function, f);
505
+ if (TYPE(vx) == T_ARRAY) {
506
+ x = gsl_vector_alloc(s->f->size);
507
+ cvector_set_from_rarray(x, vx);
508
+ flag = 1;
509
+ } else {
510
+ Data_Get_Vector(vx, x);
511
+ }
512
+ status = gsl_multiroot_fsolver_set(s, f, x);
513
+ if (flag == 1) gsl_vector_free(x);
514
+ return INT2FIX(status);
515
+ }
516
+
517
+ static VALUE rb_gsl_multiroot_fsolver_name(VALUE obj)
518
+ {
519
+ gsl_multiroot_fsolver *s = NULL;
520
+ Data_Get_Struct(obj, gsl_multiroot_fsolver, s);
521
+ return rb_str_new2(gsl_multiroot_fsolver_name(s));
522
+ }
523
+
524
+ static VALUE rb_gsl_multiroot_fsolver_iterate(VALUE obj)
525
+ {
526
+ gsl_multiroot_fsolver *s = NULL;
527
+ Data_Get_Struct(obj, gsl_multiroot_fsolver, s);
528
+ return INT2FIX(gsl_multiroot_fsolver_iterate(s));
529
+ }
530
+
531
+ static VALUE rb_gsl_multiroot_fsolver_root(VALUE obj)
532
+ {
533
+ gsl_multiroot_fsolver *s = NULL;
534
+ Data_Get_Struct(obj, gsl_multiroot_fsolver, s);
535
+ return Data_Wrap_Struct(cgsl_vector_view_ro, 0, NULL, gsl_multiroot_fsolver_root(s));
536
+ }
537
+
538
+ static VALUE rb_gsl_multiroot_fsolver_x(VALUE obj)
539
+ {
540
+ gsl_multiroot_fsolver *s = NULL;
541
+ Data_Get_Struct(obj, gsl_multiroot_fsolver, s);
542
+ return Data_Wrap_Struct(cgsl_vector_view_ro, 0, NULL, s->x);
543
+ }
544
+
545
+ static VALUE rb_gsl_multiroot_fsolver_dx(VALUE obj)
546
+ {
547
+ gsl_multiroot_fsolver *s = NULL;
548
+ Data_Get_Struct(obj, gsl_multiroot_fsolver, s);
549
+ return Data_Wrap_Struct(cgsl_vector_view_ro, 0, NULL, s->dx);
550
+ }
551
+
552
+ static VALUE rb_gsl_multiroot_fsolver_f(VALUE obj)
553
+ {
554
+ gsl_multiroot_fsolver *s = NULL;
555
+ Data_Get_Struct(obj, gsl_multiroot_fsolver, s);
556
+ return Data_Wrap_Struct(cgsl_vector_view_ro, 0, NULL, s->f);
557
+ }
558
+
559
+ static VALUE rb_gsl_multiroot_fsolver_test_delta(VALUE obj, VALUE ea, VALUE er)
560
+ {
561
+ gsl_multiroot_fsolver *s = NULL;
562
+ Need_Float(ea); Need_Float(er);
563
+ Data_Get_Struct(obj, gsl_multiroot_fsolver, s);
564
+ return INT2FIX(gsl_multiroot_test_delta(s->dx, s->x, NUM2DBL(ea), NUM2DBL(er)));
565
+ }
566
+
567
+ static VALUE rb_gsl_multiroot_fsolver_test_residual(VALUE obj, VALUE ea)
568
+ {
569
+ gsl_multiroot_fsolver *s = NULL;
570
+ Need_Float(ea);
571
+ Data_Get_Struct(obj, gsl_multiroot_fsolver, s);
572
+ return INT2FIX(gsl_multiroot_test_residual(s->f, NUM2DBL(ea)));
573
+ }
574
+
575
+ /***/
576
+
577
+ static VALUE rb_gsl_multiroot_fdfsolver_new(VALUE klass, VALUE t, VALUE n)
578
+ {
579
+ gsl_multiroot_fdfsolver *s = NULL;
580
+ const gsl_multiroot_fdfsolver_type *T;
581
+ CHECK_FIXNUM(n);
582
+ T = get_fdfsolver_type(t);
583
+ s = gsl_multiroot_fdfsolver_alloc(T, FIX2INT(n));
584
+ return Data_Wrap_Struct(klass, 0, gsl_multiroot_fdfsolver_free, s);
585
+ }
586
+
587
+ static VALUE rb_gsl_multiroot_fdfsolver_set(VALUE obj, VALUE vf, VALUE vx)
588
+ {
589
+ gsl_multiroot_fdfsolver *s = NULL;
590
+ gsl_multiroot_function_fdf *f = NULL;
591
+ gsl_vector *x = NULL;
592
+ int flag = 0, status;
593
+ CHECK_MULTIROOT_FUNCTION_FDF(vf);
594
+ Data_Get_Struct(obj, gsl_multiroot_fdfsolver, s);
595
+ Data_Get_Struct(vf, gsl_multiroot_function_fdf, f);
596
+ if (TYPE(vx) == T_ARRAY) {
597
+ x = gsl_vector_alloc(s->f->size);
598
+ cvector_set_from_rarray(x, vx);
599
+ flag = 1;
600
+ } else {
601
+ Data_Get_Vector(vx, x);
602
+ }
603
+ status = gsl_multiroot_fdfsolver_set(s, f, x);
604
+ if (flag == 0) gsl_vector_free(x);
605
+ return INT2FIX(status);
606
+ }
607
+
608
+ static VALUE rb_gsl_multiroot_fdfsolver_name(VALUE obj)
609
+ {
610
+ gsl_multiroot_fdfsolver *s = NULL;
611
+ Data_Get_Struct(obj, gsl_multiroot_fdfsolver, s);
612
+ return rb_str_new2(gsl_multiroot_fdfsolver_name(s));
613
+ }
614
+
615
+
616
+ static VALUE rb_gsl_multiroot_fdfsolver_iterate(VALUE obj)
617
+ {
618
+ gsl_multiroot_fdfsolver *s = NULL;
619
+ Data_Get_Struct(obj, gsl_multiroot_fdfsolver, s);
620
+ return INT2FIX(gsl_multiroot_fdfsolver_iterate(s));
621
+ }
622
+
623
+ static VALUE rb_gsl_multiroot_fdfsolver_root(VALUE obj)
624
+ {
625
+ gsl_multiroot_fdfsolver *s = NULL;
626
+ Data_Get_Struct(obj, gsl_multiroot_fdfsolver, s);
627
+ return Data_Wrap_Struct(cgsl_vector_view_ro, 0, NULL, gsl_multiroot_fdfsolver_root(s));
628
+ }
629
+
630
+ static VALUE rb_gsl_multiroot_fdfsolver_x(VALUE obj)
631
+ {
632
+ gsl_multiroot_fdfsolver *s = NULL;
633
+ Data_Get_Struct(obj, gsl_multiroot_fdfsolver, s);
634
+ return Data_Wrap_Struct(cgsl_vector_view_ro, 0, NULL, s->x);
635
+ }
636
+
637
+ static VALUE rb_gsl_multiroot_fdfsolver_dx(VALUE obj)
638
+ {
639
+ gsl_multiroot_fdfsolver *s = NULL;
640
+ Data_Get_Struct(obj, gsl_multiroot_fdfsolver, s);
641
+ return Data_Wrap_Struct(cgsl_vector_view_ro, 0, NULL, s->dx);
642
+ }
643
+
644
+ static VALUE rb_gsl_multiroot_fdfsolver_f(VALUE obj)
645
+ {
646
+ gsl_multiroot_fdfsolver *s = NULL;
647
+ Data_Get_Struct(obj, gsl_multiroot_fdfsolver, s);
648
+ return Data_Wrap_Struct(cgsl_vector_view_ro, 0, NULL, s->f);
649
+ }
650
+
651
+ static VALUE rb_gsl_multiroot_fdfsolver_J(VALUE obj)
652
+ {
653
+ gsl_multiroot_fdfsolver *s = NULL;
654
+ Data_Get_Struct(obj, gsl_multiroot_fdfsolver, s);
655
+ return Data_Wrap_Struct(cgsl_matrix_view_ro, 0, NULL, s->J);
656
+ }
657
+
658
+ static VALUE rb_gsl_multiroot_fdfsolver_test_delta(VALUE obj, VALUE ea, VALUE er)
659
+ {
660
+ gsl_multiroot_fdfsolver *s = NULL;
661
+ Need_Float(ea); Need_Float(er);
662
+ Data_Get_Struct(obj, gsl_multiroot_fdfsolver, s);
663
+ return INT2FIX(gsl_multiroot_test_delta(s->dx, s->x, NUM2DBL(ea), NUM2DBL(er)));
664
+ }
665
+
666
+ static VALUE rb_gsl_multiroot_fdfsolver_test_residual(VALUE obj, VALUE ea)
667
+ {
668
+ gsl_multiroot_fdfsolver *s = NULL;
669
+ Need_Float(ea);
670
+ Data_Get_Struct(obj, gsl_multiroot_fdfsolver, s);
671
+ return INT2FIX(gsl_multiroot_test_residual(s->f, NUM2DBL(ea)));
672
+ }
673
+
674
+ static VALUE rb_gsl_multiroot_test_delta(VALUE obj, VALUE vdx, VALUE vx,
675
+ VALUE ea, VALUE er)
676
+ {
677
+ gsl_vector *dx = NULL, *x = NULL;
678
+ Need_Float(ea); Need_Float(er);
679
+ Data_Get_Struct(vdx, gsl_vector, dx);
680
+ Data_Get_Struct(vx, gsl_vector, x);
681
+ return INT2FIX(gsl_multiroot_test_delta(dx, x, NUM2DBL(ea), NUM2DBL(er)));
682
+ }
683
+
684
+ static VALUE rb_gsl_multiroot_test_residual(VALUE obj, VALUE vf, VALUE ea)
685
+ {
686
+ gsl_vector *f = NULL;
687
+ Need_Float(ea);
688
+ Data_Get_Struct(vf, gsl_vector, f);
689
+ return INT2FIX(gsl_multiroot_test_residual(f, NUM2DBL(ea)));
690
+ }
691
+
692
+ static VALUE rb_gsl_multiroot_fsolver_fsolve(int argc, VALUE *argv, VALUE obj)
693
+ {
694
+ gsl_multiroot_fsolver *s = NULL;
695
+ int iter = 0, itmp = 0, i, status, max_iter = 1000;
696
+ double eps = 1e-7;
697
+ gsl_vector *xnew = NULL;
698
+ switch (TYPE(obj)) {
699
+ case T_MODULE:
700
+ case T_CLASS:
701
+ case T_OBJECT:
702
+ Data_Get_Struct(argv[0], gsl_multiroot_fsolver, s);
703
+ itmp = 1;
704
+ break;
705
+ default:
706
+ Data_Get_Struct(obj, gsl_multiroot_fsolver, s);
707
+ itmp = 0;
708
+ break;
709
+ }
710
+ for (i = itmp; i < argc; i++) {
711
+ switch (argv[i]) {
712
+ case T_FIXNUM:
713
+ max_iter = FIX2INT(argv[i]);
714
+ break;
715
+ case T_FLOAT:
716
+ eps = NUM2DBL(argv[i]);
717
+ break;
718
+ default:
719
+ rb_raise(rb_eTypeError, "wrong type of argument %s (Fixnum or Float expected)",
720
+ rb_class2name(CLASS_OF(argv[i])));
721
+ break;
722
+ }
723
+ }
724
+
725
+ do {
726
+ iter ++;
727
+ status = gsl_multiroot_fsolver_iterate (s);
728
+ if (status) break;
729
+ status = gsl_multiroot_test_residual(s->f, eps);
730
+ } while (status == GSL_CONTINUE && iter < max_iter);
731
+ xnew = gsl_vector_alloc(s->x->size);
732
+ gsl_vector_memcpy(xnew, gsl_multiroot_fsolver_root(s));
733
+ return rb_ary_new3(3,
734
+ Data_Wrap_Struct(cgsl_vector, 0, gsl_vector_free, xnew),
735
+ INT2FIX(iter), INT2FIX(status));
736
+ }
737
+
738
+ /* singleton */
739
+ static VALUE rb_gsl_multiroot_fdjacobian(int argc, VALUE *argv, VALUE obj)
740
+ {
741
+ gsl_multiroot_function *F = NULL, func;
742
+ gsl_multiroot_function_fdf *fdf = NULL;
743
+ gsl_vector *x = NULL, *f = NULL;
744
+ gsl_matrix *J = NULL;
745
+ double eps;
746
+ int status;
747
+ if (argc != 4 && argc != 5)
748
+ rb_raise(rb_eArgError, "wrong number of arguments (%d for 4 or 5)", argc);
749
+
750
+ if (rb_obj_is_kind_of(argv[0], cgsl_multiroot_function_fdf)) {
751
+ Data_Get_Struct(argv[0], gsl_multiroot_function_fdf, fdf);
752
+ func.f = fdf->f;
753
+ func.n = fdf->n;
754
+ func.params = fdf->params;
755
+ F = &func;
756
+ } else if (rb_obj_is_kind_of(argv[0], cgsl_multiroot_function)) {
757
+ Data_Get_Struct(argv[0], gsl_multiroot_function, F);
758
+ } else {
759
+ rb_raise(rb_eArgError, "wrong argument type %s (MultiRoot::Function or MultiRoot::Function_fdf expected)", rb_class2name(CLASS_OF(argv[0])));
760
+ }
761
+
762
+ Need_Float(argv[3]);
763
+ Data_Get_Vector(argv[1], x);
764
+ Data_Get_Vector(argv[2], f);
765
+ eps = NUM2DBL(argv[3]);
766
+ if (argc == 4) {
767
+ J = gsl_matrix_alloc(F->n, F->n);
768
+ status = gsl_multiroot_fdjacobian(F, x, f, eps, J);
769
+ return rb_ary_new3(2, Data_Wrap_Struct(cgsl_matrix, 0, gsl_matrix_free, J),
770
+ INT2FIX(status));
771
+ } else {
772
+ Data_Get_Struct(argv[4], gsl_matrix, J);
773
+ status = gsl_multiroot_fdjacobian(F, x, f, eps, J);
774
+ return rb_ary_new3(2, argv[4], INT2FIX(status));
775
+ }
776
+ }
777
+
778
+ static VALUE rb_gsl_multiroot_function_get_f(VALUE obj)
779
+ {
780
+ gsl_multiroot_function_fdf *F = NULL;
781
+ Data_Get_Struct(obj, gsl_multiroot_function_fdf, F);
782
+ return rb_ary_entry(((VALUE) F->params), 0);
783
+ }
784
+
785
+ static VALUE rb_gsl_multiroot_function_fdf_get_f(VALUE obj)
786
+ {
787
+ gsl_multiroot_function_fdf *F = NULL;
788
+ Data_Get_Struct(obj, gsl_multiroot_function_fdf, F);
789
+ return rb_ary_entry(((VALUE) F->params), 0);
790
+ }
791
+
792
+ static VALUE rb_gsl_multiroot_function_fdf_get_df(VALUE obj)
793
+ {
794
+ gsl_multiroot_function_fdf *F = NULL;
795
+ Data_Get_Struct(obj, gsl_multiroot_function_fdf, F);
796
+ return rb_ary_entry(((VALUE) F->params), 1);
797
+ }
798
+
799
+ static VALUE rb_gsl_multiroot_function_solve(int argc, VALUE *argv, VALUE obj)
800
+ {
801
+ gsl_multiroot_function *F = NULL;
802
+ gsl_vector *x0 = NULL, *xnew;
803
+ int flag = 0;
804
+ double epsabs = 1e-7;
805
+ size_t max_iter = 10000, iter = 0, i;
806
+ gsl_multiroot_fsolver_type *T
807
+ = (gsl_multiroot_fsolver_type *) gsl_multiroot_fsolver_hybrids;
808
+ gsl_multiroot_fsolver *s = NULL;
809
+ int status;
810
+ if (argc < 1) rb_raise(rb_eArgError, "too few arguments (%d for >= 1)", argc);
811
+ Data_Get_Struct(obj, gsl_multiroot_function, F);
812
+ switch (argc) {
813
+ case 4:
814
+ case 3:
815
+ case 2:
816
+ for (i = 1; i < argc; i++) {
817
+ switch (TYPE(argv[i])) {
818
+ case T_STRING:
819
+ T = (gsl_multiroot_fsolver_type *) get_fsolver_type(argv[i]);
820
+ break;
821
+ case T_FLOAT:
822
+ epsabs = NUM2DBL(argv[i]);
823
+ break;
824
+ case T_FIXNUM:
825
+ max_iter = FIX2INT(argv[i]);
826
+ break;
827
+ }
828
+ }
829
+ /* no break */
830
+ case 1:
831
+ if (TYPE(argv[0]) == T_ARRAY) {
832
+ // if (RARRAY(argv[0])->len != F->n)
833
+ if (RARRAY_LEN(argv[0]) != F->n)
834
+ rb_raise(rb_eRangeError, "array size are different.");
835
+ x0 = gsl_vector_alloc(F->n);
836
+ for (i = 0; i < x0->size; i++)
837
+ gsl_vector_set(x0, i, NUM2DBL(rb_ary_entry(argv[0], i)));
838
+ flag = 1;
839
+ } else {
840
+ Data_Get_Vector(argv[0], x0);
841
+ flag = 0;
842
+ }
843
+ break;
844
+ default:
845
+ rb_raise(rb_eArgError, "too many arguments (%d for 1 - 4)", argc);
846
+ break;
847
+ }
848
+ s = gsl_multiroot_fsolver_alloc (T, F->n);
849
+ gsl_multiroot_fsolver_set (s, F, x0);
850
+ do {
851
+ iter++;
852
+ status = gsl_multiroot_fsolver_iterate (s);
853
+ if (status) break;
854
+ status = gsl_multiroot_test_residual(s->f, epsabs);
855
+ } while (status == GSL_CONTINUE && iter < max_iter);
856
+ xnew = gsl_vector_alloc(x0->size);
857
+ gsl_vector_memcpy(xnew, s->x);
858
+ gsl_multiroot_fsolver_free (s);
859
+ if (flag == 1) gsl_vector_free(x0);
860
+ return rb_ary_new3(3, Data_Wrap_Struct(cgsl_vector, 0, gsl_vector_free, xnew),
861
+ INT2FIX(iter), INT2FIX(status));
862
+ }
863
+
864
+ void Init_gsl_multiroot(VALUE module)
865
+ {
866
+ VALUE mgsl_multiroot;
867
+ VALUE cgsl_multiroot_fdfsolver, cgsl_multiroot_fsolver;
868
+
869
+ mgsl_multiroot = rb_define_module_under(module, "MultiRoot");
870
+
871
+ rb_define_singleton_method(mgsl_multiroot, "test_delta",
872
+ rb_gsl_multiroot_test_delta, 4);
873
+ rb_define_singleton_method(mgsl_multiroot, "test_residual",
874
+ rb_gsl_multiroot_test_residual, 2);
875
+
876
+ rb_define_singleton_method(mgsl_multiroot, "fdjacobian",
877
+ rb_gsl_multiroot_fdjacobian, -1);
878
+
879
+ /* multiroot_function */
880
+ cgsl_multiroot_function = rb_define_class_under(mgsl_multiroot, "Function",
881
+ cgsl_function);
882
+ rb_define_singleton_method(cgsl_multiroot_function, "alloc",
883
+ rb_gsl_multiroot_function_new, -1);
884
+ rb_define_method(cgsl_multiroot_function, "eval", rb_gsl_multiroot_function_eval, 1);
885
+ rb_define_alias(cgsl_multiroot_function, "call", "eval");
886
+ rb_define_method(cgsl_multiroot_function, "set", rb_gsl_multiroot_function_set_f, -1);
887
+ rb_define_method(cgsl_multiroot_function, "set_params", rb_gsl_multiroot_function_set_params, -1);
888
+ rb_define_method(cgsl_multiroot_function, "params", rb_gsl_multiroot_function_params, 0);
889
+ rb_define_method(cgsl_multiroot_function, "n", rb_gsl_multiroot_function_n, 0);
890
+ rb_define_method(cgsl_multiroot_function, "f", rb_gsl_multiroot_function_get_f, 0);
891
+
892
+ /* multiroot_function_fdf */
893
+ cgsl_multiroot_function_fdf = rb_define_class_under(mgsl_multiroot, "Function_fdf",
894
+ cgsl_multiroot_function);
895
+ rb_define_singleton_method(cgsl_multiroot_function_fdf, "alloc",
896
+ rb_gsl_multiroot_function_fdf_new, -1);
897
+ rb_define_method(cgsl_multiroot_function_fdf, "set", rb_gsl_multiroot_function_fdf_set, -1);
898
+ rb_define_method(cgsl_multiroot_function_fdf, "set_params", rb_gsl_multiroot_function_fdf_set_params, -1);
899
+ rb_define_method(cgsl_multiroot_function_fdf, "params", rb_gsl_multiroot_function_fdf_params, 0);
900
+ rb_define_method(cgsl_multiroot_function_fdf, "n", rb_gsl_multiroot_function_fdf_n, 0);
901
+ rb_define_method(cgsl_multiroot_function_fdf, "f", rb_gsl_multiroot_function_fdf_get_f, 0);
902
+ rb_define_method(cgsl_multiroot_function_fdf, "df", rb_gsl_multiroot_function_fdf_get_df, 0);
903
+
904
+ /* solver */
905
+ cgsl_multiroot_fsolver = rb_define_class_under(mgsl_multiroot, "FSolver", cGSL_Object);
906
+ cgsl_multiroot_fdfsolver = rb_define_class_under(mgsl_multiroot, "FdfSolver", cgsl_multiroot_fsolver);
907
+
908
+ rb_define_singleton_method(cgsl_multiroot_fsolver, "alloc",
909
+ rb_gsl_multiroot_fsolver_new, 2);
910
+ rb_define_singleton_method(cgsl_multiroot_fdfsolver, "alloc",
911
+ rb_gsl_multiroot_fdfsolver_new, 2);
912
+
913
+ rb_define_method(cgsl_multiroot_fsolver, "set", rb_gsl_multiroot_fsolver_set, 2);
914
+ rb_define_method(cgsl_multiroot_fsolver, "name", rb_gsl_multiroot_fsolver_name, 0);
915
+ rb_define_method(cgsl_multiroot_fsolver, "iterate", rb_gsl_multiroot_fsolver_iterate, 0);
916
+ rb_define_method(cgsl_multiroot_fsolver, "root", rb_gsl_multiroot_fsolver_root, 0);
917
+ rb_define_method(cgsl_multiroot_fsolver, "x", rb_gsl_multiroot_fsolver_x, 0);
918
+ rb_define_method(cgsl_multiroot_fsolver, "dx", rb_gsl_multiroot_fsolver_dx, 0);
919
+ rb_define_method(cgsl_multiroot_fsolver, "f", rb_gsl_multiroot_fsolver_f, 0);
920
+ rb_define_method(cgsl_multiroot_fsolver, "test_delta", rb_gsl_multiroot_fsolver_test_delta, 2);
921
+ rb_define_method(cgsl_multiroot_fsolver, "test_residual", rb_gsl_multiroot_fsolver_test_residual, 1);
922
+
923
+ rb_define_method(cgsl_multiroot_fdfsolver, "set", rb_gsl_multiroot_fdfsolver_set, 2);
924
+ rb_define_method(cgsl_multiroot_fdfsolver, "name", rb_gsl_multiroot_fdfsolver_name, 0);
925
+ rb_define_method(cgsl_multiroot_fdfsolver, "iterate", rb_gsl_multiroot_fdfsolver_iterate, 0);
926
+ rb_define_method(cgsl_multiroot_fdfsolver, "root", rb_gsl_multiroot_fdfsolver_root, 0);
927
+ rb_define_method(cgsl_multiroot_fdfsolver, "x", rb_gsl_multiroot_fdfsolver_x, 0);
928
+ rb_define_method(cgsl_multiroot_fdfsolver, "dx", rb_gsl_multiroot_fdfsolver_dx, 0);
929
+ rb_define_method(cgsl_multiroot_fdfsolver, "f", rb_gsl_multiroot_fdfsolver_f, 0);
930
+ rb_define_method(cgsl_multiroot_fdfsolver, "J", rb_gsl_multiroot_fdfsolver_J, 0);
931
+ rb_define_alias(cgsl_multiroot_fdfsolver, "jac", "J");
932
+ rb_define_alias(cgsl_multiroot_fdfsolver, "jacobian", "J");
933
+
934
+ rb_define_method(cgsl_multiroot_fdfsolver, "test_delta", rb_gsl_multiroot_fdfsolver_test_delta, 2);
935
+ rb_define_method(cgsl_multiroot_fdfsolver, "test_residual", rb_gsl_multiroot_fdfsolver_test_residual, 1);
936
+
937
+
938
+ multiroot_define_const(cgsl_multiroot_fdfsolver, cgsl_multiroot_fsolver);
939
+
940
+ rb_define_method(cgsl_multiroot_fsolver, "fsolve", rb_gsl_multiroot_fsolver_fsolve, -1);
941
+ rb_define_alias(cgsl_multiroot_fsolver, "solve", "fsolve");
942
+
943
+ rb_define_singleton_method(cgsl_multiroot_fsolver, "fsolve", rb_gsl_multiroot_fsolver_fsolve, -1);
944
+ rb_define_singleton_method(cgsl_multiroot_fsolver, "solve", rb_gsl_multiroot_fsolver_fsolve, -1);
945
+
946
+ /*****/
947
+ rb_define_method(cgsl_multiroot_function, "solve", rb_gsl_multiroot_function_solve, -1);
948
+ rb_define_alias(cgsl_multiroot_function, "fsolve", "solve");
949
+ }
950
+ #ifdef CHECK_MULTIROOT_FUNCTION
951
+ #undef CHECK_MULTIROOT_FUNCTION
952
+ #endif
953
+ #ifdef CHECK_MULTIROOT_FUNCTION_FDF
954
+ #undef CHECK_MULTIROOT_FUNCTION_FDF
955
+ #endif