romanbsd-gsl 1.11.2.2

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