statsample-optimization 2.0.5 → 2.1.0
This diff represents the content of publicly available package versions that have been released to one of the supported registries. The information contained in this diff is provided for informational purposes only and reflects changes between package versions as they appear in their respective public registries.
- data.tar.gz.sig +2 -2
- data/History.txt +7 -1
- data/Manifest.txt +2 -0
- data/Rakefile +2 -2
- data/ext/statsamplert/as116.c +638 -0
- data/ext/statsamplert/as116.h +18 -0
- data/ext/statsamplert/statsamplert.c +41 -1
- data/test/test_statsample_optimization.rb +10 -0
- metadata +16 -32
- metadata.gz.sig +0 -0
data.tar.gz.sig
CHANGED
@@ -1,2 +1,2 @@
|
|
1
|
-
|
2
|
-
|
1
|
+
��0��,g�h��d��U���8^�ۡb�1-o�<YS`��1�V�����:���Yz�/"!Y9�X�?�=���P��fxP�(;\u�]�71�����T����@�����<N[�j�%X�<u��X
|
2
|
+
7
|
data/History.txt
CHANGED
@@ -1,8 +1,14 @@
|
|
1
|
+
=== 2.1.0 / 2010-12-22
|
2
|
+
* Added tetrachoric correlation support using fortran to c version of AS116
|
3
|
+
* Added native compilation support
|
4
|
+
|
1
5
|
=== 2.0.3 / 2010-06-14
|
2
6
|
* All extensions dependencies of statsample moved to statsample-optimization
|
7
|
+
|
3
8
|
=== 2.0.0 / 2009-08-21
|
4
9
|
* Uses rcov internal configuration
|
5
|
-
|
10
|
+
|
11
|
+
=== 1.0.0 / 2009-08-02
|
6
12
|
|
7
13
|
* Birthday!
|
8
14
|
|
data/Manifest.txt
CHANGED
data/Rakefile
CHANGED
@@ -8,11 +8,11 @@ Hoe.plugin :git
|
|
8
8
|
|
9
9
|
task "test" => ["lib/statsamplert.so"]
|
10
10
|
spec=Hoe.spec 'statsample-optimization' do
|
11
|
-
self.version="2.0
|
11
|
+
self.version="2.1.0"
|
12
12
|
self.spec_extras[:extensions] = ["ext/statsamplert/extconf.rb"]
|
13
13
|
self.rubyforge_name = 'ruby-statsample'
|
14
14
|
self.developer('Claudio Bustos', 'clbustos_at_gmail.com')
|
15
|
-
self.extra_deps << ["statsample","~>0.
|
15
|
+
self.extra_deps << ["statsample","~>0.17"] << ["statistics2", "~>0.54"] << ["gsl", "~>1.14"]
|
16
16
|
self.extra_deps << ["rake-compiler"]
|
17
17
|
|
18
18
|
end
|
@@ -0,0 +1,638 @@
|
|
1
|
+
/* as116.f -- translated by f2c (version 20090411).
|
2
|
+
You must link the resulting object file with libf2c:
|
3
|
+
on Microsoft Windows system, link with libf2c.lib;
|
4
|
+
on Linux or Unix systems, link with .../path/to/libf2c.a -lm
|
5
|
+
or, if you install libf2c.a in a standard place, with -lf2c -lm
|
6
|
+
-- in that order, at the end of the command line, as in
|
7
|
+
cc *.o -lf2c -lm
|
8
|
+
Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
|
9
|
+
|
10
|
+
http://www.netlib.org/f2c/libf2c.zip
|
11
|
+
*/
|
12
|
+
#include "math.h"
|
13
|
+
#include "as116.h"
|
14
|
+
|
15
|
+
typedef int logical;
|
16
|
+
|
17
|
+
|
18
|
+
#define dabs(x) (double)abs(x)
|
19
|
+
#define abs(x) ((x) >= 0 ? (x) : -(x))
|
20
|
+
|
21
|
+
#define TRUE_ (1)
|
22
|
+
#define FALSE_ (0)
|
23
|
+
|
24
|
+
|
25
|
+
static double alnorm_(double *x, logical *upper);
|
26
|
+
static double ppnd_(double *p, int *ier);
|
27
|
+
|
28
|
+
|
29
|
+
|
30
|
+
|
31
|
+
|
32
|
+
|
33
|
+
/* Table of constant values */
|
34
|
+
|
35
|
+
static logical c_false = FALSE_;
|
36
|
+
|
37
|
+
/* This file includes the Applied Statistics algorithm AS 66 for calculating */
|
38
|
+
/* the tail area under the normal curve, and two alternative routines which */
|
39
|
+
/* give higher accuracy. The latter have been contributed by Alan Miller of */
|
40
|
+
/* CSIRO Division of Mathematics & Statistics, Clayton, Victoria. Notice */
|
41
|
+
/* that each function or routine has different call arguments. */
|
42
|
+
|
43
|
+
|
44
|
+
static double alnorm_(double *x, logical *upper) {
|
45
|
+
/* Initialized data */
|
46
|
+
|
47
|
+
static double zero = 0.;
|
48
|
+
static double a1 = 5.75885480458;
|
49
|
+
static double a2 = 2.62433121679;
|
50
|
+
static double a3 = 5.92885724438;
|
51
|
+
static double b1 = -29.8213557807;
|
52
|
+
static double b2 = 48.6959930692;
|
53
|
+
static double c1 = -3.8052e-8;
|
54
|
+
static double c2 = 3.98064794e-4;
|
55
|
+
static double c3 = -.151679116635;
|
56
|
+
static double c4 = 4.8385912808;
|
57
|
+
static double c5 = .742380924027;
|
58
|
+
static double one = 1.;
|
59
|
+
static double c6 = 3.99019417011;
|
60
|
+
static double d1 = 1.00000615302;
|
61
|
+
static double d2 = 1.98615381364;
|
62
|
+
static double d3 = 5.29330324926;
|
63
|
+
static double d4 = -15.1508972451;
|
64
|
+
static double d5 = 30.789933034;
|
65
|
+
static double half = .5;
|
66
|
+
static double ltone = 7.;
|
67
|
+
static double utzero = 18.66;
|
68
|
+
static double con = 1.28;
|
69
|
+
static double p = .398942280444;
|
70
|
+
static double q = .39990348504;
|
71
|
+
static double r__ = .398942280385;
|
72
|
+
|
73
|
+
/* System generated locals */
|
74
|
+
double ret_val;
|
75
|
+
|
76
|
+
|
77
|
+
/* Local variables */
|
78
|
+
static double y, z__;
|
79
|
+
static logical up;
|
80
|
+
|
81
|
+
|
82
|
+
/* Algorithm AS66 Applied Statistics (1973) vol22 no.3 */
|
83
|
+
|
84
|
+
/* Evaluates the tail area of the standardised normal curve */
|
85
|
+
/* from x to infinity if upper is .true. or */
|
86
|
+
/* from minus infinity to x if upper is .false. */
|
87
|
+
|
88
|
+
/* *** machine dependent constants */
|
89
|
+
|
90
|
+
up = *upper;
|
91
|
+
z__ = *x;
|
92
|
+
if (z__ >= zero) {
|
93
|
+
goto L10;
|
94
|
+
}
|
95
|
+
up = ! up;
|
96
|
+
z__ = -z__;
|
97
|
+
L10:
|
98
|
+
if (z__ <= ltone || (up && z__ <= utzero)) {
|
99
|
+
goto L20;
|
100
|
+
}
|
101
|
+
ret_val = zero;
|
102
|
+
goto L40;
|
103
|
+
L20:
|
104
|
+
y = half * z__ * z__;
|
105
|
+
if (z__ > con) {
|
106
|
+
goto L30;
|
107
|
+
}
|
108
|
+
|
109
|
+
ret_val = half - z__ * (p - q * y / (y + a1 + b1 / (y + a2 + b2 / (y + a3)
|
110
|
+
)));
|
111
|
+
goto L40;
|
112
|
+
L30:
|
113
|
+
ret_val = r__ * exp(-y) / (z__ + c1 + d1 / (z__ + c2 + d2 / (z__ + c3 +
|
114
|
+
d3 / (z__ + c4 + d4 / (z__ + c5 + d5 / (z__ + c6))))));
|
115
|
+
L40:
|
116
|
+
if (! up) {
|
117
|
+
ret_val = one - ret_val;
|
118
|
+
}
|
119
|
+
return ret_val;
|
120
|
+
} /* alnorm_ */
|
121
|
+
|
122
|
+
static double ppnd_(double *p, int *ier)
|
123
|
+
{
|
124
|
+
/* Initialized data */
|
125
|
+
|
126
|
+
static double split = .42;
|
127
|
+
static double a0 = 2.50662823884;
|
128
|
+
static double a1 = -18.61500062529;
|
129
|
+
static double a2 = 41.39119773534;
|
130
|
+
static double a3 = -25.44106049637;
|
131
|
+
static double b1 = -8.4735109309;
|
132
|
+
static double b2 = 23.08336743743;
|
133
|
+
static double b3 = -21.06224101826;
|
134
|
+
static double b4 = 3.13082909833;
|
135
|
+
static double c0 = -2.78718931138;
|
136
|
+
static double c1 = -2.29796479134;
|
137
|
+
static double c2 = 4.85014127135;
|
138
|
+
static double c3 = 2.32121276858;
|
139
|
+
static double d1 = 3.54388924762;
|
140
|
+
static double d2 = 1.63706781897;
|
141
|
+
static double zero = 0.;
|
142
|
+
static double one = 1.;
|
143
|
+
static double half = .5;
|
144
|
+
|
145
|
+
/* System generated locals */
|
146
|
+
double ret_val;
|
147
|
+
|
148
|
+
|
149
|
+
/* Local variables */
|
150
|
+
static double q, r__;
|
151
|
+
|
152
|
+
|
153
|
+
/* ALGORITHM AS 111, APPL.STATIST., VOL.26, 118-121, 1977. */
|
154
|
+
|
155
|
+
/* PRODUCES NORMAL DEVIATE CORRESPONDING TO LOWER TAIL AREA = P. */
|
156
|
+
|
157
|
+
/* See also AS 241 which contains alternative routines accurate to */
|
158
|
+
/* about 7 and 16 decimal digits. */
|
159
|
+
|
160
|
+
|
161
|
+
*ier = 0;
|
162
|
+
q = *p - half;
|
163
|
+
if (abs(q) > split) {
|
164
|
+
goto L10;
|
165
|
+
}
|
166
|
+
|
167
|
+
/* 0.08 < P < 0.92 */
|
168
|
+
|
169
|
+
r__ = q * q;
|
170
|
+
ret_val = q * (((a3 * r__ + a2) * r__ + a1) * r__ + a0) / ((((b4 * r__ +
|
171
|
+
b3) * r__ + b2) * r__ + b1) * r__ + one);
|
172
|
+
return ret_val;
|
173
|
+
|
174
|
+
/* P < 0.08 OR P > 0.92, SET R = MIN(P,1-P) */
|
175
|
+
|
176
|
+
L10:
|
177
|
+
r__ = *p;
|
178
|
+
if (q > zero) {
|
179
|
+
r__ = one - *p;
|
180
|
+
}
|
181
|
+
if (r__ <= zero) {
|
182
|
+
goto L20;
|
183
|
+
}
|
184
|
+
r__ = sqrt(-log(r__));
|
185
|
+
ret_val = (((c3 * r__ + c2) * r__ + c1) * r__ + c0) / ((d2 * r__ + d1) *
|
186
|
+
r__ + one);
|
187
|
+
if (q < zero) {
|
188
|
+
ret_val = -ret_val;
|
189
|
+
}
|
190
|
+
return ret_val;
|
191
|
+
L20:
|
192
|
+
*ier = 1;
|
193
|
+
ret_val = zero;
|
194
|
+
return ret_val;
|
195
|
+
} /* ppnd_ */
|
196
|
+
|
197
|
+
/* Subroutine */
|
198
|
+
|
199
|
+
int tetra(double *a, double *b, double *c__, double *d__, double *r__,
|
200
|
+
double *sdr, double *sdzero, double *threshold_x, double *threshold_y, int *itype, int *ifault)
|
201
|
+
{
|
202
|
+
/* Initialized data */
|
203
|
+
|
204
|
+
static double x[16] = { .9972638618f,.9856115115f,.9647622556f,.9349060759f,
|
205
|
+
.8963211558f,.8493676137f,.794483796f,.7321821187f,.6630442669f,
|
206
|
+
.5877157572f,.5068999089f,.4213512761f,.3318686023f,.2392873623f,
|
207
|
+
.1444719616f,.0483076657f };
|
208
|
+
static double w[16] = { .00701861f,.0162743947f,.0253920653f,.0342738629f,
|
209
|
+
.042835898f,.0509980593f,.0586840935f,.0658222228f,.0723457941f,
|
210
|
+
.0781938958f,.0833119242f,.087652093f,.0911738787f,.0938443991f,
|
211
|
+
.0956387201f,.0965400885f };
|
212
|
+
static double zero = 0.f;
|
213
|
+
static double one = 1.f;
|
214
|
+
static double two = 2.f;
|
215
|
+
static double four = 4.f;
|
216
|
+
static double six = 6.f;
|
217
|
+
static double half = .5f;
|
218
|
+
static double twopi = 6.28318531f;
|
219
|
+
static double sqt2pi = 2.50662827f;
|
220
|
+
static double rlimit = .9999f;
|
221
|
+
static double rcut = .95f;
|
222
|
+
static double uplim = 5.f;
|
223
|
+
static double const__ = 1e-36f;
|
224
|
+
static double chalf = 1e-18f;
|
225
|
+
static double conv = 1e-8f;
|
226
|
+
static double citer = 1e-6f;
|
227
|
+
static int niter = 25;
|
228
|
+
|
229
|
+
/* System generated locals */
|
230
|
+
double r__1, r__2, r__3;
|
231
|
+
|
232
|
+
|
233
|
+
/* Local variables */
|
234
|
+
static double aa, bb, cc, dd;
|
235
|
+
static int ie;
|
236
|
+
static double dr, va, vb, wa, wb, rr, sr, ss, pab, pac, cof, vaa, waa, pdf,
|
237
|
+
zab, zac, xla, xlb, sum, tot, amid;
|
238
|
+
static double prob;
|
239
|
+
static int iter;
|
240
|
+
static double xlen, term, rrsq, delta;
|
241
|
+
static int iquad;
|
242
|
+
static double tempa, tempb, deriv;
|
243
|
+
static int ksign, iterm;
|
244
|
+
static double rrest;
|
245
|
+
static int kdelta;
|
246
|
+
static double probaa, probac, probab;
|
247
|
+
static double rrprev, sumprv;
|
248
|
+
|
249
|
+
|
250
|
+
/* ALGORITHM AS 116 APPL. STATIST. (1977) VOL.26, NO.3 */
|
251
|
+
|
252
|
+
/* TO COMPUTE THE TETRACHORIC CORRELATION (R) AND ITS STANDARD */
|
253
|
+
/* ERRORS (SDR AND SDZERO) FROM THE FREQUENCIES OF A 2*2 TABLE */
|
254
|
+
/* (A, B, C AND D) */
|
255
|
+
/* X AND W ARE CONSTANTS USED IN GAUSSIAN QUADRATURE */
|
256
|
+
|
257
|
+
|
258
|
+
/* INITIALIZATION */
|
259
|
+
|
260
|
+
*r__ = zero;
|
261
|
+
*sdzero = zero;
|
262
|
+
*sdr = zero;
|
263
|
+
*itype = 0;
|
264
|
+
*ifault = 0;
|
265
|
+
*threshold_x=zero;
|
266
|
+
*threshold_y=zero;
|
267
|
+
|
268
|
+
/* CHECK IF ANY CELL FREQUENCY IS NEGATIVE */
|
269
|
+
|
270
|
+
if (*a < zero || *b < zero || *c__ < zero || *d__ < zero) {
|
271
|
+
goto L92;
|
272
|
+
}
|
273
|
+
|
274
|
+
/* CHECK IF ANY FREQUENCY IS ZERO AND SET KDELTA */
|
275
|
+
|
276
|
+
kdelta = 1;
|
277
|
+
delta = zero;
|
278
|
+
if (*a == zero || *d__ == zero) {
|
279
|
+
kdelta = 2;
|
280
|
+
}
|
281
|
+
if (*b == zero || *c__ == zero) {
|
282
|
+
kdelta += 2;
|
283
|
+
}
|
284
|
+
|
285
|
+
/* KDELTA=4 MEANS TABLE HAS ZERO ROW OR COLUMN, RUN IS TERMINATED */
|
286
|
+
|
287
|
+
switch (kdelta) {
|
288
|
+
case 1: goto L4;
|
289
|
+
case 2: goto L1;
|
290
|
+
case 3: goto L2;
|
291
|
+
case 4: goto L92;
|
292
|
+
}
|
293
|
+
|
294
|
+
/* DELTA IS 0.0, 0.5 OR -0.5 ACCORDING TO WHICH CELL IS ZERO */
|
295
|
+
|
296
|
+
L1:
|
297
|
+
delta = half;
|
298
|
+
if (*a == zero && *d__ == zero) {
|
299
|
+
*r__ = -one;
|
300
|
+
}
|
301
|
+
goto L4;
|
302
|
+
L2:
|
303
|
+
delta = -half;
|
304
|
+
if (*b == zero && *c__ == zero) {
|
305
|
+
*r__ = one;
|
306
|
+
}
|
307
|
+
L4:
|
308
|
+
if (*r__ != zero) {
|
309
|
+
*itype = 3;
|
310
|
+
}
|
311
|
+
|
312
|
+
/* STORE FREQUENCIES IN AA, BB, CC AND DD */
|
313
|
+
|
314
|
+
aa = *a + delta;
|
315
|
+
bb = *b - delta;
|
316
|
+
cc = *c__ - delta;
|
317
|
+
dd = *d__ + delta;
|
318
|
+
tot = aa + bb + cc + dd;
|
319
|
+
|
320
|
+
/* CHECK IF CORRELATION IS NEGATIVE, ZERO, POSITIVE */
|
321
|
+
|
322
|
+
if ((r__1 = aa * dd - bb * cc) < 0.f) {
|
323
|
+
goto L7;
|
324
|
+
} else if (r__1 == 0) {
|
325
|
+
goto L5;
|
326
|
+
} else {
|
327
|
+
goto L6;
|
328
|
+
}
|
329
|
+
L5:
|
330
|
+
*itype = 4;
|
331
|
+
|
332
|
+
/* COMPUTE PROBABILITIES OF QUADRANT AND OF MARGINALS */
|
333
|
+
/* PROBAA AND PROBAC CHOSEN SO THAT CORRELATION IS POSITIVE. */
|
334
|
+
/* KSIGN INDICATES WHETHER QUADRANTS HAVE BEEN SWITCHED */
|
335
|
+
|
336
|
+
L6:
|
337
|
+
probaa = aa / tot;
|
338
|
+
probac = (aa + cc) / tot;
|
339
|
+
ksign = 1;
|
340
|
+
goto L8;
|
341
|
+
L7:
|
342
|
+
probaa = bb / tot;
|
343
|
+
probac = (bb + dd) / tot;
|
344
|
+
ksign = 2;
|
345
|
+
L8:
|
346
|
+
probab = (aa + bb) / tot;
|
347
|
+
|
348
|
+
/* COMPUTE NORMAL DEVIATES FOR THE MARGINAL FREQUENCIES */
|
349
|
+
/* SINCE NO MARGINAL CAN BE ZERO, IE IS NOT CHECKED */
|
350
|
+
|
351
|
+
zac = ppnd_((double*)&probac, &ie);
|
352
|
+
zab = ppnd_((double*)&probab, &ie);
|
353
|
+
|
354
|
+
*threshold_x=zab;
|
355
|
+
*threshold_y=zac;
|
356
|
+
/* Computing 2nd power */
|
357
|
+
r__1 = zac;
|
358
|
+
/* Computing 2nd power */
|
359
|
+
r__2 = zab;
|
360
|
+
ss = exp(-half * (r__1 * r__1 + r__2 * r__2)) / twopi;
|
361
|
+
|
362
|
+
/* WHEN R IS 0.0, 1.0 OR -1.0, TRANSFER TO COMPUTE SDZERO */
|
363
|
+
|
364
|
+
if (*r__ != zero || *itype > 0) {
|
365
|
+
goto L85;
|
366
|
+
}
|
367
|
+
|
368
|
+
/* WHEN MARGINALS ARE EQUAL, COSINE EVALUATION IS USED */
|
369
|
+
|
370
|
+
if (*a == *d__ && *b == *c__) {
|
371
|
+
goto L60;
|
372
|
+
}
|
373
|
+
|
374
|
+
/* INITIAL ESTIMATE OF CORRELATION IS YULES Y */
|
375
|
+
|
376
|
+
/* Computing 2nd power */
|
377
|
+
r__2 = sqrt(aa * dd) - sqrt(bb * cc);
|
378
|
+
rr = r__2 * r__2 / (r__1 = aa * dd - bb * cc, dabs(r__1));
|
379
|
+
iter = 0;
|
380
|
+
|
381
|
+
/* IF RR EXCEEDS RCUT, GAUSSIAN QUADRATURE IS USED */
|
382
|
+
|
383
|
+
L10:
|
384
|
+
if (rr > rcut) {
|
385
|
+
goto L40;
|
386
|
+
}
|
387
|
+
|
388
|
+
/* TETRACHORIC SERIES IS COMPUTED */
|
389
|
+
|
390
|
+
/* INITIALIZATION */
|
391
|
+
|
392
|
+
va = one;
|
393
|
+
vb = zac;
|
394
|
+
wa = one;
|
395
|
+
wb = zab;
|
396
|
+
term = one;
|
397
|
+
iterm = 0;
|
398
|
+
sum = probab * probac;
|
399
|
+
deriv = zero;
|
400
|
+
sr = ss;
|
401
|
+
L15:
|
402
|
+
if (dabs(sr) > const__) {
|
403
|
+
goto L20;
|
404
|
+
}
|
405
|
+
|
406
|
+
/* RESCALE TERMS TO AVOID OVERFLOWS AND UNDERFLOWS */
|
407
|
+
|
408
|
+
sr /= const__;
|
409
|
+
va *= chalf;
|
410
|
+
vb *= chalf;
|
411
|
+
wa *= chalf;
|
412
|
+
wb *= chalf;
|
413
|
+
|
414
|
+
/* FORM SUM AND DERIVATIVE OF SERIES */
|
415
|
+
|
416
|
+
L20:
|
417
|
+
dr = sr * va * wa;
|
418
|
+
sr = sr * rr / term;
|
419
|
+
cof = sr * va * wa;
|
420
|
+
|
421
|
+
/* ITERM COUNTS NO. OF CONSECUTIVE TERMS .LT. CONV */
|
422
|
+
|
423
|
+
++iterm;
|
424
|
+
if (dabs(cof) > conv) {
|
425
|
+
iterm = 0;
|
426
|
+
}
|
427
|
+
sum += cof;
|
428
|
+
deriv += dr;
|
429
|
+
vaa = va;
|
430
|
+
waa = wa;
|
431
|
+
va = vb;
|
432
|
+
wa = wb;
|
433
|
+
vb = zac * va - term * vaa;
|
434
|
+
wb = zab * wa - term * waa;
|
435
|
+
term += one;
|
436
|
+
if (iterm < 2 || term < six) {
|
437
|
+
goto L15;
|
438
|
+
}
|
439
|
+
|
440
|
+
/* CHECK IF ITERATION CONVERGED */
|
441
|
+
|
442
|
+
if ((r__1 = sum - probaa, dabs(r__1)) > citer) {
|
443
|
+
goto L25;
|
444
|
+
}
|
445
|
+
|
446
|
+
/* ITERATION HAS CONVERGED, SET ITYPE */
|
447
|
+
|
448
|
+
*itype = term;
|
449
|
+
goto L70;
|
450
|
+
|
451
|
+
/* CALCULATE NEXT ESTIMATE OF CORRELATION */
|
452
|
+
|
453
|
+
L25:
|
454
|
+
++iter;
|
455
|
+
|
456
|
+
/* IF TOO MANY ITERATlONS, RUN IS TERMINATED */
|
457
|
+
|
458
|
+
if (iter >= niter) {
|
459
|
+
goto L93;
|
460
|
+
}
|
461
|
+
delta = (sum - probaa) / deriv;
|
462
|
+
rrprev = rr;
|
463
|
+
rr -= delta;
|
464
|
+
if (iter == 1) {
|
465
|
+
rr += half * delta;
|
466
|
+
}
|
467
|
+
if (rr > rlimit) {
|
468
|
+
rr = rlimit;
|
469
|
+
}
|
470
|
+
if (rr < zero) {
|
471
|
+
rr = zero;
|
472
|
+
}
|
473
|
+
goto L10;
|
474
|
+
|
475
|
+
/* GAUSSIAN QUADRATURE */
|
476
|
+
|
477
|
+
L40:
|
478
|
+
if (iter > 0) {
|
479
|
+
goto L41;
|
480
|
+
}
|
481
|
+
|
482
|
+
/* INITIALIZATION, IF THIS IS FIRST ITERATION */
|
483
|
+
|
484
|
+
sum = probab * probac;
|
485
|
+
rrprev = zero;
|
486
|
+
|
487
|
+
/* INITIALIZATION */
|
488
|
+
|
489
|
+
L41:
|
490
|
+
sumprv = probab - sum;
|
491
|
+
prob = bb / tot;
|
492
|
+
if (ksign == 2) {
|
493
|
+
prob = aa / tot;
|
494
|
+
}
|
495
|
+
*itype = 1;
|
496
|
+
|
497
|
+
/* LOOP TO FIND ESTIMATE OF CORRELATION */
|
498
|
+
/* COMPUTATION OF INTEGRAL (SUM) BY QUADRATURE */
|
499
|
+
|
500
|
+
L42:
|
501
|
+
/* Computing 2nd power */
|
502
|
+
r__1 = rr;
|
503
|
+
rrsq = sqrt(one - r__1 * r__1);
|
504
|
+
amid = half * (uplim + zac);
|
505
|
+
xlen = uplim - amid;
|
506
|
+
sum = zero;
|
507
|
+
for (iquad = 1; iquad <= 16; ++iquad) {
|
508
|
+
xla = amid + x[iquad - 1] * xlen;
|
509
|
+
xlb = amid - x[iquad - 1] * xlen;
|
510
|
+
|
511
|
+
/* TO AVOID UNDERFLOWS, TEMPA AND TEMPB ARE USED */
|
512
|
+
|
513
|
+
tempa = (zab - rr * xla) / rrsq;
|
514
|
+
if (tempa >= -six) {
|
515
|
+
/* Computing 2nd power */
|
516
|
+
r__1 = xla;
|
517
|
+
sum += w[iquad - 1] * exp(-half * (r__1 * r__1)) * alnorm_((
|
518
|
+
double*)&tempa, &c_false);
|
519
|
+
}
|
520
|
+
tempb = (zab - rr * xlb) / rrsq;
|
521
|
+
if (tempb >= -six) {
|
522
|
+
/* Computing 2nd power */
|
523
|
+
r__1 = xlb;
|
524
|
+
sum += w[iquad - 1] * exp(-half * (r__1 * r__1)) * alnorm_((
|
525
|
+
double*)&tempb, &c_false);
|
526
|
+
}
|
527
|
+
/* L44: */
|
528
|
+
}
|
529
|
+
sum = sum * xlen / sqt2pi;
|
530
|
+
|
531
|
+
/* CHECK IF ITERATION HAS CONVERGED */
|
532
|
+
|
533
|
+
if ((r__1 = prob - sum, dabs(r__1)) <= citer) {
|
534
|
+
goto L70;
|
535
|
+
}
|
536
|
+
++iter;
|
537
|
+
|
538
|
+
/* IF TOO MANY ITERATIONS, RUN IS TERMINATED */
|
539
|
+
|
540
|
+
if (iter >= niter) {
|
541
|
+
goto L93;
|
542
|
+
}
|
543
|
+
|
544
|
+
/* ESTIMATE CORRELATION FOR NEXT ITERATION BY LINEAR INTERPOLATION */
|
545
|
+
|
546
|
+
rrest = ((prob - sum) * rrprev - (prob - sumprv) * rr) / (sumprv - sum);
|
547
|
+
|
548
|
+
/* IS ESTIMATE POSITIVE AND LESS THAN UPPER LIMIT */
|
549
|
+
|
550
|
+
if (rrest > rlimit) {
|
551
|
+
rrest = rlimit;
|
552
|
+
}
|
553
|
+
if (rrest < zero) {
|
554
|
+
rrest = zero;
|
555
|
+
}
|
556
|
+
rrprev = rr;
|
557
|
+
rr = rrest;
|
558
|
+
sumprv = sum;
|
559
|
+
|
560
|
+
/* IF ESTIMATE HAS SAME VALUE ON TWO ITERATIONS, STOP ITERATION */
|
561
|
+
|
562
|
+
if (rr == rrprev) {
|
563
|
+
goto L70;
|
564
|
+
}
|
565
|
+
goto L42;
|
566
|
+
|
567
|
+
/* WHEN ALL MARGINALS ARE EQUAL THE COSINE FUNCTION IS USED */
|
568
|
+
|
569
|
+
L60:
|
570
|
+
rr = -cos(twopi * probaa);
|
571
|
+
*itype = 2;
|
572
|
+
|
573
|
+
/* COMPUTE SDR */
|
574
|
+
|
575
|
+
L70:
|
576
|
+
*r__ = rr;
|
577
|
+
/* Computing 2nd power */
|
578
|
+
r__1 = *r__;
|
579
|
+
rrsq = sqrt(one - r__1 * r__1);
|
580
|
+
if (kdelta > 1) {
|
581
|
+
*itype = -(*itype);
|
582
|
+
}
|
583
|
+
if (ksign == 1) {
|
584
|
+
goto L71;
|
585
|
+
}
|
586
|
+
*r__ = -(*r__);
|
587
|
+
zac = -zac;
|
588
|
+
*threshold_y=zac;
|
589
|
+
|
590
|
+
L71:
|
591
|
+
/* Computing 2nd power */
|
592
|
+
r__1 = zac;
|
593
|
+
/* Computing 2nd power */
|
594
|
+
r__2 = zab;
|
595
|
+
/* Computing 2nd power */
|
596
|
+
r__3 = rrsq;
|
597
|
+
pdf = exp(-half * (r__1 * r__1 - two * *r__ * zac * zab + r__2 * r__2) / (
|
598
|
+
r__3 * r__3)) / (twopi * rrsq);
|
599
|
+
r__1 = (zac - *r__ * zab) / rrsq;
|
600
|
+
pac = alnorm_((double*)&r__1, &c_false) - half;
|
601
|
+
r__1 = (zab - *r__ * zac) / rrsq;
|
602
|
+
pab = alnorm_((double*)&r__1, &c_false) - half;
|
603
|
+
/* Computing 2nd power */
|
604
|
+
r__1 = pab;
|
605
|
+
/* Computing 2nd power */
|
606
|
+
r__2 = pac;
|
607
|
+
*sdr = (aa + dd) * (bb + cc) / four + r__1 * r__1 * (aa + cc) * (bb + dd)
|
608
|
+
+ r__2 * r__2 * (aa + bb) * (cc + dd) + two * pab * pac * (aa *
|
609
|
+
dd - bb * cc) - pab * (aa * bb - cc * dd) - pac * (aa * cc - bb *
|
610
|
+
dd);
|
611
|
+
if (*sdr < zero) {
|
612
|
+
*sdr = zero;
|
613
|
+
}
|
614
|
+
*sdr = sqrt(*sdr) / (tot * pdf * sqrt(tot));
|
615
|
+
|
616
|
+
/* COMPUTE SDZERO */
|
617
|
+
|
618
|
+
L85:
|
619
|
+
/* Computing 2nd power */
|
620
|
+
r__1 = tot;
|
621
|
+
*sdzero = sqrt((aa + bb) * (aa + cc) * (bb + dd) * (cc + dd) / tot) / (
|
622
|
+
r__1 * r__1 * ss);
|
623
|
+
if (*r__ == zero) {
|
624
|
+
*sdr = *sdzero;
|
625
|
+
}
|
626
|
+
goto L99;
|
627
|
+
|
628
|
+
/* ERROR TERMINATIONS */
|
629
|
+
|
630
|
+
L92:
|
631
|
+
*ifault = 1;
|
632
|
+
L93:
|
633
|
+
++(*ifault);
|
634
|
+
|
635
|
+
L99:
|
636
|
+
return 0;
|
637
|
+
} /* tetra_ */
|
638
|
+
|
@@ -0,0 +1,18 @@
|
|
1
|
+
#ifndef AS116_H
|
2
|
+
#define AS116_H
|
3
|
+
|
4
|
+
// A, B,C__, D__ -> the four cell frequencies [[A,B],[C,D]]
|
5
|
+
// R__ -> The tetrachoric correlation
|
6
|
+
// sdr -> The standard deviation of r
|
7
|
+
// sdzero -> standard deviation of r, appropiate to test that correlation is 0
|
8
|
+
// itype-> numerical method used
|
9
|
+
// ifault-> error indicator
|
10
|
+
// 0->normal
|
11
|
+
// 1->iteration did not converge
|
12
|
+
// 2->tabla has at most one nonzero row or column
|
13
|
+
|
14
|
+
int tetra(double *a, double *b, double *c__, double *d__, double *r__,
|
15
|
+
double *sdr, double *sdzero, double *tx, double *ty, int *itype, int *ifault);
|
16
|
+
|
17
|
+
#endif
|
18
|
+
|
@@ -1,12 +1,16 @@
|
|
1
1
|
#include <ruby.h>
|
2
|
+
#include "as116.h"
|
2
3
|
/**
|
3
4
|
* :stopdoc:
|
4
5
|
*/
|
6
|
+
|
5
7
|
void Init_statsamplert();
|
6
8
|
VALUE statsample_frequencies(VALUE self, VALUE data);
|
7
9
|
VALUE statsample_set_valid_data_intern(VALUE self, VALUE vector);
|
8
10
|
VALUE statsample_case_as_hash(VALUE self, VALUE ds, VALUE index);
|
9
11
|
VALUE statsample_case_as_array(VALUE self, VALUE ds, VALUE index);
|
12
|
+
VALUE statsample_tetrachoric(VALUE self, VALUE a, VALUE b, VALUE c, VALUE d);
|
13
|
+
|
10
14
|
void Init_statsamplert()
|
11
15
|
{
|
12
16
|
VALUE mStatsample;
|
@@ -32,6 +36,7 @@ void Init_statsamplert()
|
|
32
36
|
rb_define_module_function(mSTATSAMPLE__,"set_valid_data_intern", statsample_set_valid_data_intern, 1);
|
33
37
|
rb_define_module_function(mSTATSAMPLE__,"case_as_hash",statsample_case_as_hash,2);
|
34
38
|
rb_define_module_function(mSTATSAMPLE__,"case_as_array",statsample_case_as_array,2);
|
39
|
+
rb_define_module_function(mSTATSAMPLE__,"tetrachoric",statsample_tetrachoric,4);
|
35
40
|
|
36
41
|
}
|
37
42
|
|
@@ -78,7 +83,7 @@ VALUE statsample_set_valid_data_intern(VALUE self, VALUE vector) {
|
|
78
83
|
VALUE statsample_frequencies(VALUE self, VALUE data) {
|
79
84
|
VALUE h;
|
80
85
|
VALUE val;
|
81
|
-
|
86
|
+
long len;
|
82
87
|
long i;
|
83
88
|
|
84
89
|
Check_Type(data,T_ARRAY);
|
@@ -128,3 +133,38 @@ VALUE statsample_case_as_array(VALUE self, VALUE ds, VALUE index) {
|
|
128
133
|
return ar;
|
129
134
|
}
|
130
135
|
|
136
|
+
|
137
|
+
|
138
|
+
VALUE statsample_tetrachoric(VALUE self, VALUE a, VALUE b, VALUE c, VALUE d) {
|
139
|
+
VALUE h=rb_hash_new();
|
140
|
+
double pa;
|
141
|
+
double pb;
|
142
|
+
double pc;
|
143
|
+
double pd;
|
144
|
+
double r;
|
145
|
+
double sdr;
|
146
|
+
double sdzero;
|
147
|
+
double t_x;
|
148
|
+
double t_y;
|
149
|
+
|
150
|
+
int itype;
|
151
|
+
int ifault;
|
152
|
+
int result;
|
153
|
+
pa=NUM2DBL(a);
|
154
|
+
pb=NUM2DBL(b);
|
155
|
+
pc=NUM2DBL(c);
|
156
|
+
pd=NUM2DBL(d);
|
157
|
+
|
158
|
+
result= tetra(&pa,&pb, &pc, &pd, &r,
|
159
|
+
&sdr, &sdzero, &t_x,&t_y, &itype, &ifault);
|
160
|
+
rb_hash_aset(h, rb_str_new_cstr("r"), DBL2NUM(r));
|
161
|
+
rb_hash_aset(h, rb_str_new_cstr("sdr"), DBL2NUM(sdr));
|
162
|
+
rb_hash_aset(h, rb_str_new_cstr("sdzero"), DBL2NUM(sdzero));
|
163
|
+
rb_hash_aset(h, rb_str_new_cstr("threshold_x"), DBL2NUM(t_x));
|
164
|
+
rb_hash_aset(h, rb_str_new_cstr("threshold_y"), DBL2NUM(t_y));
|
165
|
+
rb_hash_aset(h, rb_str_new_cstr("itype"), INT2NUM(itype));
|
166
|
+
rb_hash_aset(h, rb_str_new_cstr("ifault"), INT2NUM(ifault));
|
167
|
+
|
168
|
+
return h;
|
169
|
+
|
170
|
+
}
|
@@ -39,5 +39,15 @@ class TestRubyStatsampleOpt < Test::Unit::TestCase
|
|
39
39
|
ds={"a"=>a,"b"=>b}.to_dataset
|
40
40
|
assert_equal({"a"=>1,"b"=>4},Statsample::STATSAMPLE__.case_as_hash(ds,0))
|
41
41
|
end
|
42
|
+
def test_tetrachoric
|
43
|
+
assert(Statsample::STATSAMPLE__.respond_to?(:tetrachoric))
|
44
|
+
a,b,c,d = 30,40,70,20
|
45
|
+
result=Statsample::STATSAMPLE__.tetrachoric(a,b,c,d)
|
46
|
+
assert_in_delta(-0.53980, result['r'], 0.0001)
|
47
|
+
assert_in_delta(0.09940, result['sdr'], 0.0001)
|
48
|
+
assert_in_delta(-0.15731, result['threshold_x'], 0.0001)
|
49
|
+
assert_in_delta(0.31864, result['threshold_y'], 0.0001)
|
50
|
+
|
51
|
+
end
|
42
52
|
|
43
53
|
end
|
metadata
CHANGED
@@ -1,13 +1,13 @@
|
|
1
1
|
--- !ruby/object:Gem::Specification
|
2
2
|
name: statsample-optimization
|
3
3
|
version: !ruby/object:Gem::Version
|
4
|
-
hash:
|
4
|
+
hash: 11
|
5
5
|
prerelease: false
|
6
6
|
segments:
|
7
7
|
- 2
|
8
|
+
- 1
|
8
9
|
- 0
|
9
|
-
|
10
|
-
version: 2.0.5
|
10
|
+
version: 2.1.0
|
11
11
|
platform: ruby
|
12
12
|
authors:
|
13
13
|
- Claudio Bustos
|
@@ -36,7 +36,7 @@ cert_chain:
|
|
36
36
|
rpP0jjs0
|
37
37
|
-----END CERTIFICATE-----
|
38
38
|
|
39
|
-
date: 2010-
|
39
|
+
date: 2010-12-22 00:00:00 -03:00
|
40
40
|
default_executable:
|
41
41
|
dependencies:
|
42
42
|
- !ruby/object:Gem::Dependency
|
@@ -47,12 +47,11 @@ dependencies:
|
|
47
47
|
requirements:
|
48
48
|
- - ~>
|
49
49
|
- !ruby/object:Gem::Version
|
50
|
-
hash:
|
50
|
+
hash: 41
|
51
51
|
segments:
|
52
52
|
- 0
|
53
|
-
-
|
54
|
-
|
55
|
-
version: 0.15.1
|
53
|
+
- 17
|
54
|
+
version: "0.17"
|
56
55
|
type: :runtime
|
57
56
|
version_requirements: *id001
|
58
57
|
- !ruby/object:Gem::Dependency
|
@@ -78,12 +77,11 @@ dependencies:
|
|
78
77
|
requirements:
|
79
78
|
- - ~>
|
80
79
|
- !ruby/object:Gem::Version
|
81
|
-
hash:
|
80
|
+
hash: 19
|
82
81
|
segments:
|
83
82
|
- 1
|
84
|
-
-
|
85
|
-
|
86
|
-
version: 1.12.109
|
83
|
+
- 14
|
84
|
+
version: "1.14"
|
87
85
|
type: :runtime
|
88
86
|
version_requirements: *id003
|
89
87
|
- !ruby/object:Gem::Dependency
|
@@ -101,37 +99,21 @@ dependencies:
|
|
101
99
|
type: :runtime
|
102
100
|
version_requirements: *id004
|
103
101
|
- !ruby/object:Gem::Dependency
|
104
|
-
name:
|
102
|
+
name: hoe
|
105
103
|
prerelease: false
|
106
104
|
requirement: &id005 !ruby/object:Gem::Requirement
|
107
105
|
none: false
|
108
106
|
requirements:
|
109
107
|
- - ">="
|
110
108
|
- !ruby/object:Gem::Version
|
111
|
-
hash:
|
109
|
+
hash: 47
|
112
110
|
segments:
|
113
111
|
- 2
|
112
|
+
- 8
|
114
113
|
- 0
|
115
|
-
|
116
|
-
version: 2.0.4
|
114
|
+
version: 2.8.0
|
117
115
|
type: :development
|
118
116
|
version_requirements: *id005
|
119
|
-
- !ruby/object:Gem::Dependency
|
120
|
-
name: hoe
|
121
|
-
prerelease: false
|
122
|
-
requirement: &id006 !ruby/object:Gem::Requirement
|
123
|
-
none: false
|
124
|
-
requirements:
|
125
|
-
- - ">="
|
126
|
-
- !ruby/object:Gem::Version
|
127
|
-
hash: 19
|
128
|
-
segments:
|
129
|
-
- 2
|
130
|
-
- 6
|
131
|
-
- 2
|
132
|
-
version: 2.6.2
|
133
|
-
type: :development
|
134
|
-
version_requirements: *id006
|
135
117
|
description: |-
|
136
118
|
Install gsl, statistics2 and provides a C extension to optimize the following methods
|
137
119
|
|
@@ -154,6 +136,8 @@ files:
|
|
154
136
|
- Manifest.txt
|
155
137
|
- README.txt
|
156
138
|
- Rakefile
|
139
|
+
- ext/statsamplert/as116.c
|
140
|
+
- ext/statsamplert/as116.h
|
157
141
|
- ext/statsamplert/extconf.rb
|
158
142
|
- ext/statsamplert/statsamplert.c
|
159
143
|
- test/test_statsample_optimization.rb
|
metadata.gz.sig
CHANGED
Binary file
|