annotate rDiff/src/locfit/Source/liblfev.c @ 0:0f80a5141704

version 0.3 uploaded
author vipints
date Thu, 14 Feb 2013 23:38:36 -0500
parents
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
0
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1 /*
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2 * Copyright 1996-2006 Catherine Loader.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3 */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
5 #include "mex.h"
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
6 /*
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
7 * Copyright 1996-2006 Catherine Loader.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
8 */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
9 #include "lfev.h"
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
10
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
11 extern void fitoptions();
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
12
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
13 static double hmin, gmin, sig2, pen, vr, tb;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
14 static lfit *blf;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
15 static design *bdes;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
16
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
17 int procvbind(des,lf,v)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
18 design *des;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
19 lfit *lf;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
20 int v;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
21 { double s0, s1, bi;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
22 int i, ii, k;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
23 k = procv_var(des,lf,v);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
24 wdiag(&lf->lfd, &lf->sp, des,des->wd,&lf->dv,0,1,0);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
25 s0 = s1 = 0.0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
26 for (i=0; i<des->n; i++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
27 { ii = des->ind[i];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
28 s0+= prwt(&lf->lfd,ii)*des->wd[i]*des->wd[i];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
29 bi = prwt(&lf->lfd,ii)*fabs(des->wd[i]*ipower(dist(des,ii),deg(&lf->sp)+1));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
30 s1+= bi*bi;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
31 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
32 vr += s0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
33 tb += s1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
34 return(k);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
35 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
36
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
37 double bcri(h,c,cri)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
38 double h;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
39 int c, cri;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
40 { double num, den, res[10];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
41 int (*pv)();
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
42 if (c==DALP)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
43 blf->sp.nn = h;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
44 else
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
45 blf->sp.fixh = h;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
46 if ((cri&63)==BIND)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
47 { pv = procvbind;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
48 vr = tb = 0.0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
49 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
50 else pv = procvstd;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
51 if (cri<64) startlf(bdes,blf,pv,0);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
52 switch(cri&63)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
53 { case BGCV:
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
54 ressumm(blf,bdes,res);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
55 num = -2*blf->lfd.n*res[0];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
56 den = blf->lfd.n-res[1];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
57 return(num/(den*den));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
58 case BCP:
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
59 ressumm(blf,bdes,res);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
60 return(-2*res[0]/sig2-blf->lfd.n+pen*res[1]);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
61 case BIND:
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
62 return(vr+pen*pen*tb);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
63 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
64 LERR(("bcri: unknown criterion"));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
65 return(0.0);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
66 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
67
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
68 void bsel2(h0,g0,ifact,c,cri)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
69 double h0, g0, ifact;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
70 int c, cri;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
71 { int done, inc;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
72 double h1, g1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
73 h1 = h0; g1 = g0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
74 done = inc = 0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
75 while (!done)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
76 { h1 *= 1+ifact;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
77 g0 = g1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
78 g1 = bcri(h1,c,cri);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
79 if (g1<gmin) { hmin = h1; gmin = g1; }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
80 if (g1>g0) inc++; else inc = 0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
81 switch(cri)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
82 { case BIND:
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
83 done = (inc>=4) & (vr<blf->fp.nv);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
84 break;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
85 default:
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
86 done = (inc>=4);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
87 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
88 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
89 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
90
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
91 void bsel3(h0,g0,ifact,c,cri)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
92 double h0, g0, ifact;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
93 int c, cri;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
94 { double h1, g1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
95 int i;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
96 hmin = h0; gmin = g0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
97 for (i=-1; i<=1; i++) if (i!=0)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
98 { h1 = h0*(1+i*ifact);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
99 g1 = bcri(h1,c,cri);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
100 if (g1<gmin) { hmin = h1; gmin = g1; }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
101 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
102 return;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
103 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
104
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
105 void bselect(lf,des,c,cri,pn)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
106 lfit *lf;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
107 design *des;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
108 int c, cri;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
109 double pn;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
110 { double h0, g0, ifact;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
111 int i;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
112 pen = pn;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
113 blf = lf;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
114 bdes = des;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
115 if (cri==BIND) pen /= factorial(deg(&lf->sp)+1);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
116 hmin = h0 = (c==DFXH) ? fixh(&lf->sp) : nn(&lf->sp);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
117 if (h0==0) LERR(("bselect: initial bandwidth is 0"));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
118 if (lf_error) return;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
119 sig2 = 1.0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
120
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
121 gmin = g0 = bcri(h0,c,cri);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
122 if (cri==BCP)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
123 { sig2 = rv(&lf->fp);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
124 g0 = gmin = bcri(h0,c,cri+64);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
125 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
126
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
127 ifact = 0.3;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
128 bsel2(h0,g0,ifact,c,cri);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
129
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
130 for (i=0; i<5; i++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
131 { ifact = ifact/2;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
132 bsel3(hmin,gmin,ifact,c,cri);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
133 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
134 if (c==DFXH)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
135 fixh(&lf->sp) = hmin;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
136 else
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
137 nn(&lf->sp) = hmin;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
138 startlf(des,lf,procvstd,0);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
139 ressumm(lf,des,lf->fp.kap);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
140 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
141
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
142 double compsda(x,h,n)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
143 double *x, h;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
144 int n;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
145 /* n/(n-1) * int( fhat''(x)^2 dx ); bandwidth h */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
146 { int i, j;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
147 double ik, sd, z;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
148 ik = wint(1,NULL,0,WGAUS);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
149 sd = 0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
150
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
151 for (i=0; i<n; i++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
152 for (j=i; j<n; j++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
153 { z = (x[i]-x[j])/h;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
154 sd += (2-(i==j))*Wconv4(z,WGAUS)/(ik*ik);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
155 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
156 sd = sd/(n*(n-1)*h*h*h*h*h);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
157 return(sd);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
158 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
159
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
160 double widthsj(x,lambda,n)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
161 double *x, lambda;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
162 int n;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
163 { double ik, a, b, td, sa, z, c, c1, c2, c3;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
164 int i, j;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
165 a = GFACT*0.920*lambda*exp(-log((double)n)/7)/SQRT2;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
166 b = GFACT*0.912*lambda*exp(-log((double)n)/9)/SQRT2;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
167 ik = wint(1,NULL,0,WGAUS);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
168
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
169 td = 0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
170 for (i=0; i<n; i++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
171 for (j=i; j<n; j++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
172 { z = (x[i]-x[j])/b;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
173 td += (2-(i==j))*Wconv6(z,WGAUS)/(ik*ik);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
174 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
175
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
176 td = -td/(n*(n-1));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
177 j = 2.0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
178 c1 = Wconv4(0.0,WGAUS);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
179 c2 = wint(1,&j,1,WGAUS);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
180 c3 = Wconv(0.0,WGAUS); /* (2*c1/(c2*c3))^(1/7)=1.357 */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
181 sa = compsda(x,a,n);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
182 c = b*exp(log(c1*ik/(c2*c3*GFACT*GFACT*GFACT*GFACT)*sa/td)/7)*SQRT2;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
183 return(c);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
184 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
185
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
186 void kdecri(x,h,res,c,k,ker,n)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
187 double *x, h, *res, c;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
188 int k, ker, n;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
189 { int i, j;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
190 double degfree, dfd, pen, s, r0, r1, d0, d1, ik, wij;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
191
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
192 if (h<=0) WARN(("kdecri, h = %6.4f",h));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
193
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
194 res[0] = res[1] = 0.0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
195 ik = wint(1,NULL,0,ker);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
196 switch(k)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
197 { case 1: /* aic */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
198 pen = 2.0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
199 for (i=0; i<n; i++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
200 { r0 = d0 = 0.0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
201 for (j=0; j<n; j++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
202 { s = (x[i]-x[j])/h;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
203 r0 += W(s,ker);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
204 d0 += s*s*Wd(s,ker);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
205 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
206 d0 = -(d0+r0)/(n*h*h*ik); /* d0 = d/dh fhat(xi) */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
207 r0 /= n*h*ik; /* r0 = fhat(xi) */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
208 res[0] += -2*log(r0)+pen*W(0.0,ker)/(n*h*ik*r0);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
209 res[1] += -2*d0/r0-pen*W(0.0,ker)/(n*h*ik*r0)*(d0/r0+1.0/h);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
210 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
211 return;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
212 case 2: /* ocv */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
213 for (i=0; i<n; i++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
214 { r0 = 0.0; d0 = 0.0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
215 for (j=0; j<n; j++) if (i!=j)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
216 { s = (x[i]-x[j])/h;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
217 r0 += W(s,ker);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
218 d0 += s*s*Wd(s,ker);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
219 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
220 d0 = -(d0+r0)/((n-1)*h*h);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
221 r0 = r0/((n-1)*h);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
222 res[0] -= log(r0);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
223 res[1] -= d0/r0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
224 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
225 return;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
226 case 3: /* lscv */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
227 r0 = r1 = d0 = d1 = degfree = 0.0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
228 for (i=0; i<n; i++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
229 { dfd = 0.0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
230 for (j=0; j<n; j++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
231 { s = (x[i]-x[j])/h;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
232 wij = W(s,ker);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
233 dfd += wij;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
234 /*
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
235 * r0 = \int fhat * fhat = sum_{i,j} W*W( (Xi-Xj)/h ) / n^2 h.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
236 * d0 is it's derivative wrt h.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
237 *
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
238 * r1 = 1/n sum( f_{-i}(X_i) ).
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
239 * d1 is it's derivative wrt h.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
240 *
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
241 * degfree = sum_i ( W_0 / sum_j W( (Xi-Xj)/h ) ) is fitted d.f.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
242 */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
243 r0 += Wconv(s,ker);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
244 d0 += -s*s*Wconv1(s,ker);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
245 if (i != j)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
246 { r1 += wij;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
247 d1 += -s*s*Wd(s,ker);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
248 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
249 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
250 degfree += 1.0/dfd;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
251 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
252 d1 -= r1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
253 d0 -= r0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
254 res[0] = r0/(n*n*h*ik*ik) - 2*r1/(n*(n-1)*h*ik);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
255 res[1] = d0/(n*n*h*h*ik*ik) - 2*d1/(n*(n-1)*h*h*ik);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
256 res[2] = degfree;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
257 return;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
258 case 4: /* bcv */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
259 r0 = d0 = 0.0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
260 for (i=0; i<n; i++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
261 for (j=i+1; j<n; j++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
262 { s = (x[i]-x[j])/h;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
263 r0 += 2*Wconv4(s,ker);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
264 d0 += 2*s*Wconv5(s,ker);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
265 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
266 d0 = (-d0-r0)/(n*n*h*h*ik*ik);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
267 r0 = r0/(n*n*h*ik*ik);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
268 j = 2.0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
269 d1 = wint(1,&j,1,ker);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
270 r1 = Wconv(0.0,ker);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
271 res[0] = (d1*d1*r0/4+r1/(n*h))/(ik*ik);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
272 res[1] = (d1*d1*d0/4-r1/(n*h*h))/(ik*ik);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
273 return;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
274 case 5: /* sjpi */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
275 s = c*exp(5*log(h)/7)/SQRT2;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
276 d0 = compsda(x,s,n);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
277 res[0] = d0; /* this is S(alpha) in SJ */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
278 res[1] = exp(log(Wikk(WGAUS,0)/(d0*n))/5)-h;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
279 return;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
280 case 6: /* gas-k-k */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
281 s = exp(log(1.0*n)/10)*h;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
282 d0 = compsda(x,s,n);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
283 res[0] = d0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
284 res[1] = exp(log(Wikk(WGAUS,0)/(d0*n))/5)-h;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
285 return;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
286 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
287 LERR(("kdecri: what???"));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
288 return;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
289 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
290
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
291 double esolve(x,j,h0,h1,k,c,ker,n)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
292 double *x, h0, h1, c;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
293 int j, k, ker, n;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
294 { double h[7], d[7], r[7], res[4], min, minh, fact;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
295 int i, nc;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
296 min = 1.0e30; minh = 0.0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
297 fact = 1.00001;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
298 h[6] = h0; kdecri(x,h[6],res,c,j,ker,n);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
299 r[6] = res[0]; d[6] = res[1];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
300 if (lf_error) return(0.0);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
301 nc = 0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
302 for (i=0; i<k; i++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
303 { h[5] = h[6]; r[5] = r[6]; d[5] = d[6];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
304 h[6] = h0*exp((i+1)*log(h1/h0)/k);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
305 kdecri(x,h[6],res,c,j,ker,n);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
306 r[6] = res[0]; d[6] = res[1];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
307 if (lf_error) return(0.0);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
308 if (d[5]*d[6]<0)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
309 { h[2] = h[0] = h[5]; d[2] = d[0] = d[5]; r[2] = r[0] = r[5];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
310 h[3] = h[1] = h[6]; d[3] = d[1] = d[6]; r[3] = r[1] = r[6];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
311 while ((h[3]>fact*h[2])|(h[2]>fact*h[3]))
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
312 { h[4] = h[3]-d[3]*(h[3]-h[2])/(d[3]-d[2]);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
313 if ((h[4]<h[0]) | (h[4]>h[1])) h[4] = (h[0]+h[1])/2;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
314 kdecri(x,h[4],res,c,j,ker,n);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
315 r[4] = res[0]; d[4] = res[1];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
316 if (lf_error) return(0.0);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
317 h[2] = h[3]; h[3] = h[4];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
318 d[2] = d[3]; d[3] = d[4];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
319 r[2] = r[3]; r[3] = r[4];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
320 if (d[4]*d[0]>0) { h[0] = h[4]; d[0] = d[4]; r[0] = r[4]; }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
321 else { h[1] = h[4]; d[1] = d[4]; r[1] = r[4]; }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
322 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
323 if (j>=4) return(h[4]); /* first min for BCV etc */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
324 if (r[4]<=min) { min = r[4]; minh = h[4]; }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
325 nc++;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
326 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
327 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
328 if (nc==0) minh = (r[5]<r[6]) ? h0 : h1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
329 return(minh);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
330 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
331
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
332 void kdeselect(band,x,ind,h0,h1,meth,nm,ker,n)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
333 double h0, h1, *band, *x;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
334 int *ind, nm, ker, n, *meth;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
335 { double scale, c;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
336 int i, k;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
337 k = n/4;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
338 for (i=0; i<n; i++) ind[i] = i;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
339 scale = kordstat(x,n+1-k,n,ind) - kordstat(x,k,n,ind);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
340 c = widthsj(x,scale,n);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
341 for (i=0; i<nm; i++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
342 band[i] = esolve(x,meth[i],h0,h1,10,c,ker,n);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
343 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
344 /*
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
345 * Copyright 1996-2006 Catherine Loader.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
346 */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
347 /*
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
348 * The function dens_integrate(lf,des,z) is used to integrate a density
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
349 * estimate (z=1) or the density squared (z=2). This is used to renormalize
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
350 * the estimate (function dens_renorm) or in the computation of LSCV
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
351 * (in modlscv.c). The implementation is presently for d=1.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
352 *
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
353 * The computation orders the fit points selected by locfit, and
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
354 * integrates analytically over each interval. For the log-link,
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
355 * the interpolant used is peicewise quadratic (with one knot in
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
356 * the middle of each interval); this differs from the cubic interpolant
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
357 * used elsewhere in Locfit.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
358 *
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
359 * TODO: allow for xlim. What can be done simply in >=2 dimensions?
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
360 */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
361
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
362 #include "lfev.h"
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
363
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
364 /*
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
365 * Finds the order of observations in the array x, and
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
366 * stores in integer array ind.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
367 * At input, lset l=0 and r=length(x)-1.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
368 * At output, x[ind[0]] <= x[ind[1]] <= ...
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
369 */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
370 void lforder(ind,x,l,r)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
371 int *ind, l, r;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
372 double *x;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
373 { double piv;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
374 int i, i0, i1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
375 piv = (x[ind[l]]+x[ind[r]])/2;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
376 i0 = l; i1 = r;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
377 while (i0<=i1)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
378 { while ((i0<=i1) && (x[ind[i0]]<=piv)) i0++;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
379 while ((i0<=i1) && (x[ind[i1]]>piv)) i1--;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
380 if (i0<i1)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
381 { ISWAP(ind[i0],ind[i1]);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
382 i0++; i1--;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
383 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
384 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
385 /* now, x[ind[l..i1]] <= piv < x[ind[i0..r]].
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
386 put the ties in the middle */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
387 while ((i1>=l) && (x[ind[i1]]==piv)) i1--;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
388 for (i=l; i<=i1; i++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
389 if (x[ind[i]]==piv)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
390 { ISWAP(ind[i],ind[i1]);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
391 while (x[ind[i1]]==piv) i1--;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
392 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
393
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
394 if (l<i1) lforder(ind,x,l,i1);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
395 if (i0<r) lforder(ind,x,i0,r);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
396 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
397
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
398 /*
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
399 * estdiv integrates the density between fit points x0 and x1.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
400 * f0, f1 are function values, d0, d1 are derivatives.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
401 */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
402 double estdiv(x0,x1,f0,f1,d0,d1,lin)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
403 double x0, x1, f0, f1, d0, d1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
404 int lin;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
405 { double cf[4], I[2], dlt, e0, e1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
406
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
407 if (x0==x1) return(0.0);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
408
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
409 if (lin==LIDENT)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
410 {
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
411 /* cf are integrals of hermite polynomials.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
412 * Then adjust for x1-x0.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
413 */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
414 cf[0] = cf[1] = 0.5;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
415 cf[2] = 1.0/12.0; cf[3] = -cf[2];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
416 return( (cf[0]*f0+cf[1]*f1)*(x1-x0)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
417 + (cf[2]*d0+cf[3]*d1)*(x1-x0)*(x1-x0) );
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
418 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
419
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
420 /*
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
421 * this is for LLOG
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
422 */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
423
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
424 dlt = (x1-x0)/2;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
425 cf[0] = f0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
426 cf[1] = d0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
427 cf[2] = ( 2*(f1-f0) - dlt*(d1+3*d0) )/(4*dlt*dlt);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
428 recurint(0.0,dlt,cf,I,0,WRECT);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
429 e0 = I[0];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
430
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
431 cf[0] = f1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
432 cf[1] = -d1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
433 cf[2] = ( 2*(f0-f1) + dlt*(d0+3*d1) )/( 4*dlt*dlt );
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
434 recurint(0.0,dlt,cf,I,0,WRECT);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
435 e1 = I[0];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
436
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
437 return(e0+e1);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
438 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
439
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
440 /*
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
441 * Evaluate the integral of the density estimate to the power z.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
442 * This would be severely messed up, if I ever implement parcomp
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
443 * for densities.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
444 */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
445 double dens_integrate(lf,des,z)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
446 lfit *lf;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
447 design *des;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
448 int z;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
449 { int has_deriv, i, i0, i1, nv, *ind;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
450 double *xev, *fit, *deriv, sum, term;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
451 double d0, d1, f0, f1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
452 fitpt *fp;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
453
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
454 fp = &lf->fp;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
455
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
456 if (fp->d >= 2)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
457 { WARN(("dens_integrate requires d=1"));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
458 return(0.0);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
459 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
460
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
461 has_deriv = (deg(&lf->sp) > 0); /* not right? */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
462 fit = fp->coef;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
463 if (has_deriv)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
464 deriv = &fit[fp->nvm];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
465 xev = evp(fp);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
466
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
467 /*
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
468 * order the vertices
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
469 */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
470 nv = fp->nv;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
471 if (lf->lfd.n<nv) return(0.0);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
472 ind = des->ind;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
473 for (i=0; i<nv; i++) ind[i] = i;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
474 lforder(ind,xev,0,nv-1);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
475 sum = 0.0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
476
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
477 /*
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
478 * Estimate the contribution of the boundaries.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
479 * should really check flim here.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
480 */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
481 i0 = ind[0]; i1 = ind[1];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
482 f1 = fit[i0];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
483 d1 = (has_deriv) ? deriv[i0] :
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
484 (fit[i1]-fit[i0])/(xev[i1]-xev[i0]);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
485 if (d1 <= 0) WARN(("dens_integrate - ouch!"));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
486 if (z==2)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
487 { if (link(&lf->sp)==LLOG)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
488 { f1 *= 2; d1 *= 2; }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
489 else
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
490 { d1 = 2*d1*f1; f1 = f1*f1; }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
491 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
492 term = (link(&lf->sp)==LIDENT) ? f1*f1/(2*d1) : exp(f1)/d1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
493 sum += term;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
494
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
495 i0 = ind[nv-2]; i1 = ind[nv-1];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
496 f0 = fit[i1];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
497 d0 = (has_deriv) ? deriv[i1] :
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
498 (fit[i1]-fit[i0])/(xev[i1]-xev[i0]);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
499 if (d0 >= 0) WARN(("dens_integrate - ouch!"));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
500 if (z==2)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
501 { if (link(&lf->sp)==LLOG)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
502 { f0 *= 2; d0 *= 2; }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
503 else
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
504 { d0 = 2*d0*f0; f0 = f0*f0; }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
505 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
506 term = (link(&lf->sp)==LIDENT) ? -f0*f0/(2*d0) : exp(f0)/d0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
507 sum += term;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
508
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
509 for (i=1; i<nv; i++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
510 { i0 = ind[i-1]; i1 = ind[i];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
511 f0 = fit[i0]; f1 = fit[i1];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
512 d0 = (has_deriv) ? deriv[i0] :
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
513 (f1-f0)/(xev[i1]-xev[i0]);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
514 d1 = (has_deriv) ? deriv[i1] : d0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
515 if (z==2)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
516 { if (link(&lf->sp)==LLOG)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
517 { f0 *= 2; f1 *= 2; d0 *= 2; d1 *= 2; }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
518 else
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
519 { d0 *= 2*f0; d1 *= 2*f1; f0 = f0*f0; f1 = f1*f1; }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
520 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
521 term = estdiv(xev[i0],xev[i1],f0,f1,d0,d1,link(&lf->sp));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
522 sum += term;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
523 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
524
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
525 return(sum);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
526 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
527
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
528 void dens_renorm(lf,des)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
529 lfit *lf;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
530 design *des;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
531 { int i;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
532 double sum;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
533 sum = dens_integrate(lf,des,1);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
534 if (sum==0.0) return;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
535 sum = log(sum);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
536 for (i=0; i<lf->fp.nv; i++) lf->fp.coef[i] -= sum;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
537 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
538 /*
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
539 * Copyright 1996-2006 Catherine Loader.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
540 */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
541 /*
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
542 * This file contains functions for constructing and
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
543 * interpolating the adaptive tree structure. This is
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
544 * the default evaluation structure used by Locfit.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
545 */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
546
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
547 #include "lfev.h"
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
548
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
549 /*
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
550 Guess the number of fitting points.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
551 Needs improving!
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
552 */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
553 void atree_guessnv(evs,nvm,ncm,vc,d,alp)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
554 evstruc *evs;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
555 double alp;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
556 int *nvm, *ncm, *vc, d;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
557 { double a0, cu, ifl;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
558 int i, nv, nc;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
559
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
560 *ncm = 1<<30; *nvm = 1<<30;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
561 *vc = 1 << d;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
562
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
563 if (alp>0)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
564 { a0 = (alp > 1) ? 1 : 1/alp;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
565 if (cut(evs)<0.01)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
566 { WARN(("guessnv: cut too small."));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
567 cut(evs) = 0.01;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
568 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
569 cu = 1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
570 for (i=0; i<d; i++) cu *= MIN(1.0,cut(evs));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
571 nv = (int)((5*a0/cu)**vc); /* this allows 10*a0/cu splits */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
572 nc = (int)(10*a0/cu+1); /* and 10*a0/cu cells */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
573 if (nv<*nvm) *nvm = nv;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
574 if (nc<*ncm) *ncm = nc;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
575 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
576
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
577 if (*nvm == 1<<30) /* by default, allow 100 splits */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
578 { *nvm = 102**vc;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
579 *ncm = 201;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
580 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
581
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
582 /* inflation based on mk */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
583 ifl = mk(evs)/100.0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
584 *nvm = *vc+(int)(ifl**nvm);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
585 *ncm = (int)(ifl**ncm);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
586
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
587 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
588
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
589 /*
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
590 Determine whether a cell in the tree needs splitting.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
591 If so, return the split variable (0..d-1).
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
592 Otherwise, return -1.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
593 */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
594 int atree_split(lf,ce,le,ll,ur)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
595 lfit *lf;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
596 int *ce;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
597 double *le, *ll, *ur;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
598 { int d, vc, i, is;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
599 double h, hmin, score[MXDIM];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
600 d = lf->fp.d; vc = 1<<d;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
601
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
602 hmin = 0.0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
603 for (i=0; i<vc; i++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
604 { h = lf->fp.h[ce[i]];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
605 if ((h>0) && ((hmin==0)|(h<hmin))) hmin = h;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
606 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
607
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
608 is = 0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
609 for (i=0; i<d; i++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
610 { le[i] = (ur[i]-ll[i])/lf->lfd.sca[i];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
611 if ((lf->lfd.sty[i]==STCPAR) || (hmin==0))
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
612 score[i] = 2*(ur[i]-ll[i])/(lf->evs.fl[i+d]-lf->evs.fl[i]);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
613 else
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
614 score[i] = le[i]/hmin;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
615 if (score[i]>score[is]) is = i;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
616 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
617 if (cut(&lf->evs)<score[is]) return(is);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
618 return(-1);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
619 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
620
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
621 /*
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
622 recursively grow the tree structure, begining with the parent cell.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
623 */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
624 void atree_grow(des,lf,ce,ct,term,ll,ur)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
625 design *des;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
626 lfit *lf;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
627 int *ce, *ct, *term;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
628 double *ll, *ur;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
629 { int nce[1<<MXDIM];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
630 int i, i0, i1, d, vc, pv, tk, ns;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
631 double le[MXDIM], z;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
632 d = lf->fp.d; vc = 1<<d;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
633
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
634 /* does this cell need splitting?
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
635 If not, wrap up and return.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
636 */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
637 ns = atree_split(lf,ce,le,ll,ur);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
638 if (ns==-1)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
639 { if (ct != NULL) /* reconstructing terminal cells */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
640 { for (i=0; i<vc; i++) term[*ct*vc+i] = ce[i];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
641 (*ct)++;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
642 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
643 return;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
644 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
645
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
646 /* split the cell at the midpoint on side ns */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
647 tk = 1<<ns;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
648 for (i=0; i<vc; i++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
649 { if ((i&tk)==0) nce[i] = ce[i];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
650 else
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
651 { i0 = ce[i];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
652 i1 = ce[i-tk];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
653 pv = (lf->lfd.sty[i]!=STCPAR) &&
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
654 (le[ns] < (cut(&lf->evs)*MIN(lf->fp.h[i0],lf->fp.h[i1])));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
655 nce[i] = newsplit(des,lf,i0,i1,pv);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
656 if (lf_error) return;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
657 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
658 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
659 z = ur[ns]; ur[ns] = (z+ll[ns])/2;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
660 atree_grow(des,lf,nce,ct,term,ll,ur);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
661 if (lf_error) return;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
662 ur[ns] = z;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
663 for (i=0; i<vc; i++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
664 nce[i] = ((i&tk)== 0) ? nce[i+tk] : ce[i];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
665 z = ll[ns]; ll[ns] = (z+ur[ns])/2;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
666 atree_grow(des,lf,nce,ct,term,ll,ur);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
667 if (lf_error) return;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
668 ll[ns] = z;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
669 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
670
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
671 void atree_start(des,lf)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
672 design *des;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
673 lfit *lf;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
674 { int d, i, j, k, vc, ncm, nvm;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
675 double ll[MXDIM], ur[MXDIM];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
676
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
677 if (lf_debug>1) mut_printf(" In atree_start\n");
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
678 d = lf->fp.d;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
679 atree_guessnv(&lf->evs,&nvm,&ncm,&vc,d,nn(&lf->sp));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
680 if (lf_debug>2) mut_printf(" atree_start: nvm %d ncm %d\n",nvm,ncm);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
681 trchck(lf,nvm,ncm,vc);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
682
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
683 /* Set the lower left, upper right limits. */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
684 for (j=0; j<d; j++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
685 { ll[j] = lf->evs.fl[j];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
686 ur[j] = lf->evs.fl[j+d];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
687 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
688
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
689 /* Set the initial cell; fit at the vertices. */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
690 for (i=0; i<vc; i++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
691 { j = i;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
692 for (k=0; k<d; ++k)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
693 { evptx(&lf->fp,i,k) = (j%2) ? ur[k] : ll[k];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
694 j >>= 1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
695 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
696 lf->evs.ce[i] = i;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
697 PROC_VERTEX(des,lf,i);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
698 if (lf_error) return;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
699 lf->evs.s[i] = 0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
700 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
701 lf->fp.nv = vc;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
702
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
703 /* build the tree */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
704 atree_grow(des,lf,lf->evs.ce,NULL,NULL,ll,ur);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
705 lf->evs.nce = 1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
706 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
707
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
708 double atree_int(lf,x,what)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
709 lfit *lf;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
710 double *x;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
711 int what;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
712 { double vv[64][64], *ll, *ur, h, xx[MXDIM];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
713 int lo, tk, ns, nv, nc, d, i, vc;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
714 int ce[64];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
715 fitpt *fp;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
716 evstruc *evs;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
717
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
718 fp = &lf->fp;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
719 evs= &lf->evs;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
720 d = fp->d;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
721 vc = 1<<d;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
722
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
723 for (i=0; i<vc; i++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
724 { setzero(vv[i],vc);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
725 nc = exvval(fp,vv[i],i,d,what,1);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
726 ce[i] = evs->ce[i];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
727 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
728 ns = 0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
729 while(ns!=-1)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
730 { ll = evpt(fp,ce[0]); ur = evpt(fp,ce[vc-1]);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
731 ns = atree_split(lf,ce,xx,ll,ur);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
732 if (ns!=-1)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
733 { tk = 1<<ns;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
734 h = ur[ns]-ll[ns];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
735 lo = (2*(x[ns]-ll[ns])) < h;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
736 for (i=0; i<vc; i++) if ((tk&i)==0)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
737 { nv = findpt(fp,evs,(int)ce[i],(int)ce[i+tk]);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
738 if (nv==-1) LERR(("Descend tree problem"));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
739 if (lf_error) return(0.0);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
740 if (lo)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
741 { ce[i+tk] = nv;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
742 if (evs->s[nv]) exvvalpv(vv[i+tk],vv[i],vv[i+tk],d,ns,h,nc);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
743 else exvval(fp,vv[i+tk],nv,d,what,1);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
744 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
745 else
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
746 { ce[i] = nv;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
747 if (evs->s[nv]) exvvalpv(vv[i],vv[i],vv[i+tk],d,ns,h,nc);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
748 else exvval(fp,vv[i],nv,d,what,1);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
749 } }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
750 } }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
751 ll = evpt(fp,ce[0]); ur = evpt(fp,ce[vc-1]);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
752 return(rectcell_interp(x,vv,ll,ur,d,nc));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
753 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
754 /*
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
755 * Copyright 1996-2006 Catherine Loader.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
756 */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
757 #include "lfev.h"
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
758
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
759 double linear_interp(h,d,f0,f1)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
760 double h, d, f0, f1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
761 { if (d==0) return(f0);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
762 return( ( (d-h)*f0 + h*f1 ) / d );
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
763 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
764
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
765 void hermite2(x,z,phi)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
766 double x, z, *phi;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
767 { double h;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
768 if (z==0)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
769 { phi[0] = 1.0; phi[1] = phi[2] = phi[3] = 0.0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
770 return;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
771 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
772 h = x/z;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
773 if (h<0)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
774 { phi[0] = 1; phi[1] = 0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
775 phi[2] = h; phi[3] = 0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
776 return;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
777 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
778 if (h>1)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
779 { phi[0] = 0; phi[1] = 1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
780 phi[2] = 0; phi[3] = h-1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
781 return;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
782 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
783 phi[1] = h*h*(3-2*h);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
784 phi[0] = 1-phi[1];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
785 phi[2] = h*(1-h)*(1-h);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
786 phi[3] = h*h*(h - 1);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
787 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
788
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
789 double cubic_interp(h,f0,f1,d0,d1)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
790 double h, f0, f1, d0, d1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
791 { double phi[4];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
792 hermite2(h,1.0,phi);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
793 return(phi[0]*f0+phi[1]*f1+phi[2]*d0+phi[3]*d1);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
794 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
795
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
796 double cubintd(h,f0,f1,d0,d1)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
797 double h, f0, f1, d0, d1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
798 { double phi[4];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
799 phi[1] = 6*h*(1-h);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
800 phi[0] = -phi[1];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
801 phi[2] = (1-h)*(1-3*h);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
802 phi[3] = h*(3*h-2);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
803 return(phi[0]*f0+phi[1]*f1+phi[2]*d0+phi[3]*d1);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
804 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
805
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
806 /*
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
807 interpolate over a rectangular cell.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
808 x = interpolation point.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
809 vv = array of vertex values.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
810 ll = lower left corner.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
811 ur = upper right corner.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
812 d = dimension.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
813 nc = no of coefficients.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
814 */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
815 double rectcell_interp(x,vv,ll,ur,d,nc)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
816 double *x, vv[64][64], *ll, *ur;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
817 int d, nc;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
818 { double phi[4];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
819 int i, j, k, tk;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
820
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
821 tk = 1<<d;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
822 for (i=0; i<tk; i++) if (vv[i][0]==NOSLN) return(NOSLN);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
823
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
824 /* no derivatives - use multilinear interpolation */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
825 if (nc==1)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
826 { for (i=d-1; i>=0; i--)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
827 { tk = 1<<i;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
828 for (j=0; j<tk; j++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
829 vv[j][0] = linear_interp(x[i]-ll[i],ur[i]-ll[i],vv[j][0],vv[j+tk][0]);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
830 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
831 return(vv[0][0]);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
832 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
833
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
834 /* with derivatives -- use cubic */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
835 if (nc==d+1)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
836 { for (i=d-1; i>=0; i--)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
837 { hermite2(x[i]-ll[i],ur[i]-ll[i],phi);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
838 tk = 1<<i;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
839 phi[2] *= ur[i]-ll[i];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
840 phi[3] *= ur[i]-ll[i];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
841 for (j=0; j<tk; j++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
842 { vv[j][0] = phi[0]*vv[j][0] + phi[1]*vv[j+tk][0]
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
843 + phi[2]*vv[j][i+1] + phi[3]*vv[j+tk][i+1];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
844 for (k=1; k<=i; k++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
845 vv[j][k] = phi[0]*vv[j][k] + phi[1]*vv[j+tk][k];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
846 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
847 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
848 return(vv[0][0]);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
849 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
850
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
851 /* with all coefs -- use multicubic */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
852 for (i=d-1; i>=0; i--)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
853 { hermite2(x[i]-ll[i],ur[i]-ll[i],phi);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
854 tk = 1<<i;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
855 phi[2] *= ur[i]-ll[i];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
856 phi[3] *= ur[i]-ll[i];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
857 for (j=0; j<tk; j++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
858 for (k=0; k<tk; k++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
859 vv[j][k] = phi[0]*vv[j][k] + phi[1]*vv[j+tk][k]
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
860 + phi[2]*vv[j][k+tk] + phi[3]*vv[j+tk][k+tk];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
861 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
862 return(vv[0][0]);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
863 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
864
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
865 int exvval(fp,vv,nv,d,what,z)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
866 fitpt *fp;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
867 double *vv;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
868 int nv, d, z, what;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
869 { int i, k;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
870 double *values;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
871
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
872 k = (z) ? 1<<d : d+1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
873 for (i=1; i<k; i++) vv[i] = 0.0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
874 switch(what)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
875 { case PCOEF:
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
876 values = fp->coef;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
877 break;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
878 case PVARI:
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
879 case PNLX:
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
880 values = fp->nlx;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
881 break;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
882 case PT0:
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
883 values = fp->t0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
884 break;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
885 case PBAND:
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
886 vv[0] = fp->h[nv];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
887 return(1);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
888 case PDEGR:
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
889 vv[0] = fp->deg[nv];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
890 return(1);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
891 case PLIK:
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
892 vv[0] = fp->lik[nv];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
893 return(1);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
894 case PRDF:
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
895 vv[0] = fp->lik[2*fp->nvm+nv];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
896 return(1);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
897 default:
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
898 LERR(("Invalid what in exvval"));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
899 return(0);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
900 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
901 vv[0] = values[nv];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
902 if (!fp->hasd) return(1);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
903 if (z)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
904 { for (i=0; i<d; i++) vv[1<<i] = values[(i+1)*fp->nvm+nv];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
905 return(1<<d);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
906 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
907 else
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
908 { for (i=1; i<=d; i++) vv[i] = values[i*fp->nvm+nv];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
909 return(d+1);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
910 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
911 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
912
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
913 void exvvalpv(vv,vl,vr,d,k,dl,nc)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
914 double *vv, *vl, *vr, dl;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
915 int d, k, nc;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
916 { int i, tk, td;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
917 double f0, f1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
918 if (nc==1)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
919 { vv[0] = (vl[0]+vr[0])/2;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
920 return;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
921 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
922 tk = 1<<k;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
923 td = 1<<d;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
924 for (i=0; i<td; i++) if ((i&tk)==0)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
925 { f0 = (vl[i]+vr[i])/2 + dl*(vl[i+tk]-vr[i+tk])/8;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
926 f1 = 1.5*(vr[i]-vl[i])/dl - (vl[i+tk]+vr[i+tk])/4;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
927 vv[i] = f0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
928 vv[i+tk] = f1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
929 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
930 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
931
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
932 double grid_int(fp,evs,x,what)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
933 fitpt *fp;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
934 evstruc *evs;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
935 double *x;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
936 int what;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
937 { int d, i, j, jj, nc, sk, v[MXDIM], vc, z0, nce[1<<MXDIM], *mg;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
938 double *ll, *ur, vv[64][64], z;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
939
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
940 d = fp->d;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
941 ll = evpt(fp,0); ur = evpt(fp,fp->nv-1);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
942 mg = mg(evs);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
943
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
944 z0 = 0; vc = 1<<d;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
945 for (j=d-1; j>=0; j--)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
946 { v[j] = (int)((mg[j]-1)*(x[j]-ll[j])/(ur[j]-ll[j]));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
947 if (v[j]<0) v[j]=0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
948 if (v[j]>=mg[j]-1) v[j] = mg[j]-2;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
949 z0 = z0*mg[j]+v[j];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
950 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
951 nce[0] = z0; nce[1] = z0+1; sk = jj = 1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
952 for (i=1; i<d; i++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
953 { sk *= mg[i-1];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
954 jj<<=1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
955 for (j=0; j<jj; j++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
956 nce[j+jj] = nce[j]+sk;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
957 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
958 for (i=0; i<vc; i++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
959 nc = exvval(fp,vv[i],nce[i],d,what,1);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
960 ll = evpt(fp,nce[0]);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
961 ur = evpt(fp,nce[vc-1]);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
962 z = rectcell_interp(x,vv,ll,ur,d,nc);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
963 return(z);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
964 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
965
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
966 double fitp_int(fp,x,what,i)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
967 fitpt *fp;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
968 double *x;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
969 int what, i;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
970 { double vv[1+MXDIM];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
971 exvval(fp,vv,i,fp->d,what,0);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
972 return(vv[0]);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
973 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
974
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
975 double xbar_int(fp,x,what)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
976 fitpt *fp;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
977 double *x;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
978 int what;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
979 { int i, nc;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
980 double vv[1+MXDIM], f;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
981 nc = exvval(fp,vv,0,fp->d,what,0);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
982 f = vv[0];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
983 if (nc>1)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
984 for (i=0; i<fp->d; i++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
985 f += vv[i+1]*(x[i]-evptx(fp,0,i));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
986 return(f);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
987 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
988
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
989 double dointpoint(lf,x,what,ev,j)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
990 lfit *lf;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
991 double *x;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
992 int what, ev, j;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
993 { double xf, f, link[LLEN];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
994 int i, rt;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
995 fitpt *fp;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
996 evstruc *evs;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
997
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
998 fp = &lf->fp; evs = &lf->evs;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
999 for (i=0; i<fp->d; i++) if (lf->lfd.sty[i]==STANGL)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1000 { xf = floor(x[i]/(2*PI*lf->lfd.sca[i]));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1001 x[i] -= xf*2*PI*lf->lfd.sca[i];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1002 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1003 if (what > 64)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1004 { rt = what-64;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1005 what = PCOEF;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1006 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1007 else rt = 0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1008
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1009 switch(ev)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1010 { case EGRID: f = grid_int(fp,evs,x,what); break;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1011 case EKDTR: f = kdtre_int(fp,evs,x,what); break;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1012 case ETREE: f = atree_int(lf,x,what); break;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1013 case EPHULL: f = triang_int(lf,x,what); break;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1014 case EFITP: f = fitp_int(fp,x,what,j); break;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1015 case EXBAR: f = xbar_int(fp,x,what); break;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1016 case ENONE: f = 0; break;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1017 case ESPHR: f = sphere_int(lf,x,what); break;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1018 default: LERR(("dointpoint: cannot interpolate structure %d",ev));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1019 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1020 if (((what==PT0)|(what==PNLX)) && (f<0)) f = 0.0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1021 f += addparcomp(lf,x,what);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1022
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1023 if (rt>0)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1024 {
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1025 stdlinks(link,&lf->lfd,&lf->sp,j,f,rsc(fp));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1026 f = resid(resp(&lf->lfd,j),prwt(&lf->lfd,j),f,fam(&lf->sp),rt,link);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1027 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1028
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1029 return(f);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1030 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1031 /*
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1032 * Copyright 1996-2006 Catherine Loader.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1033 */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1034 /*
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1035 * Routines for building and interpolating the kd tree.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1036 * Initially, this started from the loess code.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1037 *
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1038 * Todo: EKDCE isn't working.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1039 */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1040
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1041 #include "lfev.h"
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1042
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1043 void newcell();
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1044 static int nterm;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1045
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1046 void kdtre_guessnv(evs,nvm,ncm,vc,n,d,alp)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1047 evstruc *evs;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1048 double alp;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1049 int *nvm, *ncm, *vc, n, d;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1050 { int k;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1051 if (ev(evs) == EKDTR)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1052 { nterm = (int)(cut(evs)/4 * n * MIN(alp,1.0) );
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1053 k = 2*n/nterm;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1054 *vc = 1<<d;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1055 *ncm = 2*k+1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1056 *nvm = (k+2)**vc/2;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1057 return;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1058 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1059 if (ev(evs) == EKDCE)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1060 { nterm = (int)(n * alp);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1061 *vc = 1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1062 *nvm = 1+(int)(2*n/nterm);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1063 *ncm = 2**nvm+1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1064 return;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1065 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1066 *nvm = *ncm = *vc = 0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1067 return;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1068 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1069
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1070 /*
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1071 Split x[pi[l..r]] into two equal sized sets.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1072
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1073 Let m=(l+r)/2.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1074 At return,
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1075 x[pi[l..m]] < x[pi[m+1..r]].
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1076 Assuming no ties:
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1077 If l+r is odd, the sets have the same size.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1078 If l+r is even, the low set is larger by 1.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1079 If there are ties, all ties go in the low set.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1080 */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1081 int ksmall(l, r, m, x, pi)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1082 int l, r, m, *pi;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1083 double *x;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1084 {
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1085 int il, ir, jl, jr;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1086 double t;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1087
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1088
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1089 while(l<r)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1090 { t = x[pi[m]];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1091
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1092 /*
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1093 permute the observations so that
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1094 x[pi[l..il]] < t <= x[pi[ir..r]].
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1095 */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1096 ir = l; il = r;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1097 while (ir<il)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1098 { while ((ir<=r) && (x[pi[ir]] < t)) ir++;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1099 while ((il>=l) && (x[pi[il]]>= t)) il--;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1100 if (ir<il) ISWAP(pi[ir],pi[il]);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1101 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1102
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1103 /*
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1104 move = t to the middle:
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1105 x[pi[l..il]] < t
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1106 x[pi[jl..jr]] = t
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1107 x[pi[ir..r]] > t
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1108 */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1109 jl = ir; jr = r;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1110 while (ir<jr)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1111 { while ((ir<=r) && (x[pi[ir]]== t)) ir++;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1112 while ((jr>=jl) && (x[pi[jr]] > t)) jr--;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1113 if (ir<jr) ISWAP(pi[ir],pi[jr]);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1114 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1115
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1116 /*
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1117 we're done if m is in the middle, jl <= m <= jr.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1118 */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1119 if ((jl<=m) & (jr>=m)) return(jr);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1120
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1121 /*
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1122 update l or r.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1123 */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1124 if (m>=ir) l = ir;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1125 if (m<=il) r = il;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1126 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1127 if (l==r) return(l);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1128 LERR(("ksmall failure"));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1129 return(0);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1130 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1131
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1132 int terminal(lf,p,pi,fc,d,m,split_val)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1133 lfit *lf;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1134 int p, d, fc, *m, *pi;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1135 double *split_val;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1136 { int i, k, lo, hi, split_var;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1137 double max, min, score, max_score, t;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1138
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1139 /*
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1140 if there are fewer than fc points in the cell, this cell
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1141 is terminal.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1142 */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1143 lo = lf->evs.lo[p]; hi = lf->evs.hi[p];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1144 if (hi-lo < fc) return(-1);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1145
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1146 /* determine the split variable */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1147 max_score = 0.0; split_var = 0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1148 for (k=0; k<d; k++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1149 { max = min = datum(&lf->lfd, k, pi[lo]);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1150 for (i=lo+1; i<=hi; i++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1151 { t = datum(&lf->lfd,k,pi[i]);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1152 if (t<min) min = t;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1153 if (t>max) max = t;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1154 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1155 score = (max-min) / lf->lfd.sca[k];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1156 if (score > max_score)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1157 { max_score = score;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1158 split_var = k;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1159 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1160 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1161 if (max_score==0) /* all points in the cell are equal */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1162 return(-1);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1163
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1164 *m = ksmall(lo,hi,(lo+hi)/2, dvari(&lf->lfd,split_var), pi);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1165 *split_val = datum(&lf->lfd, split_var, pi[*m]);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1166
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1167 if (*m==hi) /* all observations go lo */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1168 return(-1);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1169 return(split_var);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1170 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1171
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1172 void kdtre_start(des,lf)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1173 design *des;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1174 lfit *lf;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1175 {
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1176 int i, j, vc, d, nc, nv, ncm, nvm, k, m, n, p, *pi;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1177 double sv;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1178 d = lf->lfd.d; n = lf->lfd.n; pi = des->ind;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1179 kdtre_guessnv(&lf->evs,&nvm,&ncm,&vc,n,d,nn(&lf->sp));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1180 trchck(lf,nvm,ncm,vc);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1181
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1182 nv = 0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1183 if (ev(&lf->evs) != EKDCE)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1184 { for (i=0; i<vc; i++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1185 { j = i;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1186 for (k=0; k<d; ++k)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1187 { evptx(&lf->fp,i,k) = lf->evs.fl[d*(j%2)+k];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1188 j >>= 1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1189 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1190 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1191 nv = vc;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1192 for (j=0; j<vc; j++) lf->evs.ce[j] = j;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1193 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1194
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1195 for (i=0; i<n; i++) pi[i] = i;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1196 p = 0; nc = 1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1197 lf->evs.lo[p] = 0; lf->evs.hi[p] = n-1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1198 lf->evs.s[p] = -1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1199 while (p<nc)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1200 { k = terminal(lf,p,pi,nterm,d,&m,&sv);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1201 if (k>=0)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1202 {
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1203 if ((ncm<nc+2) | (2*nvm<2*nv+vc))
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1204 { WARN(("Insufficient space for full tree"));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1205 lf->evs.nce = nc; lf->fp.nv = nv;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1206 return;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1207 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1208
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1209 /* new lo cell has obsn's lo[p]..m */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1210 lf->evs.lo[nc] = lf->evs.lo[p];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1211 lf->evs.hi[nc] = m;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1212 lf->evs.s[nc] = -1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1213
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1214 /* new hi cell has obsn's m+1..hi[p] */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1215 lf->evs.lo[nc+1] = m+1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1216 lf->evs.hi[nc+1] = lf->evs.hi[p];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1217 lf->evs.s[nc+1] = -1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1218
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1219 /* cell p is split on variable k, value sv */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1220 lf->evs.s[p] = k;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1221 lf->evs.sv[p] = sv;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1222 lf->evs.lo[p] = nc; lf->evs.hi[p] = nc+1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1223
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1224 nc=nc+2; i = nv;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1225
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1226 /* now compute the new vertices. */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1227 if (ev(&lf->evs) != EKDCE)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1228 newcell(&nv,vc,evp(&lf->fp), d, k, sv,
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1229 &lf->evs.ce[p*vc], &lf->evs.ce[(nc-2)*vc], &lf->evs.ce[(nc-1)*vc]);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1230
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1231 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1232 else if (ev(&lf->evs)==EKDCE) /* new vertex at cell center */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1233 { sv = 0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1234 for (i=0; i<d; i++) evptx(&lf->fp,nv,i) = 0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1235 for (j=lf->evs.lo[p]; j<=lf->evs.hi[p]; j++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1236 { sv += prwt(&lf->lfd,(int)pi[j]);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1237 for (i=0; i<d; i++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1238 evptx(&lf->fp,nv,i) += datum(&lf->lfd,i,pi[j])*prwt(&lf->lfd,(int)pi[j]);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1239 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1240 for (i=0; i<d; i++) evptx(&lf->fp,nv,i) /= sv;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1241 lf->lfd.n = lf->evs.hi[p] - lf->evs.lo[p] + 1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1242 des->ind = &pi[lf->evs.lo[p]]; /* why? */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1243 PROC_VERTEX(des,lf,nv);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1244 lf->lfd.n = n; des->ind = pi;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1245 nv++;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1246 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1247 p++;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1248 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1249
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1250 /* We've built the tree. Now do the fitting. */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1251 if (ev(&lf->evs)==EKDTR)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1252 for (i=0; i<nv; i++) PROC_VERTEX(des,lf,i);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1253
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1254 lf->evs.nce = nc; lf->fp.nv = nv;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1255 return;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1256 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1257
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1258 void newcell(nv,vc,xev, d, k, split_val, cpar, clef, crig)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1259 double *xev, split_val;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1260 int *cpar, *clef, *crig;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1261 int *nv, vc, d, k;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1262 { int i, ii, j, j2, tk, match;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1263 tk = 1<<k;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1264 for (i=0; i<vc; i++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1265 { if ((i&tk) == 0)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1266 { for (j=0; j<d; j++) xev[*nv*d+j] = xev[d*cpar[i]+j];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1267 xev[*nv*d+k] = split_val;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1268 match = 0; j = vc; /* no matches in first vc points */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1269 while ((j<*nv) && (!match))
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1270 { j2 = 0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1271 while ((j2<d) && (xev[*nv*d+j2] == xev[j*d+j2])) j2++;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1272 match = (j2==d);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1273 if (!match) j++;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1274 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1275 ii = i+tk;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1276 clef[i] = cpar[i];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1277 clef[ii]= crig[i] = j;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1278 crig[ii]= cpar[ii];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1279 if (!match) (*nv)++;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1280 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1281 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1282 return;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1283 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1284
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1285 extern void hermite2();
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1286
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1287 double blend(fp,evs,s,x,ll,ur,j,nt,t,what)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1288 fitpt *fp;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1289 evstruc *evs;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1290 double s, *x, *ll, *ur;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1291 int j, nt, *t, what;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1292 {
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1293 int *ce, k, k1, m, nc, j0, j1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1294 double v0, v1, xibar, g0[3], g1[3], gg[4], gp[4], phi[4];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1295 ce = evs->ce;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1296 for (k=0; k<4; k++) /* North South East West */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1297 { k1 = (k>1);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1298 v0 = ll[k1]; v1 = ur[k1];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1299 j0 = ce[j+2*(k==0)+(k==2)];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1300 j1 = ce[j+3-2*(k==1)-(k==3)];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1301 xibar = (k%2==0) ? ur[k<2] : ll[k<2];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1302 m = nt;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1303 while ((m>=0) && ((evs->s[t[m]] != (k<=1)) | (evs->sv[t[m]] != xibar))) m--;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1304 if (m >= 0)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1305 { m = (k%2==1) ? evs->lo[t[m]] : evs->hi[t[m]];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1306 while (evs->s[m] != -1)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1307 m = (x[evs->s[m]] < evs->sv[m]) ? evs->lo[m] : evs->hi[m];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1308 if (v0 < evptx(fp,ce[4*m+2*(k==1)+(k==3)],k1))
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1309 { j0 = ce[4*m+2*(k==1)+(k==3)];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1310 v0 = evptx(fp,j0,k1);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1311 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1312 if (evptx(fp,ce[4*m+3-2*(k==0)-(k==2)],k1) < v1)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1313 { j1 = ce[4*m+3-2*(k==0)-(k==2)];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1314 v1 = evptx(fp,j1,k1);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1315 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1316 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1317 nc = exvval(fp,g0,j0,2,what,0);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1318 nc = exvval(fp,g1,j1,2,what,0);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1319 if (nc==1)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1320 gg[k] = linear_interp((x[(k>1)]-v0),v1-v0,g0[0],g1[0]);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1321 else
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1322 { hermite2(x[(k>1)]-v0,v1-v0,phi);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1323 gg[k] = phi[0]*g0[0]+phi[1]*g1[0]+(phi[2]*g0[1+k1]+phi[3]*g1[1+k1])*(v1-v0);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1324 gp[k] = phi[0]*g0[2-k1] + phi[1]*g1[2-k1];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1325 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1326 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1327 s = -s;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1328 if (nc==1)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1329 for (k=0; k<2; k++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1330 s += linear_interp(x[k]-ll[k],ur[k]-ll[k],gg[3-2*k],gg[2-2*k]);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1331 else
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1332 for (k=0; k<2; k++) /* EW NS */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1333 { hermite2(x[k]-ll[k],ur[k]-ll[k],phi);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1334 s += phi[0]*gg[3-2*k] + phi[1]*gg[2-2*k]
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1335 +(phi[2]*gp[3-2*k] + phi[3]*gp[2-2*k]) * (ur[k]-ll[k]);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1336 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1337 return(s);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1338 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1339
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1340 double kdtre_int(fp,evs,x,what)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1341 fitpt *fp;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1342 evstruc *evs;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1343 double *x;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1344 int what;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1345 {
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1346 int *ce, k, vc, t[20], nt, nc, j, d;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1347 double *ll, *ur, ff, vv[64][64];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1348 d = fp->d;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1349 vc = 1<<d;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1350 if (d > 6) { LERR(("d too large in kdint")); return(NOSLN); }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1351
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1352 /* descend the tree to find the terminal cell */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1353 nt = 0; t[nt] = 0; k = 0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1354 while (evs->s[k] != -1)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1355 { nt++;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1356 if (nt>=20) { LERR(("Too many levels in kdint")); return(NOSLN); }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1357 k = t[nt] = (x[evs->s[k]] < evs->sv[k]) ? evs->lo[k] : evs->hi[k];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1358 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1359
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1360 ce = &evs->ce[k*vc];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1361 ll = evpt(fp,ce[0]);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1362 ur = evpt(fp,ce[vc-1]);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1363 nc = 0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1364 for (j=0; j<vc; j++) nc = exvval(fp,vv[j],(int)ce[j],d,what,0);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1365 ff = rectcell_interp(x,vv,ll,ur,d,nc);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1366
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1367 if (d==2) ff = blend(fp,evs,ff,x,ll,ur,k*vc,nt,t,what);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1368 return(ff);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1369 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1370 /*
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1371 * Copyright 1996-2006 Catherine Loader.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1372 */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1373 #include "lfev.h"
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1374
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1375 /*
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1376 * convert eval. structure string to numeric code.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1377 */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1378 #define NETYPE 11
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1379 static char *etype[NETYPE]= { "tree", "phull", "data", "grid", "kdtree",
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1380 "kdcenter", "cross", "preset", "xbar", "none",
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1381 "sphere" };
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1382 static int evals[NETYPE]= { ETREE, EPHULL, EDATA, EGRID, EKDTR,
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1383 EKDCE, ECROS, EPRES, EXBAR, ENONE, ESPHR };
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1384 int lfevstr(char *z)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1385 { return(pmatch(z, etype, evals, NETYPE, -1));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1386 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1387
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1388 void evstruc_init(evs)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1389 evstruc *evs;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1390 { int i;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1391 ev(evs) = ETREE;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1392 mk(evs) = 100;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1393 cut(evs) = 0.8;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1394 for (i=0; i<MXDIM; i++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1395 { evs->fl[i] = evs->fl[i+MXDIM] = 0.0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1396 evs->mg[i] = 10;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1397 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1398 evs->nce = evs->ncm = 0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1399 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1400
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1401 int evstruc_reqi(nvm,ncm,vc)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1402 int nvm, ncm, vc;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1403 { return(ncm*vc+3*MAX(ncm,nvm));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1404 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1405
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1406 /* al=1: allows dynamic allocation.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1407 * al=0: inhibit. use with caution.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1408 */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1409 void evstruc_alloc(evs,nvm,ncm,vc,al)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1410 evstruc *evs;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1411 int nvm, ncm, vc, al;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1412 { int rw, *k;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1413
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1414 if (al)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1415 { rw = evstruc_reqi(nvm,ncm,vc);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1416 if (evs->liw<rw)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1417 { evs->iwk = (int *)calloc(rw,sizeof(int));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1418 if ( evs->iwk == NULL ) {
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1419 printf("Problem allocating memory for evs->iwk\n");fflush(stdout);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1420 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1421 evs->liw = rw;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1422 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1423 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1424 k = evs->iwk;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1425 evs->ce = k; k += vc*ncm;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1426 evs->s = k; k += MAX(ncm,nvm);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1427 evs->lo = k; k += MAX(ncm,nvm);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1428 evs->hi = k; k += MAX(ncm,nvm);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1429 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1430
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1431 void guessnv(evs,sp,mdl,n,d,lw,nvc)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1432 evstruc *evs;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1433 smpar *sp;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1434 module *mdl;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1435 int n, d, *lw, *nvc;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1436 { int i, nvm, ncm, vc;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1437
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1438 npar(sp) = calcp(sp,d);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1439 switch(ev(evs))
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1440 { case ETREE:
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1441 atree_guessnv(evs,&nvm,&ncm,&vc,d,nn(sp));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1442 break;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1443 case EPHULL:
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1444 nvm = ncm = mk(evs)*d;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1445 vc = d+1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1446 break;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1447 case EDATA:
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1448 case ECROS:
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1449 nvm = n;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1450 ncm = vc = 0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1451 break;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1452 case EKDTR:
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1453 case EKDCE:
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1454 kdtre_guessnv(evs,&nvm,&ncm,&vc,n,d,nn(sp));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1455 break;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1456 case EGRID:
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1457 nvm = 1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1458 for (i=0; i<d; i++) nvm *= evs->mg[i];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1459 ncm = 0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1460 vc = 1<<d;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1461 break;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1462 case EXBAR:
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1463 case ENONE:
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1464 nvm = 1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1465 ncm = vc = 0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1466 break;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1467 case EPRES:
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1468 nvm = evs->mg[0];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1469 ncm = vc = 0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1470 break;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1471 default:
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1472 LERR(("guessnv: I don't know this evaluation structure."));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1473 nvm = ncm = vc = 0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1474 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1475
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1476 lw[0] = des_reqd(n,npar(sp));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1477 lw[1] = lfit_reqd(d,nvm,ncm,mdl);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1478 lw[2] = evstruc_reqi(nvm,ncm,vc);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1479 lw[6] = des_reqi(n,npar(sp));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1480 lw[3] = pc_reqd(d,npar(sp));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1481 lw[4] = mdl->keepv;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1482 lw[5] = mdl->keepc;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1483
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1484 if (nvc==NULL) return;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1485 nvc[0] = nvm;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1486 nvc[1] = ncm;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1487 nvc[2] = vc;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1488 nvc[3] = nvc[4] = 0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1489 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1490
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1491 /*
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1492 * trchck checks the working space on the lfit structure
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1493 * has space for nvm vertices and ncm cells.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1494 */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1495 void lfit_alloc(lf)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1496 lfit *lf;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1497 { lf->fp.lwk = lf->fp.lev = lf->evs.liw = lf->pc.lwk = 0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1498 lf->lf_init_id = LF_INIT_ID;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1499 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1500 int lfit_reqd(d,nvm,ncm,mdl)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1501 int d, nvm, ncm;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1502 module *mdl;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1503 { int z;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1504 z = mdl->keepv;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1505 return(nvm*z+ncm);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1506 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1507
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1508 void trchck(lf,nvm,ncm,vc)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1509 lfit *lf;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1510 int nvm, ncm, vc;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1511 { int rw, d, *k;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1512 double *z;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1513
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1514 if (lf->lf_init_id != LF_INIT_ID) lfit_alloc(lf);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1515
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1516 lf->fp.nvm = nvm; lf->evs.ncm = ncm;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1517 d = lf->lfd.d;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1518
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1519 if (lf->fp.lev < d*nvm)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1520 { lf->fp.xev = (double *)calloc(d*nvm,sizeof(double));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1521 if ( lf->fp.xev == NULL ) {
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1522 printf("Problem allocating memory for lf->fp.xev\n");fflush(stdout);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1523 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1524 lf->fp.lev = d*nvm;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1525 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1526
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1527 rw = lfit_reqd(d,nvm,ncm,&lf->mdl);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1528 if (lf->fp.lwk < rw)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1529 {
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1530 lf->fp.coef = (double *)calloc(rw,sizeof(double));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1531 if ( lf->fp.coef == NULL ) {
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1532 printf("Problem allocating memory for lf->fp.coef\n");fflush(stdout);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1533 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1534 lf->fp.lwk = rw;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1535 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1536 z = lf->fp.wk = lf->fp.coef;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1537
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1538 lf->fp.h = NULL;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1539 if (!lf->mdl.isset) mut_printf("module not set.\n");
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1540 else
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1541 { if (lf->mdl.alloc!=NULL) lf->mdl.alloc(lf);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1542 z += KEEPV(lf) * nvm;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1543 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1544 lf->evs.sv = z; z += ncm;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1545
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1546 evstruc_alloc(&lf->evs,nvm,ncm,vc,1);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1547 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1548
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1549 void data_guessnv(nvm,ncm,vc,n)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1550 int *nvm, *ncm, *vc, n;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1551 { *nvm = n;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1552 *ncm = *vc = 0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1553 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1554
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1555 void dataf(des,lf)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1556 design *des;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1557 lfit *lf;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1558 {
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1559 int d, i, j, ncm, nv, vc;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1560
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1561 d = lf->lfd.d;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1562 data_guessnv(&nv,&ncm,&vc,lf->lfd.n);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1563 trchck(lf,nv,ncm,vc);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1564
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1565 for (i=0; i<nv; i++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1566 for (j=0; j<d; j++) evptx(&lf->fp,i,j) = datum(&lf->lfd,j,i);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1567 for (i=0; i<nv; i++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1568 {
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1569 PROC_VERTEX(des,lf,i);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1570 lf->evs.s[i] = 0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1571 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1572 lf->fp.nv = lf->fp.nvm = nv; lf->evs.nce = 0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1573 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1574
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1575 void xbar_guessnv(nvm,ncm,vc)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1576 int *nvm, *ncm, *vc;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1577 { *nvm = 1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1578 *ncm = *vc = 0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1579 return;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1580 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1581
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1582 void xbarf(des,lf)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1583 design *des;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1584 lfit *lf;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1585 { int i, d, nvm, ncm, vc;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1586 d = lf->lfd.d;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1587 xbar_guessnv(&nvm,&ncm,&vc);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1588 trchck(lf,1,0,0);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1589 for (i=0; i<d; i++) evptx(&lf->fp,0,i) = lf->pc.xbar[i];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1590 PROC_VERTEX(des,lf,0);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1591 lf->evs.s[0] = 0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1592 lf->fp.nv = 1; lf->evs.nce = 0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1593 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1594
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1595 void preset(des,lf)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1596 design *des;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1597 lfit *lf;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1598 { int i, nv;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1599
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1600 nv = lf->fp.nvm;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1601 trchck(lf,nv,0,0);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1602 for (i=0; i<nv; i++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1603 {
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1604 PROC_VERTEX(des,lf,i);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1605 lf->evs.s[i] = 0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1606 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1607 lf->fp.nv = nv; lf->evs.nce = 0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1608 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1609
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1610 void crossf(des,lf)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1611 design *des;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1612 lfit *lf;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1613 { int d, i, j, n, nv, ncm, vc;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1614 double w;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1615
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1616 n = lf->lfd.n; d = lf->lfd.d;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1617 data_guessnv(&nv,&ncm,&vc,n);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1618 trchck(lf,nv,ncm,vc);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1619
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1620 if (lf->lfd.w==NULL) LERR(("crossf() needs prior weights"));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1621 for (i=0; i<n; i++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1622 for (j=0; j<d; j++) evptx(&lf->fp,i,j) = datum(&lf->lfd,j,i);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1623 for (i=0; i<n; i++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1624 { lf->evs.s[i] = 0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1625 w = prwt(&lf->lfd,i);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1626 lf->lfd.w[i] = 0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1627 PROC_VERTEX(des,lf,i);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1628 lf->lfd.w[i] = w;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1629 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1630 lf->fp.nv = n; lf->evs.nce = 0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1631 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1632
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1633 void gridf(des,lf)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1634 design *des;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1635 lfit *lf;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1636 { int d, i, j, nv, u0, u1, z;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1637 nv = 1; d = lf->lfd.d;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1638 for (i=0; i<d; i++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1639 { if (lf->evs.mg[i]==0)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1640 lf->evs.mg[i] = 2+(int)((lf->evs.fl[i+d]-lf->evs.fl[i])/(lf->lfd.sca[i]*cut(&lf->evs)));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1641 nv *= lf->evs.mg[i];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1642 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1643 trchck(lf,nv,0,1<<d);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1644 for (i=0; i<nv; i++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1645 { z = i;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1646 for (j=0; j<d; j++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1647 { u0 = z%lf->evs.mg[j];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1648 u1 = lf->evs.mg[j]-1-u0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1649 evptx(&lf->fp,i,j) = (lf->evs.mg[j]==1) ? lf->evs.fl[j] :
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1650 (u1*lf->evs.fl[j]+u0*lf->evs.fl[j+d])/(lf->evs.mg[j]-1);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1651 z = z/lf->evs.mg[j];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1652 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1653 lf->evs.s[i] = 0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1654 PROC_VERTEX(des,lf,i);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1655 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1656 lf->fp.nv = nv; lf->evs.nce = 0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1657 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1658
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1659 int findpt(fp,evs,i0,i1)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1660 fitpt *fp;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1661 evstruc *evs;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1662 int i0, i1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1663 { int i;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1664 if (i0>i1) ISWAP(i0,i1);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1665 for (i=i1+1; i<fp->nv; i++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1666 if ((evs->lo[i]==i0) && (evs->hi[i]==i1)) return(i);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1667 return(-1);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1668 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1669
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1670 /*
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1671 add a new vertex at the midpoint of (x[i0],x[i1]).
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1672 return the vertex number.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1673 */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1674 int newsplit(des,lf,i0,i1,pv)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1675 design *des;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1676 lfit *lf;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1677 int i0, i1, pv;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1678 { int i, nv;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1679
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1680 i = findpt(&lf->fp,&lf->evs,i0,i1);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1681 if (i>=0) return(i);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1682
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1683 if (i0>i1) ISWAP(i0,i1);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1684 nv = lf->fp.nv;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1685
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1686 /* the point is new. Now check we have space for the new point. */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1687 if (nv>=lf->fp.nvm)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1688 {
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1689 LERR(("newsplit: out of vertex space"));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1690 return(-1);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1691 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1692
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1693 /* compute the new point, and evaluate the fit */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1694 lf->evs.lo[nv] = i0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1695 lf->evs.hi[nv] = i1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1696 for (i=0; i<lf->fp.d; i++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1697 evptx(&lf->fp,nv,i) = (evptx(&lf->fp,i0,i)+evptx(&lf->fp,i1,i))/2;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1698 if (pv) /* pseudo vertex */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1699 { lf->fp.h[nv] = (lf->fp.h[i0]+lf->fp.h[i1])/2;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1700 lf->evs.s[nv] = 1; /* pseudo-vertex */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1701 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1702 else /* real vertex */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1703 {
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1704 PROC_VERTEX(des,lf,nv);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1705 lf->evs.s[nv] = 0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1706 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1707 lf->fp.nv++;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1708
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1709 return(nv);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1710 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1711 /*
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1712 * Copyright 1996-2006 Catherine Loader.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1713 */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1714 /*
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1715 * Functions for constructing the fit and
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1716 * interpolating on the circle/sphere. d=2 only.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1717 */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1718
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1719 #include "lfev.h"
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1720
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1721 /*
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1722 * Guess the number of fitting points.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1723 */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1724 void sphere_guessnv(nvm,ncm,vc,mg)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1725 int *nvm, *ncm, *vc, *mg;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1726 { *nvm = mg[1]*(mg[0]+1);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1727 *ncm = 0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1728 *vc = 0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1729 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1730
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1731 void sphere_start(des,lf)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1732 design *des;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1733 lfit *lf;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1734 { int d, i, j, ct, nv, ncm, vc, *mg;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1735 double rmin, rmax, *orig, r, th, c, s;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1736
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1737 mg = mg(&lf->evs);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1738 sphere_guessnv(&nv,&ncm,&vc,mg);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1739 trchck(lf,nv,0,0);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1740 d = lf->lfd.d;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1741
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1742 rmin = lf->evs.fl[0];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1743 rmax = lf->evs.fl[1];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1744 orig = &lf->evs.fl[2];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1745 rmin = 0; rmax = 1; orig[0] = orig[1] = 0.0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1746
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1747 ct = 0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1748 for (i=0; i<mg[1]; i++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1749 { th = 2*PI*i/mg[1];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1750 c = cos(th);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1751 s = sin(th);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1752 for (j=0; j<=mg[0]; j++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1753 { r = rmin + (rmax-rmin)*j/mg[0];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1754 evptx(&lf->fp,ct,0) = orig[0] + r*c;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1755 evptx(&lf->fp,ct,1) = orig[1] + r*s;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1756 PROC_VERTEX(des,lf,ct);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1757 ct++;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1758 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1759 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1760 lf->fp.nv = ct;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1761 lf->evs.nce = 0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1762 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1763
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1764 double sphere_int(lf,x,what)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1765 lfit *lf;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1766 double *x;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1767 int what;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1768 { double rmin, rmax, *orig, dx, dy, r, th, th0, th1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1769 double v[64][64], c0, c1, s0, s1, r0, r1, d0, d1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1770 double ll[2], ur[2], xx[2];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1771 int i0, j0, i1, j1, *mg, nc, ce[4];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1772
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1773 rmin = lf->evs.fl[0];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1774 rmax = lf->evs.fl[1];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1775 orig = &lf->evs.fl[2];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1776 rmin = 0; rmax = 1; orig[0] = orig[1] = 0.0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1777 mg = mg(&lf->evs);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1778
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1779 dx = x[0] - orig[0];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1780 dy = x[1] - orig[1];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1781 r = sqrt(dx*dx+dy*dy);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1782 th = atan2(dy,dx); /* between -pi and pi */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1783
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1784 i0 = (int)floor(mg[1]*th/(2*PI)) % mg[1];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1785 j0 = (int)(mg[0]*(r-rmin)/(rmax-rmin));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1786
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1787 i1 = (i0+1) % mg[1];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1788 j1 = j0+1; if (j1>mg[0]) { j0 = mg[0]-1; j1 = mg[0]; }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1789
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1790 ce[0] = i0*(mg[0]+1)+j0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1791 ce[1] = i0*(mg[0]+1)+j1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1792 ce[2] = i1*(mg[0]+1)+j0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1793 ce[3] = i1*(mg[0]+1)+j1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1794 nc = exvval(&lf->fp,v[0],ce[0],2,what,1);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1795 nc = exvval(&lf->fp,v[1],ce[1],2,what,1);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1796 nc = exvval(&lf->fp,v[2],ce[2],2,what,1);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1797 nc = exvval(&lf->fp,v[3],ce[3],2,what,1);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1798
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1799 th0 = 2*PI*i0/mg[1]; c0 = cos(th0); s0 = sin(th0);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1800 th1 = 2*PI*i1/mg[1]; c1 = cos(th1); s1 = sin(th1);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1801 r0 = rmin + j0*(rmax-rmin)/mg[0];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1802 r1 = rmin + j1*(rmax-rmin)/mg[0];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1803
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1804 d0 = c0*v[0][1] + s0*v[0][2];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1805 d1 = r0*(c0*v[0][2]-s0*v[0][1]);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1806 v[0][1] = d0; v[0][2] = d1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1807
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1808 d0 = c0*v[1][1] + s0*v[1][2];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1809 d1 = r1*(c0*v[1][2]-s0*v[1][1]);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1810 v[1][1] = d0; v[1][2] = d1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1811
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1812 d0 = c1*v[2][1] + s1*v[2][2];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1813 d1 = r0*(c1*v[2][2]-s1*v[2][1]);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1814 v[2][1] = d0; v[2][2] = d1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1815
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1816 d0 = c1*v[3][1] + s1*v[3][2];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1817 d1 = r1*(c1*v[3][2]-s1*v[3][1]);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1818 v[3][1] = d0; v[3][2] = d1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1819
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1820 xx[0] = r; xx[1] = th;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1821 ll[0] = r0; ll[1] = th0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1822 ur[0] = r1; ur[1] = th1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1823 return(rectcell_interp(xx,v,ll,ur,2,nc));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1824 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1825 /*
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1826 * Copyright 1996-2006 Catherine Loader.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1827 */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1828 #include "lfev.h"
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1829
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1830 void solve(A,b,d) /* this is crude! A organized by column. */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1831 double *A, *b;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1832 int d;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1833 { int i, j, k;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1834 double piv;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1835 for (i=0; i<d; i++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1836 { piv = A[(d+1)*i];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1837 for (j=i; j<d; j++) A[j*d+i] /= piv;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1838 b[i] /= piv;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1839 for (j=0; j<d; j++) if (j != i)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1840 { piv = A[i*d+j];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1841 A[i*d+j] = 0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1842 for (k=i+1; k<d; k++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1843 A[k*d+j] -= piv*A[k*d+i];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1844 b[j] -= piv*b[i];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1845 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1846 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1847 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1848
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1849 void triang_guessnv(nvm,ncm,vc,d,mk)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1850 int *nvm, *ncm, *vc, d, mk;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1851 { *nvm = *ncm = mk*d;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1852 *vc = d+1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1853 return;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1854 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1855
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1856 int triang_split(lf,ce,le)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1857 lfit *lf;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1858 double *le;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1859 int *ce;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1860 { int d, i, j, k, nts, vc;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1861 double di, dfx[MXDIM];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1862 nts = 0; d = lf->fp.d; vc = d+1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1863 for (i=0; i<d; i++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1864 for (j=i+1; j<=d; j++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1865 { for (k=0; k<d; k++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1866 dfx[k] = evptx(&lf->fp,ce[i],k)-evptx(&lf->fp,ce[j],k);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1867 di = rho(dfx,lf->lfd.sca,d,KSPH,NULL);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1868 le[i*vc+j] = le[j*vc+i] = di/MIN(lf->fp.h[ce[i]],lf->fp.h[ce[j]]);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1869 nts = nts || le[i*vc+j]>cut(&lf->evs);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1870 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1871 return(nts);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1872 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1873
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1874 void resort(pv,xev,dig)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1875 double *xev;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1876 int *pv, *dig;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1877 { double d0, d1, d2;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1878 int i;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1879 d0 = d1 = d2 = 0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1880 for (i=0; i<3; i++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1881 { d0 += (xev[3*pv[11]+i]-xev[3*pv[1]+i])*(xev[3*pv[11]+i]-xev[3*pv[1]+i]);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1882 d1 += (xev[3*pv[ 7]+i]-xev[3*pv[2]+i])*(xev[3*pv[ 7]+i]-xev[3*pv[2]+i]);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1883 d2 += (xev[3*pv[ 6]+i]-xev[3*pv[3]+i])*(xev[3*pv[ 6]+i]-xev[3*pv[3]+i]);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1884 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1885 if ((d0<=d1) & (d0<=d2))
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1886 { dig[0] = pv[1]; dig[1] = pv[11];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1887 dig[2] = pv[2]; dig[3] = pv[7];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1888 dig[4] = pv[3]; dig[5] = pv[6];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1889 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1890 else if (d1<=d2)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1891 { dig[0] = pv[2]; dig[1] = pv[7];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1892 dig[2] = pv[1]; dig[3] = pv[11];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1893 dig[4] = pv[3]; dig[5] = pv[6];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1894 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1895 else
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1896 { dig[0] = pv[3]; dig[1] = pv[6];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1897 dig[2] = pv[2]; dig[3] = pv[7];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1898 dig[4] = pv[1]; dig[5] = pv[11];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1899 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1900 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1901
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1902 void triang_grow(des,lf,ce,ct,term)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1903 design *des;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1904 lfit *lf;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1905 int *ce, *ct, *term;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1906 { double le[(1+MXDIM)*(1+MXDIM)], ml;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1907 int d, i, j, im, jm, vc, pv[(1+MXDIM)*(1+MXDIM)], dig[6];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1908 int nce[1+MXDIM];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1909 if (lf_error) return;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1910 d = lf->fp.d; vc = d+1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1911 if (!triang_split(lf,ce,le))
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1912 { if (ct != NULL)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1913 { for (i=0; i<vc; i++) term[*ct*vc+i] = ce[i];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1914 (*ct)++;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1915 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1916 return;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1917 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1918 if (d>3)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1919 { ml = 0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1920 for (i=0; i<d; i++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1921 for (j=i+1; j<vc; j++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1922 if (le[i*vc+j]>ml) { ml = le[i*vc+j]; im = i; jm = j; }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1923 pv[0] = newsplit(des,lf,(int)ce[im],(int)ce[jm],0);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1924 for (i=0; i<vc; i++) nce[i] = ce[i];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1925 nce[im] = pv[0]; triang_grow(des,lf,nce,ct,term); nce[im] = ce[im];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1926 nce[jm] = pv[0]; triang_grow(des,lf,nce,ct,term);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1927 return;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1928 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1929
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1930 for (i=0; i<d; i++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1931 for (j=i+1; j<=d; j++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1932 pv[i*vc+j] = pv[j*vc+i]
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1933 = newsplit(des,lf,(int)ce[i],(int)ce[j],le[i*vc+j]<=cut(&lf->evs));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1934 for (i=0; i<=d; i++) /* corners */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1935 { for (j=0; j<=d; j++) nce[j] = (j==i) ? ce[i] : pv[i*vc+j];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1936 triang_grow(des,lf,nce,ct,term);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1937 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1938
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1939 if (d==2) /* center for d=2 */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1940 { nce[0] = pv[5]; nce[1] = pv[2]; nce[2] = pv[1];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1941 triang_grow(des,lf,nce,ct,term);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1942 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1943 if (d==3) /* center for d=3 */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1944 { resort(pv,evp(&lf->fp),dig);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1945 nce[0] = dig[0]; nce[1] = dig[1];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1946 nce[2] = dig[2]; nce[3] = dig[4]; triang_grow(des,lf,nce,ct,term);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1947 nce[2] = dig[5]; nce[3] = dig[3]; triang_grow(des,lf,nce,ct,term);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1948 nce[2] = dig[2]; nce[3] = dig[5]; triang_grow(des,lf,nce,ct,term);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1949 nce[2] = dig[4]; nce[3] = dig[3]; triang_grow(des,lf,nce,ct,term);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1950 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1951 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1952
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1953 void triang_descend(tr,xa,ce)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1954 lfit *tr;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1955 double *xa;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1956 int *ce;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1957 { double le[(1+MXDIM)*(1+MXDIM)], ml;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1958 int d, vc, i, j, im, jm, pv[(1+MXDIM)*(1+MXDIM)];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1959 design *des;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1960 des = NULL;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1961 if (!triang_split(tr,ce,le)) return;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1962 d = tr->fp.d; vc = d+1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1963
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1964 if (d>3) /* split longest edge */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1965 { ml = 0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1966 for (i=0; i<d; i++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1967 for (j=i+1; j<vc; j++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1968 if (le[i*vc+j]>ml) { ml = le[i*vc+j]; im = i; jm = j; }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1969 pv[0] = newsplit(des,tr,(int)ce[im],(int)ce[jm],0);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1970 if (xa[im]>xa[jm])
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1971 { xa[im] -= xa[jm]; xa[jm] *= 2; ce[jm] = pv[0]; }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1972 else
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1973 { xa[jm] -= xa[im]; xa[im] *= 2; ce[im] = pv[0]; }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1974 triang_descend(tr,xa,ce);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1975 return;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1976 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1977
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1978 for (i=0; i<d; i++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1979 for (j=i+1; j<=d; j++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1980 pv[i*vc+j] = pv[j*vc+i]
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1981 = newsplit(des,tr,(int)ce[i],(int)ce[j],le[i*d+j]<=cut(&tr->evs));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1982 for (i=0; i<=d; i++) if (xa[i]>=0.5) /* in corner */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1983 { for (j=0; j<=d; j++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1984 { if (i!=j) ce[j] = pv[i*vc+j];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1985 xa[j] = 2*xa[j];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1986 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1987 xa[i] -= 1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1988 triang_descend(tr,xa,ce);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1989 return;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1990 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1991 if (d==1) { LERR(("weights sum to < 1")); }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1992 if (d==2) /* center */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1993 { ce[0] = pv[5]; xa[0] = 1-2*xa[0];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1994 ce[1] = pv[2]; xa[1] = 1-2*xa[1];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1995 ce[2] = pv[1]; xa[2] = 1-2*xa[2];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1996 triang_descend(tr,xa,ce);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1997 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1998 if (d==3) /* center */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
1999 { double z; int dig[6];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2000 resort(pv,evp(&tr->fp),dig);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2001 ce[0] = dig[0]; ce[1] = dig[1];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2002 xa[0] *= 2; xa[1] *= 2; xa[2] *= 2; xa[3] *= 2;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2003 if (xa[0]+xa[2]>=1)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2004 { if (xa[0]+xa[3]>=1)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2005 { ce[2] = dig[2]; ce[3] = dig[4];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2006 z = xa[0];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2007 xa[3] += z-1; xa[2] += z-1; xa[0] = xa[1]; xa[1] = 1-z;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2008 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2009 else
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2010 { ce[2] = dig[2]; ce[3] = dig[5];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2011 z = xa[3]; xa[3] = xa[1]+xa[2]-1; xa[1] = z;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2012 z = xa[2]; xa[2] += xa[0]-1; xa[0] = 1-z;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2013 } }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2014 else
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2015 { if (xa[1]+xa[2]>=1)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2016 { ce[2] = dig[5]; ce[3] = dig[3];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2017 xa[1] = 1-xa[1]; xa[2] -= xa[1]; xa[3] -= xa[1];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2018 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2019 else
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2020 { ce[2] = dig[4]; ce[3] = dig[3];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2021 z = xa[3]; xa[3] += xa[1]-1; xa[1] = xa[2];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2022 xa[2] = z+xa[0]-1; xa[0] = 1-z;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2023 } }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2024 triang_descend(tr,xa,ce);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2025 } }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2026
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2027 void covrofdata(lfd,V,mn) /* covar of data; mean in mn */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2028 lfdata *lfd;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2029 double *V, *mn;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2030 { int d, i, j, k;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2031 double s;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2032 s = 0; d = lfd->d;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2033 for (i=0; i<d*d; i++) V[i] = 0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2034 for (i=0; i<lfd->n; i++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2035 { s += prwt(lfd,i);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2036 for (j=0; j<d; j++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2037 for (k=0; k<d; k++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2038 V[j*d+k] += prwt(lfd,i)*(datum(lfd,j,i)-mn[j])*(datum(lfd,k,i)-mn[k]);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2039 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2040 for (i=0; i<d*d; i++) V[i] /= s;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2041 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2042
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2043 int intri(x,w,xev,xa,d) /* is x in triangle bounded by xd[0..d-1]? */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2044 double *x, *xev, *xa;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2045 int *w, d;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2046 { int i, j;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2047 double eps, *r, xd[MXDIM*MXDIM];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2048 eps = 1.0e-10;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2049 r = &xev[w[d]*d];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2050 for (i=0; i<d; i++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2051 { xa[i] = x[i]-r[i];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2052 for (j=0; j<d; j++) xd[i*d+j] = xev[w[i]*d+j]-r[j];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2053 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2054 solve(xd,xa,d);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2055 xa[d] = 1.0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2056 for (i=0; i<d; i++) xa[d] -= xa[i];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2057 for (i=0; i<=d; i++) if ((xa[i]<-eps) | (xa[i]>1+eps)) return(0);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2058 return(1);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2059 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2060
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2061 void triang_start(des,lf) /* Triangulation with polyhedral start */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2062 design *des;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2063 lfit *lf;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2064 {
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2065 int i, j, k, n, d, nc, nvm, ncm, vc;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2066 int *ce, ed[1+MXDIM];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2067 double V[MXDIM*MXDIM], P[MXDIM*MXDIM], sigma, z[MXDIM], xa[1+MXDIM], *xev;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2068 xev = evp(&lf->fp);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2069 d = lf->lfd.d; n = lf->lfd.n;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2070 lf->fp.nv = nc = 0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2071
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2072 triang_guessnv(&nvm,&ncm,&vc,d,mk(&lf->evs));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2073 trchck(lf,nvm,ncm,vc);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2074
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2075 ce = lf->evs.ce;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2076 for (j=0; j<d; j++) xev[j] = lf->pc.xbar[j];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2077 lf->fp.nv = 1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2078 covrofdata(&lf->lfd,V,xev); /* fix this with scaling */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2079 eig_dec(V,P,d);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2080
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2081 for (i=0; i<d; i++) /* add vertices +- 2sigma*eigenvect */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2082 { sigma = sqrt(V[i*(d+1)]);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2083 for (j=0; j<d; j++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2084 xev[lf->fp.nv*d+j] = xev[j]-2*sigma*P[j*d+i];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2085 lf->fp.nv++;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2086 for (j=0; j<d; j++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2087 xev[lf->fp.nv*d+j] = xev[j]+2*sigma*P[j*d+i];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2088 lf->fp.nv++;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2089 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2090
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2091 for (i=0; i<n; i++) /* is point i inside? */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2092 { ed[0] = 0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2093 for (j=0; j<d; j++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2094 { z[j] = 0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2095 for (k=0; k<d; k++) z[j] += P[k*d+j]*(datum(&lf->lfd,k,i)-xev[k]);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2096 ed[j+1] = 2*j+1+(z[j]>0);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2097 for (k=0; k<d; k++) z[j] = datum(&lf->lfd,j,i);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2098 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2099 k = intri(z,ed,xev,xa,d);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2100 if (xa[0]<0)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2101 { for (j=1; j<=d; j++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2102 for (k=0; k<d; k++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2103 xev[ed[j]*d+k] = xa[0]*xev[k]+(1-xa[0])*xev[ed[j]*d+k];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2104 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2105 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2106
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2107 nc = 1<<d; /* create initial cells */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2108 for (i=0; i<nc; i++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2109 { ce[i*vc] = 0; k = i;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2110 for (j=0; j<d; j++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2111 { ce[i*vc+j+1] = 2*j+(k%2)+1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2112 k>>=1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2113 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2114 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2115
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2116 for (i=0; i<lf->fp.nv; i++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2117 { PROC_VERTEX(des,lf,i);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2118 if (lf_error) return;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2119 lf->evs.s[i] = 0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2120 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2121 for (i=0; i<nc; i++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2122 triang_grow(des,lf,&ce[i*vc],NULL,NULL);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2123 lf->evs.nce = nc;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2124 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2125
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2126 double triang_cubicint(v,vv,w,d,nc,xxa)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2127 double *v, *vv, *xxa;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2128 int *w, d, nc;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2129 { double sa, lb, *vert0, *vert1, *vals0, *vals1, deriv0, deriv1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2130 int i, j, k;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2131 if (nc==1) /* linear interpolate */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2132 { sa = 0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2133 for (i=0; i<=d; i++) sa += xxa[i]*vv[i];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2134 return(sa);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2135 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2136 sa = 1.0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2137 for (j=d; j>0; j--) /* eliminate v[w[j]] */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2138 { lb = xxa[j]/sa;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2139 for (k=0; k<j; k++) /* Interpolate edge v[w[k]],v[w[j]] */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2140 { vert0 = &v[w[k]*d];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2141 vert1 = &v[w[j]*d];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2142 vals0 = &vv[k*nc];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2143 vals1 = &vv[j*nc];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2144 deriv0 = deriv1 = 0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2145 for (i=0; i<d; i++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2146 { deriv0 += (vert1[i]-vert0[i])*vals0[i+1];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2147 deriv1 += (vert1[i]-vert0[i])*vals1[i+1];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2148 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2149 vals0[0] = cubic_interp(lb,vals0[0],vals1[0],deriv0,deriv1);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2150 for (i=1; i<=d; i++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2151 vals0[i] = (1-lb)*((1-lb)*vals0[i]+lb*vals1[i]);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2152 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2153 sa -= xxa[j];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2154 if (sa<=0) j = 0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2155 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2156 return(vals0[0]);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2157 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2158
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2159 double triang_clotoch(xev,vv,ce,p,xxa)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2160 double *xev, *vv, *xxa;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2161 int *ce, p;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2162 { double cfo[3], cfe[3], cg[9], *va, *vb, *vc,
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2163 l0, nm[3], na, nb, nc, *xl, *xr, *xz, d0, d1, lb, dlt, gam;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2164 int i, w[3], cfl, cfr;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2165 if (p==1)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2166 return(xxa[0]*vv[0]+xxa[1]*vv[1]+xxa[2]*vv[2]);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2167 if (xxa[2]<=MIN(xxa[0],xxa[1]))
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2168 { va = &xev[2*ce[0]]; vb = &xev[2*ce[1]]; vc = &xev[2*ce[2]];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2169 w[0] = 0; w[1] = 3; w[2] = 6;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2170 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2171 else
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2172 if (xxa[1]<xxa[0])
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2173 { w[0] = 0; w[1] = 6; w[2] = 3;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2174 va = &xev[2*ce[0]]; vb = &xev[2*ce[2]]; vc = &xev[2*ce[1]];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2175 lb = xxa[1]; xxa[1] = xxa[2]; xxa[2] = lb;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2176 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2177 else
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2178 { w[0] = 6; w[1] = 3; w[2] = 0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2179 va = &xev[2*ce[2]]; vb = &xev[2*ce[1]]; vc = &xev[2*ce[0]];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2180 lb = xxa[0]; xxa[0] = xxa[2]; xxa[2] = lb;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2181 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2182
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2183 /* set cg to values and derivatives on standard triangle */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2184 for (i=0; i<3; i++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2185 { cg[3*i] = vv[w[i]];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2186 cg[3*i+1] = ((vb[0]-va[0])*vv[w[i]+1]
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2187 +(vb[1]-va[1])*vv[w[i]+2])/2; /* df/dx */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2188 cg[3*i+2] = ((2*vc[0]-vb[0]-va[0])*vv[w[i]+1]
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2189 +(2*vc[1]-vb[1]-va[1])*vv[w[i]+2])/2.0; /* sqrt{3} df/dy */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2190 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2191 dlt = (vb[0]-va[0])*(vc[1]-va[1])-(vc[0]-va[0])*(vb[1]-va[1]);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2192 /* Twice area; +ve if abc antic.wise -ve is abc c.wise */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2193 cfo[0] = (cg[0]+cg[3]+cg[6])/3;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2194 cfo[1] = (2*cg[0]-cg[3]-cg[6])/4;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2195 cfo[2] = (2*cg[3]-cg[0]-cg[6])/4;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2196 na = -cg[1]+cg[2]; /* perp. deriv, rel. length 2 */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2197 nb = -cg[4]-cg[5];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2198 nc = 2*cg[7];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2199 cfo[1] += (nb-nc)/16;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2200 cfo[2] += (nc-na)/16;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2201 na = -cg[1]-cg[2]/3.0; /* derivatives back to origin */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2202 nb = cg[4]-cg[5]/3.0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2203 nc = cg[8]/1.5;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2204 cfo[0] -= (na+nb+nc)*7/54;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2205 cfo[1] += 13*(nb+nc-2*na)/144;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2206 cfo[2] += 13*(na+nc-2*nb)/144;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2207 for (i=0; i<3; i++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2208 { /* Outward normals by linear interpolation on original triangle.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2209 Convert to outward normals on standard triangle.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2210 Actually, computed to opposite corner */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2211 switch(i)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2212 { case 0: xl = vc; xr = vb; xz = va; cfl = w[2]; cfr = w[1];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2213 break;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2214 case 1: xl = va; xr = vc; xz = vb; cfl = w[0]; cfr = w[2];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2215 break;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2216 case 2: xl = vb; xr = va; xz = vc; cfl = w[1]; cfr = w[0];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2217 break;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2218 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2219 na = xr[0]-xl[0]; nb = xr[1]-xl[1];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2220 lb = na*na+nb*nb;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2221 d0 = 1.5*(vv[cfr]-vv[cfl]) - 0.25*(na*(vv[cfl+1]+vv[cfr+1])
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2222 +nb*(vv[cfl+2]+vv[cfr+2]));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2223 d1 = 0.5*( na*(vv[cfl+2]+vv[cfr+2])-nb*(vv[cfl+1]+vv[cfr+1]) );
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2224 l0 = (xz[0]-xl[0])*na+(xz[1]-xl[1])*nb-lb/2;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2225 nm[i] = (d1*dlt-l0*d0)/lb;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2226 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2227 cfo[0] -= (nm[0]+nm[1]+nm[2])*4/81;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2228 cfo[1] += (2*nm[0]-nm[1]-nm[2])/27;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2229 cfo[2] += (2*nm[1]-nm[0]-nm[2])/27;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2230
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2231 gam = xxa[0]+xxa[1]-2*xxa[2];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2232 if (gam==0) return(cfo[0]);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2233 lb = (xxa[0]-xxa[2])/gam;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2234 d0 = -2*cg[4]; d1 = -2*cg[1];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2235 cfe[0] = cubic_interp(lb,cg[3],cg[0],d0,d1);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2236 cfe[1] = cubintd(lb,cg[3],cg[0],d0,d1);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2237 cfe[2] = -(1-lb)*(1-2*lb)*cg[5] + 4*lb*(1-lb)*nm[2] - lb*(2*lb-1)*cg[2];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2238 d0 = 2*(lb*cfo[1]+(1-lb)*cfo[2]);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2239 d1 = (lb-0.5)*cfe[1]+cfe[2]/3.0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2240 return(cubic_interp(gam,cfo[0],cfe[0],d0,d1));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2241 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2242
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2243 int triang_getvertexvals(fp,evs,vv,i,what)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2244 fitpt *fp;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2245 evstruc *evs;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2246 double *vv;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2247 int i, what;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2248 { double dx, P, le, vl[1+MXDIM], vh[1+MXDIM];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2249 int d, il, ih, j, nc;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2250 d = fp->d;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2251 if (evs->s[i]==0) return(exvval(fp,vv,i,d,what,0));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2252
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2253 il = evs->lo[i]; nc = triang_getvertexvals(fp,evs,vl,il,what);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2254 ih = evs->hi[i]; nc = triang_getvertexvals(fp,evs,vh,ih,what);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2255 vv[0] = (vl[0]+vh[0])/2;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2256 if (nc==1) return(nc);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2257 P = 1.5*(vh[0]-vl[0]);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2258 le = 0.0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2259 for (j=0; j<d; j++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2260 { dx = evptx(fp,ih,j)-evptx(fp,il,j);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2261 vv[0] += dx*(vl[j+1]-vh[j+1])/8;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2262 vv[j+1] = (vl[j+1]+vh[j+1])/2;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2263 P -= 1.5*dx*vv[j+1];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2264 le += dx*dx;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2265 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2266 for (j=0; j<d; j++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2267 vv[j+1] += P*(evptx(fp,ih,j)-evptx(fp,il,j))/le;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2268 return(nc);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2269 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2270
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2271 double triang_int(lf,x,what)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2272 lfit *lf;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2273 double *x;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2274 int what;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2275 {
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2276 int d, i, j, k, vc, nc;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2277 int *ce, nce[1+MXDIM];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2278 double xa[1+MXDIM], vv[(1+MXDIM)*(1+MXDIM)], lb;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2279 fitpt *fp;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2280 evstruc *evs;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2281 fp = &lf->fp;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2282 evs= &lf->evs;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2283
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2284 d = fp->d; vc = d+1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2285 ce = evs->ce;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2286 i = 0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2287 while ((i<evs->nce) && (!intri(x,&ce[i*vc],evp(fp),xa,d))) i++;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2288 if (i==evs->nce) return(NOSLN);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2289 i *= vc;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2290 for (j=0; j<vc; j++) nce[j] = ce[i+j];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2291 triang_descend(lf,xa,nce);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2292
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2293 /* order the vertices -- needed for asymmetric interptr */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2294 do
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2295 { k=0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2296 for (i=0; i<d; i++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2297 if (nce[i]>nce[i+1])
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2298 { j=nce[i]; nce[i]=nce[i+1]; nce[i+1]=j; k=1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2299 lb = xa[i]; xa[i] = xa[i+1]; xa[i+1] = lb;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2300 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2301 } while(k);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2302 nc = 0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2303 for (i=0; i<vc; i++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2304 nc = triang_getvertexvals(fp,evs,&vv[i*nc],nce[i],what);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2305 return((d==2) ? triang_clotoch(evp(fp),vv,nce,nc,xa) :
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2306 triang_cubicint(evp(fp),vv,nce,d,nc,xa));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2307 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2308 /*
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2309 * Copyright 1996-2006 Catherine Loader.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2310 */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2311 /*
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2312 * Functions for computing residuals and fitted values from
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2313 * the locfit object.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2314 *
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2315 * fitted(lf,fit,what,cv,ty) computes fitted values from the
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2316 * fit structure in lf.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2317 * resid(y,c,w,th,mi,ty) converts fitted values to residuals
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2318 */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2319
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2320 #include "lfev.h"
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2321
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2322 #define NRT 8
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2323 static char *rtype[NRT] = { "deviance", "d2", "pearson", "raw",
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2324 "ldot", "lddot", "fit", "mean" };
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2325 static int rvals[NRT] = { RDEV, RDEV2, RPEAR, RRAW, RLDOT, RLDDT, RFIT, RMEAN};
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2326 int restyp(z)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2327 char *z;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2328 { int val;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2329
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2330 val = pmatch(z, rtype, rvals, NRT, -1);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2331 if (val==-1) LERR(("Unknown type = %s",z));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2332 return(val);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2333 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2334
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2335 double resid(y,w,th,fam,ty,res)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2336 int fam, ty;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2337 double y, w, th, *res;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2338 { double raw;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2339
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2340 fam = fam & 63;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2341 if ((fam==TGAUS) | (fam==TROBT) | (fam==TCAUC))
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2342 raw = y-res[ZMEAN];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2343 else
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2344 raw = y-w*res[ZMEAN];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2345 switch(ty)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2346 { case RDEV:
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2347 if (res[ZDLL]>0) return(sqrt(-2*res[ZLIK]));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2348 else return(-sqrt(-2*res[ZLIK]));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2349 case RPEAR:
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2350 if (res[ZDDLL]<=0)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2351 { if (res[ZDLL]==0) return(0);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2352 return(NOSLN);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2353 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2354 return(res[ZDLL]/sqrt(res[ZDDLL]));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2355 case RRAW: return(raw);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2356 case RLDOT: return(res[ZDLL]);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2357 case RDEV2: return(-2*res[ZLIK]);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2358 case RLDDT: return(res[ZDDLL]);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2359 case RFIT: return(th);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2360 case RMEAN: return(res[ZMEAN]);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2361 default: LERR(("resid: unknown residual type %d",ty));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2362 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2363 return(0.0);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2364 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2365
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2366 double studentize(res,inl,var,ty,link)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2367 double res, inl, var, *link;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2368 int ty;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2369 { double den;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2370 inl *= link[ZDDLL];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2371 var = var*var*link[ZDDLL];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2372 if (inl>1) inl = 1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2373 if (var>inl) var = inl;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2374 den = 1-2*inl+var;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2375 if (den<0) return(0.0);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2376 switch(ty)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2377 { case RDEV:
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2378 case RPEAR:
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2379 case RRAW:
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2380 case RLDOT:
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2381 return(res/sqrt(den));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2382 case RDEV2:
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2383 return(res/den);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2384 default: return(res);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2385 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2386 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2387
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2388 void fitted(lf,fit,what,cv,st,ty)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2389 lfit *lf;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2390 double *fit;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2391 int what, cv, st, ty;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2392 { int i, j, d, n, evo;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2393 double xx[MXDIM], th, inl, var, link[LLEN];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2394 n = lf->lfd.n;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2395 d = lf->lfd.d;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2396 evo = ev(&lf->evs);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2397 cv &= (evo!=ECROS);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2398 if ((evo==EDATA)|(evo==ECROS)) evo = EFITP;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2399 setfamily(&lf->sp);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2400
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2401 for (i=0; i<n; i++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2402 { for (j=0; j<d; j++) xx[j] = datum(&lf->lfd,j,i);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2403 th = dointpoint(lf,xx,what,evo,i);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2404 if ((what==PT0)|(what==PVARI)) th = th*th;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2405 if (what==PCOEF)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2406 {
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2407 th += base(&lf->lfd,i);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2408 stdlinks(link,&lf->lfd,&lf->sp,i,th,rsc(&lf->fp));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2409 if ((cv)|(st))
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2410 { inl = dointpoint(lf,xx,PT0,evo,i);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2411 inl = inl*inl;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2412 if (cv)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2413 { th -= inl*link[ZDLL];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2414 stdlinks(link,&lf->lfd,&lf->sp,i,th,rsc(&lf->fp));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2415 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2416 if (st) var = dointpoint(lf,xx,PNLX,evo,i);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2417 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2418 fit[i] = resid(resp(&lf->lfd,i),prwt(&lf->lfd,i),th,fam(&lf->sp),ty,link);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2419 if (st) fit[i] = studentize(fit[i],inl,var,ty,link);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2420 } else fit[i] = th;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2421 if (lf_error) return;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2422 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2423 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2424 /*
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2425 * Copyright 1996-2006 Catherine Loader.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2426 */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2427 #include "lfev.h"
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2428
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2429 extern double robscale;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2430
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2431 /* special version of ressumm to estimate sigma^2, with derivative estimation */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2432 void ressummd(lf)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2433 lfit *lf;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2434 { int i;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2435 double s0, s1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2436 s0 = s1 = 0.0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2437 if ((fam(&lf->sp)&64)==0)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2438 { rv(&lf->fp) = 1.0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2439 return;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2440 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2441 for (i=0; i<lf->fp.nv; i++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2442 { s0 += lf->fp.lik[2*lf->fp.nvm+i];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2443 s1 += lf->fp.lik[i];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2444 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2445 if (s0==0.0)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2446 rv(&lf->fp) = 0.0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2447 else
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2448 rv(&lf->fp) = -2*s1/s0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2449 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2450
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2451 /*
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2452 * res[0] = log-likelihood.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2453 * res[1] = df0 = tr(H)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2454 * res[2] = df0 = tr(H'H)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2455 * res[3] = s^2.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2456 * res[5] = robustscale.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2457 */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2458 void ressumm(lf,des,res)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2459 lfit *lf;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2460 design *des;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2461 double *res;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2462 { int i, j, evo, tg;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2463 double *oy, pw, r1, r2, rdf, t0, t1, u[MXDIM], link[LLEN];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2464 fitpt *fp;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2465
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2466 res[0] = res[1] = res[2] = 0.0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2467
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2468 evo = ev(&lf->evs);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2469 if ((evo==EKDCE) | (evo==EPRES))
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2470 { res[3] = 1.0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2471 return;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2472 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2473 if (lf->dv.nd>0)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2474 { ressummd(lf);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2475 return;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2476 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2477
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2478 r1 = r2 = 0.0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2479 if ((evo==EDATA) | (evo==ECROS)) evo = EFITP;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2480
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2481 for (i=0; i<lf->lfd.n; i++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2482 { for (j=0; j<lf->lfd.d; j++) u[j] = datum(&lf->lfd,j,i);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2483 fitv(des,i) = base(&lf->lfd,i)+dointpoint(lf,u,PCOEF,evo,i);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2484 des->wd[i] = resp(&(lf->lfd),i) - fitv(des,i);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2485 wght(des,i) = 1.0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2486 des->ind[i] = i;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2487 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2488
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2489 tg = fam(&lf->sp);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2490 res[5] = 1.0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2491 if ((tg==TROBT+64) | (tg==TCAUC+64)) /* global robust scale */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2492 { oy = lf->lfd.y; lf->lfd.y = des->wd;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2493 des->xev = lf->pc.xbar;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2494 locfit(&lf->lfd,des,&lf->sp,1,0,0);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2495 lf->lfd.y = oy;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2496 res[5] = robscale;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2497 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2498
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2499 for (i=0; i<lf->lfd.n; i++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2500 { for (j=0; j<lf->lfd.d; j++) u[j] = datum(&lf->lfd,j,i);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2501 t0 = dointpoint(lf,u,PT0,evo,i);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2502 t1 = dointpoint(lf,u,PNLX,evo,i);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2503 stdlinks(link,&lf->lfd,&lf->sp,i,fitv(des,i),res[5]);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2504 t1 = t1*t1*link[ZDDLL];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2505 t0 = t0*t0*link[ZDDLL];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2506 if (t1>1) t1 = 1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2507 if (t0>1) t0 = 1; /* no observation gives >1 deg.free */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2508 res[0] += link[ZLIK];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2509 res[1] += t0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2510 res[2] += t1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2511 pw = prwt(&lf->lfd,i);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2512 if (pw>0)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2513 { r1 += link[ZDLL]*link[ZDLL]/pw;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2514 r2 += link[ZDDLL]/pw;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2515 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2516 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2517
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2518 res[3] = 1.0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2519 if ((fam(&lf->sp)&64)==64) /* quasi family */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2520 { rdf = lf->lfd.n-2*res[1]+res[2];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2521 if (rdf<1.0)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2522 { WARN(("Estimated rdf < 1.0; not estimating variance"));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2523 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2524 else
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2525 res[3] = r1/r2 * lf->lfd.n / rdf;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2526 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2527
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2528 /* try to ensure consistency for family="circ"! */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2529 if (((fam(&lf->sp)&63)==TCIRC) & (lf->lfd.d==1))
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2530 { int *ind, nv;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2531 double dlt, th0, th1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2532 ind = des->ind;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2533 nv = fp->nv;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2534 for (i=0; i<nv; i++) ind[i] = i;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2535 lforder(ind,evp(fp),0,nv-1);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2536 for (i=1; i<nv; i++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2537 { dlt = evptx(fp,ind[i],0)-evptx(fp,ind[i-1],0);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2538 th0 = fp->coef[ind[i]]-dlt*fp->coef[ind[i]+nv]-fp->coef[ind[i-1]];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2539 th1 = fp->coef[ind[i]]-dlt*fp->coef[ind[i-1]+nv]-fp->coef[ind[i-1]];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2540 if ((th0>PI)&(th1>PI))
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2541 { for (j=0; j<i; j++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2542 fp->coef[ind[j]] += 2*PI;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2543 i--;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2544 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2545 if ((th0<(-PI))&(th1<(-PI)))
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2546 { for (j=0; j<i; j++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2547 fp->coef[ind[j]] -= 2*PI;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2548 i--;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2549 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2550 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2551 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2552
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2553 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2554
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2555 double rss(lf,des,df)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2556 lfit *lf;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2557 design *des;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2558 double *df;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2559 { double ss, res[10];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2560 ss = 0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2561 ressumm(lf,des,res);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2562 *df = lf->lfd.n - 2*res[1] + res[2];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2563 return(-2*res[0]);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2564 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2565 /*
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2566 * Copyright 1996-2006 Catherine Loader.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2567 */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2568 /*
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2569 *
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2570 * Derivative corrections. The local slopes are not the derivatives
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2571 * of the local likelihood estimate; the function dercor() computes
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2572 * the adjustment to get the correct derivatives under the assumption
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2573 * that h is constant.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2574 *
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2575 * By differentiating the local likelihood equations, one obtains
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2576 *
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2577 * d ^ ^ T -1 T d . ^
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2578 * -- a = a - (X W V X) X -- W l( Y, X a)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2579 * dx 0 1 dx
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2580 */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2581
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2582 #include "lfev.h"
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2583 extern double robscale;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2584
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2585 void dercor(lfd,sp,des,coef)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2586 lfdata *lfd;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2587 smpar *sp;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2588 design *des;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2589 double *coef;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2590 { double s1, dc[MXDIM], wd, link[LLEN];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2591 int i, ii, j, m, d, p;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2592 if (fam(sp)<=THAZ) return;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2593 if (ker(sp)==WPARM) return;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2594
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2595 d = lfd->d;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2596 p = des->p; m = des->n;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2597
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2598 if (lf_debug>1) mut_printf(" Correcting derivatives\n");
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2599 fitfun(lfd, sp, des->xev,des->xev,des->f1,NULL);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2600 jacob_solve(&des->xtwx,des->f1);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2601 setzero(dc,d);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2602
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2603 /* correction term is e1^T (XTWVX)^{-1} XTW' ldot. */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2604 for (i=0; i<m; i++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2605 { s1 = innerprod(des->f1,d_xi(des,i),p);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2606 ii = des->ind[i];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2607 stdlinks(link,lfd,sp,ii,fitv(des,ii),robscale);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2608 for (j=0; j<d; j++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2609 { wd = wght(des,ii)*weightd(datum(lfd,j,ii)-des->xev[j],lfd->sca[j],
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2610 d,ker(sp),kt(sp),des->h,lfd->sty[j],dist(des,ii));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2611 dc[j] += s1*wd*link[ZDLL];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2612 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2613
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2614 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2615 for (j=0; j<d; j++) coef[j+1] += dc[j];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2616 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2617 /*
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2618 * Copyright 1996-2006 Catherine Loader.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2619 */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2620 #include "lfev.h"
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2621
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2622 void allocallcf(lf)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2623 lfit *lf;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2624 { lf->fp.coef = VVEC(lf,0);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2625 lf->fp.h = VVEC(lf,NPAR(lf));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2626 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2627
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2628 int procvallcf(des,lf,v)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2629 design *des;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2630 lfit *lf;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2631 int v;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2632 { int i, p, lf_status;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2633
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2634 lf_status = procv_nov(des,lf,v);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2635 if (lf_error) return(lf_status);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2636
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2637 p = NPAR(lf);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2638 for (i=0; i<p; i++) VVAL(lf,v,i) = des->cf[i];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2639 lf->fp.h[v] = des->h;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2640
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2641 return(0);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2642 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2643
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2644 void initallcf(lf)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2645 lfit *lf;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2646 { PROCV(lf) = procvallcf;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2647 ALLOC(lf) = allocallcf;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2648 PPROC(lf) = NULL;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2649 KEEPV(lf) = NPAR(lf)+1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2650 KEEPC(lf) = 0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2651 NOPC(lf) = 1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2652 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2653 /*
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2654 * Copyright 1996-2006 Catherine Loader.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2655 */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2656 #include "lfev.h"
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2657
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2658 void pprocgam(lf,des,res)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2659 lfit *lf;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2660 design *des;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2661 double *res;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2662 { int i, j, n, evo, op;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2663 double *fv, *vr, df, t0, t1, u[MXDIM], link[LLEN];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2664
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2665 n = lf->lfd.n;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2666 fv = res;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2667 vr = &res[n];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2668 df = 0.0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2669
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2670 evo = ev(&lf->evs);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2671 if (evo==EDATA) evo = EFITP;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2672
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2673 for (i=0; i<n; i++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2674 { for (j=0; j<lf->lfd.d; j++) u[j] = datum(&lf->lfd,j,i);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2675 fitv(des,i) = base(&lf->lfd,i)+dointpoint(lf,u,PCOEF,evo,i);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2676 lf->lfd.y[i] -= fitv(des,i);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2677 wght(des,i) = 1.0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2678 des->ind[i] = i;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2679
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2680 t0 = dointpoint(lf,u,PT0,evo,i);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2681 t1 = dointpoint(lf,u,PNLX,evo,i);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2682 stdlinks(link,&lf->lfd,&lf->sp,i,fitv(des,i),1.0);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2683 t0 = t0*t0*link[ZDDLL];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2684 t1 = t1*t1*link[ZDDLL];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2685 if (t0>1) t0 = 1; /* no observation gives >1 deg.free */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2686 if (t1>1) t1 = 1; /* no observation gives >1 deg.free */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2687 vr[i] = t1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2688 df += t0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2689 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2690
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2691 des->n = n;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2692 deg(&lf->sp) = 1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2693 op = npar(&lf->sp);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2694 npar(&lf->sp) = des->p = 1+lf->lfd.d;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2695 des->xev = lf->pc.xbar;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2696 locfit(&lf->lfd,des,&lf->sp,1,0,0);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2697
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2698 for (i=0; i<n; i++) fv[i] = resp(&lf->lfd,i) - fitv(des,i);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2699 for (i=0; i<=lf->lfd.d; i++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2700 lf->pc.coef[i] += des->cf[i];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2701 res[2*n] = df-2;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2702 npar(&lf->sp) = op;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2703 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2704
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2705 void initgam(lf)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2706 lfit *lf;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2707 { initstd(lf);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2708 PPROC(lf) = pprocgam;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2709 KEEPC(lf) = 2*NOBS(lf)+1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2710 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2711 /*
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2712 * Copyright 1996-2006 Catherine Loader.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2713 */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2714 #include "lfev.h"
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2715
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2716 int procvhatm(des,lf,v)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2717 design *des;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2718 lfit *lf;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2719 int v;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2720 { int k;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2721 double *l;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2722 l = &lf->fp.coef[v*lf->lfd.n];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2723 if ((ker(&lf->sp)!=WPARM) | (!haspc(&lf->pc)))
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2724 { k = procv_nov(des,lf,v);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2725 wdiag(&lf->lfd,&lf->sp,des,l,&lf->dv,0,1,1);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2726 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2727 else
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2728 wdiagp(&lf->lfd,&lf->sp,des,l,&lf->pc,&lf->dv,0,1,1);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2729 lf->fp.h[v] = des->h;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2730 return(k);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2731 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2732
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2733 void allochatm(lf)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2734 lfit *lf;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2735 { lf->fp.coef = VVEC(lf,0);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2736 lf->fp.h = VVEC(lf,NOBS(lf));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2737 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2738
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2739 void pprochatm(lf,des,res)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2740 lfit *lf;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2741 design *des;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2742 double *res;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2743 { transpose(lf->fp.coef,lf->fp.nvm,lf->lfd.n);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2744 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2745
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2746 void inithatm(lf)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2747 lfit *lf;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2748 { PROCV(lf) = procvhatm;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2749 ALLOC(lf) = allochatm;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2750 PPROC(lf) = pprochatm;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2751 KEEPV(lf) = NOBS(lf)+1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2752 KEEPC(lf) = 1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2753 NOPC(lf) = 1; /* could use pc if mi[MKER] == WPARM */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2754 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2755 /*
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2756 * Copyright 1996-2006 Catherine Loader.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2757 */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2758 #include "lfev.h"
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2759
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2760 static lfit *lf_scb;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2761 static lfdata *lfd_scb;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2762 static smpar *scb_sp;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2763 static design *des_scb;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2764
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2765 int scbfitter(x,l,reqd)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2766 double *x, *l;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2767 int reqd;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2768 {
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2769 int m;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2770 des_scb->xev = x;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2771 if ((ker(scb_sp)!=WPARM) | (!haspc(&lf_scb->pc)))
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2772 { locfit(lfd_scb,des_scb,&lf_scb->sp,1,1,0);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2773 m = wdiag(lfd_scb, scb_sp, des_scb,l,&lf_scb->dv,reqd,2,0);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2774 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2775 else
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2776 m = wdiagp(lfd_scb, scb_sp, des_scb,l,&lf_scb->pc,&lf_scb->dv,reqd,2,0);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2777 return(m);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2778 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2779
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2780 int constants(lf,des,res)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2781 lfit *lf;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2782 design *des;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2783 double *res;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2784 {
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2785 int d, m, nt;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2786 double *wk;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2787 evstruc *evs;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2788
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2789 lf_scb = lf;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2790 des_scb = des;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2791 lfd_scb = &lf->lfd;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2792 scb_sp = &lf->sp;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2793
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2794 evs = &lf->evs;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2795 d = lfd_scb->d;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2796 m = lfd_scb->n;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2797 trchck(lf,0,0,0);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2798
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2799 if (lf_error) return(0);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2800 if ((ker(scb_sp) != WPARM) && (lf->sp.nn>0))
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2801 WARN(("constants are approximate for varying h"));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2802 npar(scb_sp) = calcp(scb_sp,lf->lfd.d);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2803 des_init(des,m,npar(scb_sp));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2804 set_scales(&lf->lfd);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2805 set_flim(&lf->lfd,&lf->evs);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2806 compparcomp(des,&lf->lfd,&lf->sp,&lf->pc,ker(scb_sp)!=WPARM);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2807
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2808 wk = &res[d+1];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2809 nt = tube_constants(scbfitter,d,m,ev(evs),mg(evs),evs->fl,
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2810 res,wk,(d>3) ? 4 : d+1,0);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2811 lf->evs.nce = nt; /* cheat way to return it to S. */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2812 return(nt);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2813 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2814
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2815 void initkappa(lf)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2816 lfit *lf;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2817 { PROCV(lf) = NULL;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2818 ALLOC(lf) = NULL;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2819 PPROC(lf) = (void *)constants;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2820 KEEPV(lf) = 0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2821 KEEPC(lf) = NVAR(lf)+1+k0_reqd(NVAR(lf),NOBS(lf),0);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2822 NOPC(lf) = 0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2823 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2824 /*
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2825 * Copyright 1996-2006 Catherine Loader.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2826 */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2827 #include "lfev.h"
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2828
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2829 /* fix df computation for link=IDENT. */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2830 void pproclscv(lf,des,res)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2831 lfit *lf;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2832 design *des;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2833 double *res;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2834 { double df, fh, fh_cv, infl, z0, z1, x[MXDIM];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2835 int i, n, j, evo;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2836 z1 = df = 0.0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2837 evo = ev(&lf->evs);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2838 n = lf->lfd.n;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2839 if ((evo==EDATA) | (evo==ECROS)) evo = EFITP;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2840
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2841 z0 = dens_integrate(lf,des,2);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2842
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2843 for (i=0; i<n; i++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2844 { for (j=0; j<lf->lfd.d; j++) x[j] = datum(&lf->lfd,j,i);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2845 fh = base(&lf->lfd,i)+dointpoint(lf,x,PCOEF,evo,i);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2846 if (link(&lf->sp)==LLOG) fh = exp(fh);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2847 infl = dointpoint(lf,x,PT0,evo,i);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2848 infl = infl * infl;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2849 if (infl>1) infl = 1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2850 fh_cv = (link(&lf->sp) == LIDENT) ?
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2851 (n*fh - infl) / (n-1.0) : fh*(1-infl)*n/(n-1.0);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2852 z1 += fh_cv;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2853 df += infl;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2854 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2855
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2856 res[0] = z0-2*z1/n;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2857 res[1] = df;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2858 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2859
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2860 void initlscv(lf)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2861 lfit *lf;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2862 { initstd(lf);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2863 KEEPC(lf) = 2;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2864 PPROC(lf) = pproclscv;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2865 NOPC(lf) = 1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2866 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2867 /*
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2868 * Copyright 1996-2006 Catherine Loader.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2869 */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2870 #include "lfev.h"
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2871
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2872 static double pen, sig2;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2873
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2874 void goldensec(f,des,tr,eps,xm,ym,meth)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2875 double (*f)(), eps, *xm, *ym;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2876 int meth;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2877 design *des;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2878 lfit *tr;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2879 { double x[4], y[4], xx[11], yy[11];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2880 int i, im;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2881 xx[0] = tr->sp.fixh;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2882 if (xx[0]<=0)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2883 { LERR(("regband: initialize h>0"));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2884 return;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2885 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2886 for (i=0; i<=10; i++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2887 { if (i>0) xx[i] = (1+gold_rat)*xx[i-1];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2888 yy[i] = f(xx[i],des,tr,meth);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2889 if ((i==0) || (yy[i]<yy[im])) im = i;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2890 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2891 if (im==0) im = 1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2892 if (im==10)im = 9;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2893 x[0] = xx[im-1]; y[0] = yy[im-1];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2894 x[1] = xx[im]; y[1] = yy[im];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2895 x[3] = xx[im+1]; y[3] = yy[im+1];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2896 x[2] = gold_rat*x[3]+(1-gold_rat)*x[0];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2897 y[2] = f(x[2],des,tr,meth);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2898 while (x[3]-x[0]>eps)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2899 { if (y[1]<y[2])
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2900 { x[3] = x[2]; y[3] = y[2];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2901 x[2] = x[1]; y[2] = y[1];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2902 x[1] = gold_rat*x[0]+(1-gold_rat)*x[3];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2903 y[1] = f(x[1],des,tr,meth);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2904 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2905 else
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2906 { x[0] = x[1]; y[0] = y[1];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2907 x[1] = x[2]; y[1] = y[2];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2908 x[2] = gold_rat*x[3]+(1-gold_rat)*x[0];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2909 y[2] = f(x[2],des,tr,meth);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2910 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2911 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2912 im = 0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2913 for (i=1; i<4; i++) if (y[i]<y[im]) im = i;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2914 *xm = x[im]; *ym = y[im];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2915 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2916
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2917 double dnk(x,k)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2918 double x;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2919 int k;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2920 { double f;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2921 switch(k)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2922 { case 0: f = 1; break;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2923 case 1: f = -x; break;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2924 case 2: f = x*x-1; break;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2925 case 3: f = x*(x*x-3); break;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2926 case 4: f = 3-x*x*(6-x*x); break;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2927 case 5: f = -x*(15-x*x*(10-x*x)); break;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2928 case 6: f = -15+x*x*(45-x*x*(15-x*x)); break;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2929 default: LERR(("dnk: k=%d too large",k)); return(0.0);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2930 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2931 return(f*exp(-x*x/2)/S2PI);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2932 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2933
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2934 double locai(h,des,lf)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2935 double h;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2936 design *des;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2937 lfit *lf;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2938 { double cp, res[10];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2939 nn(&lf->sp) = h;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2940 lf->mdl.procv = procvstd;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2941 nstartlf(des,lf);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2942 ressumm(lf,des,res);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2943 cp = -2*res[0] + pen*res[1];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2944 return(cp);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2945 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2946
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2947 static int fc;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2948
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2949 double loccp(h,des,lf,m) /* m=1: cp m=2: gcv */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2950 double h;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2951 design *des;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2952 lfit *lf;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2953 int m;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2954 { double cp, res[10];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2955 int dg, n;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2956
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2957 n = lf->lfd.n;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2958 nn(&lf->sp) = 0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2959 fixh(&lf->sp) = h;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2960 lf->mdl.procv = procvstd;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2961 nstartlf(des,lf);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2962 ressumm(lf,des,res);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2963 if (m==1)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2964 { if (fc) sig2 = res[3]; /* first call - set sig2 */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2965 cp = -2*res[0]/sig2 - n + 2*res[1];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2966 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2967 else
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2968 cp = -2*n*res[0]/((n-res[1])*(n-res[1]));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2969 fc = 0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2970 return(cp);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2971 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2972
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2973 double cp(des,lf,meth)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2974 design *des;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2975 lfit *lf;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2976 int meth;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2977 { double hm, ym;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2978 fc = 1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2979 goldensec(loccp,des,lf,0.001,&hm,&ym,meth);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2980 return(hm);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2981 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2982
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2983 double gkk(des,lf)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2984 design *des;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2985 lfit *lf;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2986 { double h, h5, nf, th;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2987 int i, j, n, dg0, dg1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2988 ev(&lf->evs)= EDATA;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2989 nn(&lf->sp) = 0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2990 n = lf->lfd.n;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2991 dg0 = deg0(&lf->sp); /* target degree */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2992 dg1 = dg0+1+(dg0%2==0); /* pilot degree */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2993 nf = exp(log(1.0*n)/10); /* bandwidth inflation factor */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2994 h = lf->sp.fixh; /* start bandwidth */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2995 for (i=0; i<=10; i++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2996 { deg(&lf->sp) = dg1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2997 lf->sp.fixh = h*nf;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2998 lf->mdl.procv = procvstd;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
2999 nstartlf(des,lf);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3000 th = 0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3001 for (j=10; j<n-10; j++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3002 th += lf->fp.coef[dg1*n+j]*lf->fp.coef[dg1*n+j];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3003 th *= n/(n-20.0);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3004 h5 = sig2 * Wikk(ker(&lf->sp),dg0) / th;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3005 h = exp(log(h5)/(2*dg1+1));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3006 if (lf_error) return(0.0);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3007 /* mut_printf("pilot %8.5f sel %8.5f\n",lf->sp.fixh,h); */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3008 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3009 return(h);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3010 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3011
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3012 double rsw(des,lf)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3013 design *des;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3014 lfit *lf;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3015 { int i, j, k, nmax, nvm, n, mk, evo, dg0, dg1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3016 double rss[6], cp[6], th22, dx, d2, hh;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3017 nmax = 5;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3018 evo = ev(&lf->evs); ev(&lf->evs) = EGRID;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3019 mk = ker(&lf->sp); ker(&lf->sp) = WRECT;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3020 dg0 = deg0(&lf->sp);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3021 dg1 = 1 + dg0 + (dg0%2==0);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3022 deg(&lf->sp) = 4;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3023 for (k=nmax; k>0; k--)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3024 { lf->evs.mg[0] = k;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3025 lf->evs.fl[0] = 1.0/(2*k);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3026 lf->evs.fl[1] = 1-1.0/(2*k);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3027 nn(&lf->sp) = 0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3028 fixh(&lf->sp) = 1.0/(2*k);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3029 lf->mdl.procv = procvstd;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3030 nstartlf(des,lf);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3031 nvm = lf->fp.nvm;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3032 rss[k] = 0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3033 for (i=0; i<k; i++) rss[k] += -2*lf->fp.lik[i];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3034 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3035 n = lf->lfd.n; k = 1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3036 for (i=1; i<=nmax; i++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3037 { /* cp[i] = (n-5*nmax)*rss[i]/rss[nmax]-(n-10*i); */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3038 cp[i] = rss[i]/sig2-(n-10*i);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3039 if (cp[i]<cp[k]) k = i;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3040 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3041 lf->evs.mg[0] = k;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3042 lf->evs.fl[0] = 1.0/(2*k);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3043 lf->evs.fl[1] = 1-1.0/(2*k);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3044 nn(&lf->sp) = 0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3045 fixh(&lf->sp) = 1.0/(2*k);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3046 lf->mdl.procv = procvstd;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3047 nstartlf(des,lf);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3048 ker(&lf->sp) = mk; ev(&lf->evs) = evo;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3049 nvm = lf->fp.nvm;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3050 th22 = 0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3051 for (i=10; i<n-10; i++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3052 { j = floor(k*datum(&lf->lfd,0,i));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3053 if (j>=k) j = k-1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3054 dx = datum(&lf->lfd,0,i)-evptx(&lf->fp,0,j);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3055 if (dg1==2)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3056 d2 = lf->fp.coef[2*nvm+j]+dx*lf->fp.coef[3*nvm+j]+dx*dx*lf->fp.coef[4*nvm+j]/2;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3057 else d2 = lf->fp.coef[4*nvm+j];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3058 th22 += d2*d2;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3059 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3060 hh = Wikk(mk,dg0)*sig2/th22*(n-20.0)/n;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3061 return(exp(log(hh)/(2*dg1+1)));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3062 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3063
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3064 #define MAXMETH 10
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3065
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3066 void rband(lf,des,hhat)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3067 lfit *lf;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3068 design *des;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3069 double *hhat;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3070 { int i, dg, nmeth, meth[MAXMETH];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3071 double h0, res[10];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3072
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3073 nmeth = lf->dv.nd;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3074 for (i=0; i<nmeth; i++) meth[i] = lf->dv.deriv[i];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3075 lf->dv.nd = 0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3076
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3077 /* first, estimate sigma^2.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3078 * this is ridiculously bad. lf->sp.fixh = 0.05????
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3079 */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3080 /* dg = deg(&lf->sp); deg(&lf->sp) = 2;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3081 h0 = lf->sp.fixh; lf->sp.fixh = 0.05;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3082 lf->mdl.procv = procvstd;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3083 nstartlf(des,lf);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3084 ressumm(lf,des,res);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3085 deg(&lf->sp) = dg; lf->sp.fixh = h0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3086 sig2 = res[3]; */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3087
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3088 for (i=0; i<nmeth; i++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3089 {
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3090 switch(meth[i])
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3091 { case 0: hhat[i] = cp(des,lf,1);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3092 break;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3093 case 1: hhat[i] = cp(des,lf,2);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3094 break;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3095 case 2: hhat[i] = gkk(des,lf);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3096 break;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3097 case 3: hhat[i] = rsw(des,lf);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3098 break;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3099 default: hhat[i] = 0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3100 mut_printf("Unknown method %d\n",meth[i]);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3101 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3102 if (lf_error) i = nmeth;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3103 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3104 lf->dv.nd = nmeth;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3105 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3106
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3107 void initrband(lf)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3108 lfit *lf;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3109 {
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3110 initstd(lf);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3111 KEEPC(lf) = MAXMETH;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3112 PROCV(lf) = NULL;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3113 PPROC(lf) = rband;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3114 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3115 /*
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3116 * Copyright 1996-2006 Catherine Loader.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3117 */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3118 #include "lfev.h"
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3119 static double scb_crit, *x, c[10], kap[5], kaq[5], max_p2;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3120 static int side, type;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3121 design *scb_des;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3122
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3123 double covar_par(lf,des,x1,x2)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3124 lfit *lf;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3125 design *des;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3126 double x1, x2;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3127 { double *v1, *v2, *wk;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3128 paramcomp *pc;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3129 int i, j, p, ispar;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3130
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3131 v1 = des->f1; v2 = des->ss; wk = des->oc;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3132 ispar = (ker(&lf->sp)==WPARM) && (haspc(&lf->pc));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3133 p = npar(&lf->sp);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3134
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3135 /* for parametric models, the covariance is
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3136 * A(x1)^T (X^T W V X)^{-1} A(x2)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3137 * which we can find easily from the parametric component.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3138 */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3139 if (ispar)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3140 { pc = &lf->pc;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3141 fitfun(&lf->lfd, &lf->sp, &x1,pc->xbar,v1,NULL);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3142 fitfun(&lf->lfd, &lf->sp, &x2,pc->xbar,v2,NULL);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3143 jacob_hsolve(&lf->pc.xtwx,v1);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3144 jacob_hsolve(&lf->pc.xtwx,v2);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3145 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3146
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3147 /* for non-parametric models, we must use the cholseky decomposition
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3148 * of M2 = X^T W^2 V X. Courtesy of lf_vcov caclulations, should have
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3149 * des->P = M2^{1/2} M1^{-1}.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3150 */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3151 if (!ispar)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3152 { fitfun(&lf->lfd, &lf->sp, &x1,des->xev,wk,NULL);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3153 for (i=0; i<p; i++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3154 { v1[i] = 0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3155 for (j=0; j<p; j++) v1[i] += des->P[i*p+j]*wk[j];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3156 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3157 fitfun(&lf->lfd, &lf->sp, &x2,des->xev,wk,NULL);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3158 for (i=0; i<p; i++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3159 { v2[i] = 0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3160 for (j=0; j<p; j++) v2[i] += des->P[i*p+j]*wk[j];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3161 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3162 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3163
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3164 return(innerprod(v1,v2,p));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3165 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3166
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3167 void cumulant(lf,des,sd)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3168 lfit *lf;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3169 design *des;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3170 double sd;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3171 { double b2i, b3i, b3j, b4i;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3172 double ss, si, sj, uii, uij, ujj, k1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3173 int ii, i, j, jj;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3174 for (i=1; i<10; i++) c[i] = 0.0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3175 k1 = 0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3176
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3177 /* ss = sd*sd; */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3178 ss = covar_par(lf,des,des->xev[0],des->xev[0]);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3179
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3180 /*
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3181 * this isn't valid for nonparametric models. At a minimum,
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3182 * the sums would have to include weights. Still have to work
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3183 * out the right way.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3184 */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3185 for (i=0; i<lf->lfd.n; i++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3186 { ii = des->ind[i];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3187 b2i = b2(fitv(des,ii),fam(&lf->sp),prwt(&lf->lfd,ii));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3188 b3i = b3(fitv(des,ii),fam(&lf->sp),prwt(&lf->lfd,ii));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3189 b4i = b4(fitv(des,ii),fam(&lf->sp),prwt(&lf->lfd,ii));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3190 si = covar_par(lf,des,des->xev[0],datum(&lf->lfd,0,ii));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3191 uii= covar_par(lf,des,datum(&lf->lfd,0,ii),datum(&lf->lfd,0,ii));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3192 if (lf_error) return;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3193
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3194 c[2] += b4i*si*si*uii;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3195 c[6] += b4i*si*si*si*si;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3196 c[7] += b3i*si*uii;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3197 c[8] += b3i*si*si*si;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3198 /* c[9] += b2i*si*si*si*si;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3199 c[9] += b2i*b2i*si*si*si*si; */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3200 k1 += b3i*si*(si*si/ss-uii);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3201
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3202 /* i=j components */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3203 c[1] += b3i*b3i*si*si*uii*uii;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3204 c[3] += b3i*b3i*si*si*si*si*uii;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3205 c[4] += b3i*b3i*si*si*uii*uii;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3206
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3207 for (j=i+1; j<lf->lfd.n; j++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3208 { jj = des->ind[j];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3209 b3j = b3(fitv(des,ii),fam(&lf->sp),prwt(&lf->lfd,jj));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3210 sj = covar_par(lf,des,des->xev[0],datum(&lf->lfd,0,jj));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3211 uij= covar_par(lf,des,datum(&lf->lfd,0,ii),datum(&lf->lfd,0,jj));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3212 ujj= covar_par(lf,des,datum(&lf->lfd,0,jj),datum(&lf->lfd,0,jj));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3213
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3214 c[1] += 2*b3i*b3j*si*sj*uij*uij;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3215 c[3] += 2*b3i*b3j*si*si*sj*sj*uij;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3216 c[4] += b3i*b3j*uij*(si*si*ujj+sj*sj*uii);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3217 if (lf_error) return;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3218 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3219 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3220 c[5] = c[1];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3221 c[7] = c[7]*c[8];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3222 c[8] = c[8]*c[8];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3223
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3224 c[1] /= ss; c[2] /= ss; c[3] /= ss*ss; c[4] /= ss;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3225 c[5] /= ss; c[6] /= ss*ss; c[7] /= ss*ss;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3226 c[8] /= ss*ss*ss; c[9] /= ss*ss;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3227
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3228 /* constants used in p(x,z) computation */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3229 kap[1] = k1/(2*sqrt(ss));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3230 kap[2] = 1 + 0.5*(c[1]-c[2]+c[4]-c[7]) - 3*c[3] + c[6] + 1.75*c[8];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3231 kap[4] = -9*c[3] + 3*c[6] + 6*c[8] + 3*c[9];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3232
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3233 /* constants used in q(x,u) computation */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3234 kaq[2] = c[3] - 1.5*c[8] - c[5] - c[4] + 0.5*c[7] + c[6] - c[2];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3235 kaq[4] = -3*c[3] - 6*c[4] - 6*c[5] + 3*c[6] + 3*c[7] - 3*c[8] + 3*c[9];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3236 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3237
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3238 /* q2(u) := u+q2(x,u) in paper */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3239 double q2(u)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3240 double u;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3241 { return(u-u*(36.0*kaq[2] + 3*kaq[4]*(u*u-3) + c[8]*((u*u-10)*u*u+15))/72.0);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3242 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3243
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3244 /* p2(u) := p2(x,u) in paper */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3245 double p2(u)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3246 double u;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3247 { return( -u*( 36*(kap[2]-1+kap[1]*kap[1])
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3248 + 3*(kap[4]+4*kap[1]*sqrt(kap[3]))*(u*u-3)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3249 + c[8]*((u*u-10)*u*u+15) ) / 72 );
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3250 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3251
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3252 extern int likereg();
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3253 double gldn_like(a)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3254 double a;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3255 { int err;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3256
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3257 scb_des->fix[0] = 1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3258 scb_des->cf[0] = a;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3259 max_nr(likereg, scb_des->cf, scb_des->oc, scb_des->res, scb_des->f1,
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3260 &scb_des->xtwx, scb_des->p, lf_maxit, 1.0e-6, &err);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3261 scb_des->fix[0] = 0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3262
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3263 return(scb_des->llk);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3264 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3265
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3266 /* v1/v2 is correct for deg=0 only */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3267 void get_gldn(fp,des,lo,hi,v)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3268 fitpt *fp;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3269 design *des;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3270 double *lo, *hi;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3271 int v;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3272 { double v1, v2, c, tlk;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3273 int err;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3274
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3275 v1 = fp->nlx[v];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3276 v2 = fp->t0[v];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3277 c = scb_crit * v1 / v2;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3278 tlk = des->llk - c*c/2;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3279 mut_printf("v %8.5f %8.5f c %8.5f tlk %8.5f llk %8.5f\n",v1,v2,c,tlk,des->llk);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3280
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3281 /* want: { a : l(a) >= l(a-hat) - c*c/2 } */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3282 lo[v] = fp->coef[v] - scb_crit*v1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3283 hi[v] = fp->coef[v] + scb_crit*v1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3284
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3285 err = 0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3286
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3287 mut_printf("lo %2d\n",v);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3288 lo[v] = solve_secant(gldn_like,tlk,lo[v],fp->coef[v],1e-8,BDF_EXPLEFT,&err);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3289 if (err>0) mut_printf("solve_secant error\n");
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3290 mut_printf("hi %2d\n",v);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3291 hi[v] = solve_secant(gldn_like,tlk,fp->coef[v],hi[v],1e-8,BDF_EXPRIGHT,&err);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3292 if (err>0) mut_printf("solve_secant error\n");
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3293 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3294
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3295 int procvscb2(des,lf,v)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3296 design *des;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3297 lfit *lf;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3298 int v;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3299 { double thhat, sd, *lo, *hi, u;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3300 int err, st, tmp;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3301 x = des->xev = evpt(&lf->fp,v);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3302 tmp = haspc(&lf->pc);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3303 /* if ((ker(&lf->sp)==WPARM) && (haspc(&lf->pc)))
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3304 { lf->coef[v] = thhat = addparcomp(lf,des->xev,PCOEF);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3305 lf->nlx[v] = lf->t0[v] = sd = addparcomp(lf,des->xev,PNLX);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3306 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3307 else */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3308 { haspc(&lf->pc) = 0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3309 st = procvstd(des,lf,v);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3310 thhat = lf->fp.coef[v];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3311 sd = lf->fp.nlx[v];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3312 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3313 if ((type==GLM2) | (type==GLM3) | (type==GLM4))
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3314 { if (ker(&lf->sp) != WPARM)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3315 WARN(("nonparametric fit; correction is invalid"));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3316 cumulant(lf,des,sd);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3317 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3318 haspc(&lf->pc) = tmp;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3319 lo = lf->fp.t0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3320 hi = &lo[lf->fp.nvm];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3321 switch(type)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3322 {
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3323 case GLM1:
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3324 return(st);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3325 case GLM2: /* centered scr */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3326 lo[v] = kap[1];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3327 hi[v] = sqrt(kap[2]);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3328 return(st);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3329 case GLM3: /* corrected 2 */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3330 lo[v] = solve_secant(q2,scb_crit,0.0,2*scb_crit,0.000001,BDF_NONE,&err);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3331 return(st);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3332 case GLM4: /* corrected 2' */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3333 u = fabs(p2(scb_crit));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3334 max_p2 = MAX(max_p2,u);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3335 return(st);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3336 case GLDN:
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3337 get_gldn(&lf->fp,des,lo,hi,v);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3338 return(st);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3339 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3340 LERR(("procvscb2: invalid type"));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3341 return(st);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3342 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3343
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3344 void scb(lf,des,res)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3345 lfit *lf;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3346 design *des;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3347 double *res;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3348 { double k1, k2, *lo, *hi, sig, thhat, nlx, rss[10];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3349 int i, nterms;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3350
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3351 scb_des= des;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3352
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3353 npar(&lf->sp) = calcp(&lf->sp,lf->lfd.d);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3354 des_init(des,lf->lfd.n,npar(&lf->sp));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3355
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3356 type = geth(&lf->fp);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3357
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3358 if (type >= 80) /* simultaneous */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3359 {
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3360 nterms = constants(lf,des,res);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3361 scb_crit = critval(0.05,res,nterms,lf->lfd.d,TWO_SIDED,0.0,GAUSS);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3362 type -= 10;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3363 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3364 else /* pointwise */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3365 { res[0] = 1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3366 scb_crit = critval(0.05,res,1,lf->lfd.d,TWO_SIDED,0.0,GAUSS);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3367 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3368
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3369 max_p2 = 0.0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3370 lf->mdl.procv = procvscb2;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3371 nstartlf(des,lf);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3372
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3373 if ((fam(&lf->sp)&64)==64)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3374 { i = haspc(&lf->pc); haspc(&lf->pc) = 0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3375 ressumm(lf,des,rss);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3376 haspc(&lf->pc) = i;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3377 sig = sqrt(rss[3]);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3378 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3379 else sig = 1.0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3380
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3381 lo = lf->fp.t0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3382 hi = &lo[lf->fp.nvm];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3383 for (i=0; i<lf->fp.nv; i++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3384 { thhat = lf->fp.coef[i];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3385 nlx = lf->fp.nlx[i];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3386 switch(type)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3387 {
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3388 case GLM1: /* basic scb */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3389 lo[i] = thhat - scb_crit * sig * nlx;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3390 hi[i] = thhat + scb_crit * sig * nlx;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3391 break;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3392 case GLM2:
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3393 k1 = lo[i];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3394 k2 = hi[i];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3395 lo[i] = thhat - k1*nlx - scb_crit*nlx*k2;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3396 hi[i] = thhat - k1*nlx + scb_crit*nlx*k2;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3397 break;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3398 case GLM3:
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3399 k1 = lo[i];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3400 lo[i] = thhat - k1*nlx;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3401 hi[i] = thhat + k1*nlx;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3402 case GLM4: /* corrected 2' */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3403 lo[i] = thhat - (scb_crit-max_p2)*lf->fp.nlx[i];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3404 hi[i] = thhat + (scb_crit-max_p2)*lf->fp.nlx[i];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3405 break;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3406 case GLDN:
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3407 break;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3408 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3409 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3410 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3411
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3412 void initscb(lf)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3413 lfit *lf;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3414 { initstd(lf);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3415 PROCV(lf) = NULL;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3416 KEEPC(lf) = NVAR(lf)+1+k0_reqd(NVAR(lf),NOBS(lf),0);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3417 PPROC(lf) = scb;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3418 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3419 /*
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3420 * Copyright 1996-2006 Catherine Loader.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3421 */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3422 #include "lfev.h"
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3423
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3424 int procvsimple(des,lf,v)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3425 design *des;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3426 lfit *lf;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3427 int v;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3428 { int lf_status;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3429 lf_status = procv_nov(des,lf,v);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3430 VVAL(lf,v,0) = des->cf[cfn(des,0)];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3431 return(lf_status);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3432 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3433
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3434 void allocsimple(lf)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3435 lfit *lf;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3436 { lf->fp.coef = VVEC(lf,0);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3437 lf->fp.h = NULL;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3438 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3439
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3440 void initsimple(lf)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3441 lfit *lf;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3442 {
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3443 PROCV(lf) = procvsimple;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3444 ALLOC(lf) = allocsimple;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3445 PPROC(lf) = NULL;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3446 KEEPV(lf) = 1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3447 KEEPC(lf) = 1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3448 NOPC(lf) = 1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3449 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3450 /*
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3451 * Copyright 1996-2006 Catherine Loader.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3452 */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3453 #include "lfev.h"
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3454
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3455 /* 3d+8 variables to keep:
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3456 * d+1 coef+derivs.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3457 * d+1 sd's + derivs.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3458 * d+1 infl + derivs.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3459 * 3 likelihood and d.f's.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3460 * 1 bandwidth h
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3461 * 1 degree.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3462 */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3463
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3464 void allocstd(lf)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3465 lfit *lf;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3466 { int d;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3467 d = NVAR(lf);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3468 lf->fp.coef = VVEC(lf,0);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3469 lf->fp.nlx = VVEC(lf,d+1);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3470 lf->fp.t0 = VVEC(lf,2*d+2);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3471 lf->fp.lik = VVEC(lf,3*d+3);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3472 lf->fp.h = VVEC(lf,3*d+6);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3473 lf->fp.deg = VVEC(lf,3*d+7);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3474 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3475
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3476 int procvstd(des,lf,v)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3477 design *des;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3478 lfit *lf;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3479 int v;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3480 { int d, p, nvm, i, k;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3481 double t0[1+MXDIM], vari[1+MXDIM];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3482 k = procv_var(des,lf,v);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3483 if (lf_error) return(k);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3484
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3485 d = lf->lfd.d;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3486 p = npar(&lf->sp);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3487 nvm = lf->fp.nvm;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3488
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3489 if (k != LF_OK) lf_status_msg(k);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3490
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3491 lf->fp.lik[v] = des->llk;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3492 lf->fp.lik[nvm+v] = des->tr2;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3493 lf->fp.lik[2*nvm+v] = des->tr0 - des->tr2;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3494
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3495 for (i=0; i<des->ncoef; i++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3496 vari[i] = des->V[p*cfn(des,0) + cfn(des,i)];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3497 vari[0] = sqrt(vari[0]);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3498 if (vari[0]>0) for (i=1; i<des->ncoef; i++) vari[i] /= vari[0];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3499
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3500 t0[0] = sqrt(des->f1[0]);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3501 if (t0[0]>0) for (i=1; i<des->ncoef; i++) t0[i] = des->f1[i]/t0[0];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3502
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3503 if (dc(&lf->fp)) dercor(&lf->lfd,&lf->sp,des,des->cf);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3504 subparcomp(des,lf,des->cf);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3505 for (i=0; i<des->ncoef; i++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3506 lf->fp.coef[i*lf->fp.nvm+v] = des->cf[cfn(des,i)];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3507
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3508 subparcomp2(des,lf,vari,t0);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3509 for (i=0; i<des->ncoef; i++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3510 { lf->fp.nlx[i*nvm+v] = vari[i];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3511 lf->fp.t0[i*nvm+v] = t0[i];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3512 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3513
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3514 lf->fp.deg[v] = deg(&lf->sp);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3515 return(k);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3516 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3517
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3518 void pprocstd(lf,des,res)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3519 lfit *lf;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3520 design *des;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3521 double *res;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3522 {
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3523 ressumm(lf,des,res);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3524 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3525
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3526 void initstd(lf)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3527 lfit *lf;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3528 { PROCV(lf) = procvstd;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3529 ALLOC(lf) = allocstd;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3530 PPROC(lf) = pprocstd;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3531 KEEPV(lf) = 3*NVAR(lf) + 8;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3532 KEEPC(lf) = 6;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3533 NOPC(lf) = 0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3534 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3535 /*
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3536 * Copyright 1996-2006 Catherine Loader.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3537 */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3538 #include "lfev.h"
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3539
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3540 extern void procstd(), allocstd();
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3541 extern double robscale;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3542
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3543 double vocri(lk,t0,t2,pen)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3544 double lk, t0, t2, pen;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3545 { if (pen==0) return(-2*t0*lk/((t0-t2)*(t0-t2)));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3546 return((-2*lk+pen*t2)/t0);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3547 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3548
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3549 double intvo(des,lf,c0,c1,a,p,t0,t20,t21)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3550 design *des;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3551 lfit *lf;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3552 double *c0, *c1, a, t0, t20, t21;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3553 int p;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3554 { double th, lk, link[LLEN];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3555 int i, ii;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3556 lk = 0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3557 for (i=0; i<des->n; i++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3558 { ii = des->ind[i];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3559 th = (1-a)*innerprod(c0,d_xi(des,i),p) + a*innerprod(c1,d_xi(des,i),p);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3560 stdlinks(link,&lf->lfd,&lf->sp,ii,th,robscale);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3561 lk += wght(des,ii)*link[ZLIK];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3562 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3563 des->llk = lk;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3564 return(vocri(des->llk,t0,(1-a)*t20+a*t21,pen(&lf->sp)));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3565 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3566
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3567 int procvvord(des,lf,v)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3568 design *des;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3569 lfit *lf;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3570 int v;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3571 { double tr[6], gcv, g0, ap, coef[4][10], t2[4], th, md;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3572 int i, j, k, d1, i0, p1, ip;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3573 des->xev = evpt(&lf->fp,v);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3574
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3575 ap = pen(&lf->sp);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3576 if ((ap==0) & ((fam(&lf->sp)&63)!=TGAUS)) ap = 2.0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3577 d1 = deg(&lf->sp); p1 = npar(&lf->sp);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3578 for (i=0; i<p1; i++) coef[0][i] = coef[1][i] = coef[2][i] = coef[3][i] = 0.0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3579 i0 = 0; g0 = 0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3580 ip = 1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3581
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3582 for (i=deg0(&lf->sp); i<=d1; i++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3583 { deg(&lf->sp) = i;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3584 des->p = npar(&lf->sp) = calcp(&lf->sp,lf->lfd.d);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3585 k = locfit(&lf->lfd,des,&lf->sp,0, i==deg0(&lf->sp),0);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3586
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3587 local_df(&lf->lfd,&lf->sp,des,tr);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3588 gcv = vocri(des->llk,tr[0],tr[2],ap);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3589 if ((i==deg0(&lf->sp)) || (gcv<g0)) { i0 = i; g0 = gcv; md = i; }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3590
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3591 for (j=0; j<des->p; j++) coef[i][j] = des->cf[j];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3592 t2[i] = tr[2];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3593
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3594 #ifdef RESEARCH
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3595 if ((ip) && (i>deg0(&lf->sp)))
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3596 { for (j=1; j<10; j++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3597 { gcv = intvo(des,lf,coef[i-1],coef[i],j/10.0,des->p,tr[0],t2[i-1],t2[i]);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3598 if (gcv<g0) { g0 = gcv; md = i-1+j/10.0; }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3599 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3600 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3601 #endif
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3602 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3603 lf->fp.h[v] = des->h;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3604 if (lf->fp.h[v]<=0) WARN(("zero bandwidth in procvvord"));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3605
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3606 if (i0<d1) /* recompute the best fit */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3607 { deg(&lf->sp) = i0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3608 des->p = npar(&lf->sp) = calcp(&lf->sp,lf->lfd.d);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3609 k = locfit(&lf->lfd,des,&lf->sp,0,0,0);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3610 for (i=npar(&lf->sp); i<p1; i++) des->cf[i] = 0.0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3611 i0 = md; if (i0==d1) i0--;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3612 th = md-i0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3613 for (i=0; i<p1; i++) des->cf[i] = (1-th)*coef[i0][i]+th*coef[i0+1][i];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3614 deg(&lf->sp) = d1; npar(&lf->sp) = p1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3615 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3616
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3617 for (i=0; i<p1; i++) lf->fp.coef[i*lf->fp.nvm+v] = des->cf[i];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3618 lf->fp.deg[v] = md;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3619 return(k);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3620 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3621
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3622 void initvord(lf)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3623 lfit *lf;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3624 { initstd(lf);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3625 PROCV(lf) = procvvord;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3626 ALLOC(lf) = allocstd;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3627 PPROC(lf) = NULL;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3628 KEEPC(lf) = 0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3629 NOPC(lf) = 1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3630 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3631 /*
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3632 * Copyright 1996-2006 Catherine Loader.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3633 */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3634 /*
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3635 * functions for computing and subtracting, adding the
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3636 * parametric component
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3637 */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3638
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3639 #include "lfev.h"
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3640
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3641 int noparcomp(sp)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3642 smpar *sp;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3643 { int tg;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3644 if (ubas(sp)) return(1);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3645 tg = fam(sp) & 63;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3646 if (tg<=THAZ) return(1);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3647 if (tg==TROBT) return(1);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3648 if (tg==TCAUC) return(1);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3649 if (tg==TQUANT) return(1);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3650 return(0);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3651 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3652
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3653 int pc_reqd(d,p)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3654 int d, p;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3655 { return(d + 2*p + jac_reqd(p));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3656 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3657
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3658 void pcchk(pc,d,p,lc)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3659 paramcomp *pc;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3660 int d, p, lc;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3661 { int rw;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3662 double *z;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3663
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3664 rw = pc_reqd(d,p);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3665 if (pc->lwk < rw)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3666 { pc->wk = (double *)calloc(rw,sizeof(double));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3667 if ( pc->wk == NULL ) {
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3668 printf("Problem allocating memory for pc->wk\n");fflush(stdout);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3669 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3670 pc->lwk= rw;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3671 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3672 z = pc->wk;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3673
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3674 pc->xbar = z; z += d;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3675 pc->coef = z; z += p;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3676 pc->f = z; z += p;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3677
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3678 z = jac_alloc(&pc->xtwx,p,z);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3679 pc->xtwx.p = p;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3680 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3681
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3682 void compparcomp(des,lfd,sp,pc,nopc)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3683 design *des;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3684 lfdata *lfd;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3685 smpar *sp;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3686 paramcomp *pc;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3687 int nopc;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3688 { int i, j, k, p;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3689 double wt, sw;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3690
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3691 if (lf_debug>1) mut_printf(" compparcomp:\n");
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3692 p = des->p;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3693 pcchk(pc,lfd->d,p,1);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3694
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3695 for (i=0; i<lfd->d; i++) pc->xbar[i] = 0.0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3696 sw = 0.0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3697 for (i=0; i<lfd->n; i++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3698 {
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3699 wt = prwt(lfd,i);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3700 sw += wt;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3701 for (j=0; j<lfd->d; j++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3702 pc->xbar[j] += datum(lfd,j,i)*wt;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3703 des->ind[i] = i;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3704 wght(des,i) = 1.0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3705 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3706 for (i=0; i<lfd->d; i++) pc->xbar[i] /= sw;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3707 if ((nopc) || noparcomp(sp))
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3708 { haspc(pc) = 0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3709 return;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3710 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3711 haspc(pc) = 1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3712 des->xev = pc->xbar;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3713 k = locfit(lfd,des,sp,0,0,0);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3714 if (k != LF_OK) lf_status_msg(k);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3715 if (lf_error) return;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3716 switch(k)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3717 { case LF_NOPT: return;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3718 case LF_INFA: return;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3719 case LF_NCON: return;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3720 case LF_OOB: return;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3721 case LF_NSLN: return;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3722 case LF_PF:
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3723 WARN(("compparcomp: perfect fit"));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3724 case LF_OK:
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3725 case LF_DONE:
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3726 for (i=0; i<p; i++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3727 { pc->coef[i] = des->cf[i];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3728 pc->xtwx.dg[i] = des->xtwx.dg[i];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3729 pc->xtwx.wk[i] = des->xtwx.wk[i];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3730 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3731 for (i=0; i<p*p; i++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3732 { pc->xtwx.Z[i] = des->xtwx.Z[i];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3733 pc->xtwx.Q[i] = des->xtwx.Q[i];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3734 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3735 pc->xtwx.sm = des->xtwx.sm;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3736 pc->xtwx.st = des->xtwx.st;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3737 return;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3738 default:
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3739 LERR(("compparcomp: locfit unknown return status %d",k));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3740 return;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3741 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3742 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3743
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3744 void subparcomp(des,lf,coef)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3745 design *des;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3746 lfit *lf;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3747 double *coef;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3748 { int i, nd;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3749 deriv *dv;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3750 paramcomp *pc;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3751
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3752 pc = &lf->pc;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3753 if (!haspc(pc)) return;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3754
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3755 dv = &lf->dv; nd = dv->nd;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3756 fitfun(&lf->lfd, &lf->sp, des->xev,pc->xbar,des->f1,dv);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3757 coef[0] -= innerprod(pc->coef,des->f1,pc->xtwx.p);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3758 if (des->ncoef == 1) return;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3759
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3760 dv->nd = nd+1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3761 for (i=0; i<lf->lfd.d; i++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3762 { dv->deriv[nd] = i;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3763 fitfun(&lf->lfd, &lf->sp, des->xev,pc->xbar,des->f1,dv);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3764 coef[i+1] -= innerprod(pc->coef,des->f1,pc->xtwx.p);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3765 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3766 dv->nd = nd;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3767 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3768
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3769 void subparcomp2(des,lf,vr,il)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3770 design *des;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3771 lfit *lf;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3772 double *vr, *il;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3773 { double t0, t1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3774 int i, nd;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3775 deriv *dv;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3776 paramcomp *pc;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3777
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3778 pc = &lf->pc;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3779 if (!haspc(pc)) return;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3780
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3781 dv = &lf->dv; nd = dv->nd;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3782
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3783 fitfun(&lf->lfd, &lf->sp, des->xev,pc->xbar,des->f1,dv);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3784 for (i=0; i<npar(&lf->sp); i++) pc->f[i] = des->f1[i];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3785 jacob_solve(&pc->xtwx,des->f1);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3786 t0 = sqrt(innerprod(pc->f,des->f1,pc->xtwx.p));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3787 vr[0] -= t0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3788 il[0] -= t0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3789 if ((t0==0) | (des->ncoef==1)) return;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3790
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3791 dv->nd = nd+1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3792 for (i=0; i<lf->lfd.d; i++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3793 { dv->deriv[nd] = i;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3794 fitfun(&lf->lfd, &lf->sp, des->xev,pc->xbar,pc->f,dv);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3795 t1 = innerprod(pc->f,des->f1,pc->xtwx.p)/t0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3796 vr[i+1] -= t1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3797 il[i+1] -= t1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3798 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3799 dv->nd = nd;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3800 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3801
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3802 double addparcomp(lf,x,c)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3803 lfit *lf;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3804 double *x;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3805 int c;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3806 { double y;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3807 paramcomp *pc;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3808
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3809 pc = &lf->pc;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3810 if (!haspc(pc)) return(0.0);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3811 fitfun(&lf->lfd, &lf->sp, x,pc->xbar,pc->f,&lf->dv);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3812 if (c==PCOEF) return(innerprod(pc->coef,pc->f,pc->xtwx.p));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3813 if ((c==PNLX)|(c==PT0)|(c==PVARI))
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3814 { y = sqrt(jacob_qf(&pc->xtwx,pc->f));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3815 return(y);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3816 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3817 return(0.0);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3818 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3819 /*
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3820 * Copyright 1996-2006 Catherine Loader.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3821 */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3822 #include "lfev.h"
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3823
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3824 /*
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3825 preplot(): interpolates the fit to a new set of points.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3826 lf -- the fit structure.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3827 x -- the points to predict at.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3828 f -- vector to return the predictions.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3829 se -- vector to return std errors (NULL if not req'd)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3830 band-- char for conf band type. ('n'=none, 'g'=global etc.)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3831 n -- no of predictions (or vector of margin lengths for grid)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3832 where -- where to predict:
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3833 1 = points in the array x.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3834 2 = grid defined by margins in x.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3835 3 = data points from lf (ignore x).
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3836 4 = fit points from lf (ignore x).
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3837 what -- what to predict.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3838 (PCOEF etc; see lfcons.h file)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3839
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3840 */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3841
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3842 #define NWH 8
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3843 static char *whtyp[NWH] = { "coef", "nlx", "infl", "band",
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3844 "degr", "like", "rdf", "vari" };
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3845 static int whval[NWH] = { PCOEF, PNLX, PT0, PBAND, PDEGR, PLIK, PRDF, PVARI };
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3846 int ppwhat(z)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3847 char *z;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3848 { int val;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3849
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3850 val = pmatch(z, whtyp, whval, NWH, -1);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3851 if (val==-1) LERR(("Unknown what = %s",z));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3852 return(val);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3853 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3854
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3855 static char cb;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3856 double *sef, *fit, sigmahat;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3857
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3858 void predptall(lf,x,what,ev,i)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3859 lfit *lf;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3860 double *x;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3861 int what, ev, i;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3862 { double lik, rdf;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3863 fit[i] = dointpoint(lf,x,what,ev,i);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3864 if (cb=='n') return;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3865 sef[i] = dointpoint(lf,x,PNLX,ev,i);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3866 if (cb=='g')
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3867 { sef[i] *= sigmahat;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3868 return;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3869 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3870 if (cb=='l')
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3871 { lik = dointpoint(lf,x,PLIK,ev,i);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3872 rdf = dointpoint(lf,x,PRDF,ev,i);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3873 sef[i] *= sqrt(-2*lik/rdf);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3874 return;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3875 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3876 if (cb=='p')
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3877 { sef[i] = sigmahat*sqrt(1+sef[i]*sef[i]);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3878 return;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3879 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3880 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3881
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3882 void predptdir(lf,des,x,what,i)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3883 lfit *lf;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3884 design *des;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3885 double *x;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3886 int what, i;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3887 { int needcv;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3888 des->xev = x;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3889 needcv = (what==PVARI) | (what==PNLX) | (what==PT0) | (what==PRDF);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3890 locfit(&lf->lfd,des,&lf->sp,0,1,needcv);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3891 switch(what)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3892 { case PCOEF: fit[i] = des->cf[0]; break;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3893 case PVARI: fit[i] = des->V[0]; break;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3894 case PNLX: fit[i] = sqrt(des->V[0]); break;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3895 case PT0: fit[i] = des->f1[0]; break;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3896 case PBAND: fit[i] = des->h; break;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3897 case PDEGR: fit[i] = deg(&lf->sp); break;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3898 case PLIK: fit[i] = des->llk; break;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3899 case PRDF: fit[i] = des->tr0 - des->tr2; break;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3900 default: LERR(("unknown what in predptdir"));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3901 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3902 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3903
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3904 void prepvector(lf,des,x,n,what,dir) /* interpolate a vector */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3905 lfit *lf;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3906 design *des;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3907 double **x;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3908 int n, what, dir;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3909 { int i, j;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3910 double xx[MXDIM];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3911 for (i=0; i<n; i++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3912 { for (j=0; j<lf->fp.d; j++) xx[j] = x[j][i];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3913 if (dir)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3914 predptdir(lf,des,xx,what,i);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3915 else
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3916 predptall(lf,xx,what,ev(&lf->evs),i);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3917 if (lf_error) return;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3918 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3919 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3920
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3921 void prepfitp(lf,what)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3922 lfit *lf;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3923 int what;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3924 { int i;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3925 for (i=0; i<lf->fp.nv; i++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3926 { predptall(lf,evpt(&lf->fp,i),what,EFITP,i);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3927 if (lf_error) return;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3928 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3929 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3930
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3931 void prepgrid(lf,des,x,mg,n,what,dir) /* interpolate a grid given margins */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3932 lfit *lf;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3933 design *des;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3934 double **x;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3935 int *mg, dir, n, what;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3936 { int i, ii, j, d;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3937 double xv[MXDIM];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3938 d = lf->fp.d;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3939 for (i=0; i<n; i++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3940 { ii = i;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3941 for (j=0; j<d; j++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3942 { xv[j] = x[j][ii%mg[j]];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3943 ii /= mg[j];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3944 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3945 if (dir)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3946 predptdir(lf,des,xv,what,i);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3947 else
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3948 predptall(lf,xv,what,ev(&lf->evs),i);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3949 if (lf_error) return;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3950 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3951 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3952
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3953 void preplot(lf,x,f,se,band,mg,where,what,dir)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3954 lfit *lf;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3955 double **x, *f, *se;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3956 int *mg, where, what, dir;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3957 char band;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3958 { int d, i, n;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3959 double *xx[MXDIM];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3960 design ppdes;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3961 d = lf->fp.d;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3962 fit = f;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3963 sef = se;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3964 cb = band;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3965 if (cb!='n') sigmahat = sqrt(rv(&lf->fp));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3966 if (dir) des_init(&ppdes,lf->lfd.n,npar(&lf->sp));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3967
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3968 switch(where)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3969 { case 1: /* vector */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3970 n = mg[0];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3971 prepvector(lf,&ppdes,x,n,what,dir);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3972 break;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3973 case 2: /* grid */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3974 n = 1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3975 for (i=0; i<d; i++) n *= mg[i];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3976 prepgrid(lf,&ppdes,x,mg,n,what,dir);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3977 break;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3978 case 3: /* data */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3979 n = lf->lfd.n;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3980 if ((ev(&lf->evs)==EDATA) | (ev(&lf->evs)==ECROS))
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3981 { prepfitp(lf,what);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3982 dir = 0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3983 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3984 else
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3985 { for (i=0; i<d; i++) xx[i] = dvari(&lf->lfd,i);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3986 prepvector(lf,&ppdes,xx,n,what,dir);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3987 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3988 break;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3989 case 4: /* fit points */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3990 n = lf->fp.nv; dir = 0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3991 prepfitp(lf,what);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3992 break;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3993 default:
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3994 LERR(("unknown where in preplot"));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3995 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3996
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3997 if ((!dir) && ((what==PT0)|(what==PVARI)))
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3998 for (i=0; i<n; i++) f[i] = f[i]*f[i];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
3999 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4000 /*
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4001 * Copyright 1996-2006 Catherine Loader.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4002 */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4003 #include "lfev.h"
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4004
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4005 int procv_nov(des,lf,v)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4006 design *des;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4007 lfit *lf;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4008 int v;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4009 { int lf_status;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4010
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4011 if (lf_debug>1) mut_printf(" procveraw: %d\n",v);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4012 des->xev = evpt(&lf->fp,v);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4013
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4014 if (acri(&lf->sp)==ANONE)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4015 lf_status = locfit(&lf->lfd,des,&lf->sp,0,1,0);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4016 else
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4017 lf_status = alocfit(&lf->lfd,&lf->sp,&lf->dv,des,0);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4018 if (lf->fp.h != NULL) lf->fp.h[v] = des->h;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4019
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4020 return(lf_status);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4021 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4022
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4023 int procv_var(des,lf,v)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4024 design *des;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4025 lfit *lf;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4026 int v;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4027 { int i, lf_status;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4028
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4029 if (lf_debug>1) mut_printf(" procvraw: %d\n",v);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4030 des->xev = evpt(&lf->fp,v);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4031
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4032 if (acri(&lf->sp)==ANONE)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4033 lf_status = locfit(&lf->lfd,des,&lf->sp,0,1,1);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4034 else
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4035 lf_status = alocfit(&lf->lfd,&lf->sp,&lf->dv,des,1);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4036 if (lf->fp.h != NULL) lf->fp.h[v] = des->h;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4037
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4038 return(lf_status);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4039 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4040 /*
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4041 * Copyright 1996-2006 Catherine Loader.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4042 */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4043 /*
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4044 * startmodule(lf,des,mod,dir) -- the standard entry point.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4045 * des and lf are pointers to the design and fit structures.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4046 * mod - module name. Set to NULL if the module is already
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4047 * initialized.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4048 * dir - for dynamic modules, the directory.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4049 *
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4050 * initmodule(mdl,mod,dir,lf)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4051 * direct call for module initialization.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4052 *
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4053 */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4054
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4055 #include "lfev.h"
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4056
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4057 #ifdef WINDOWS
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4058
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4059 #define DIRSEP '\\'
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4060 #define PATHSEP ';'
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4061
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4062 #else
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4063
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4064 #define DIRSEP '/'
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4065 #define PATHSEP ':'
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4066
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4067 #endif
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4068
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4069
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4070 #ifdef ALLOW_MODULES
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4071
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4072 #ifdef WINDOWS
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4073 #include <windows.h>
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4074 #define DLEXT "dll"
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4075 #define DLOPEN(x) LoadLibrary(x)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4076 #define DLSYM GetProcAddress
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4077
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4078 #else
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4079
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4080 #include <dlfcn.h>
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4081 #define DLEXT "so"
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4082 #define DLOPEN(x) dlopen(x,RTLD_LAZY)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4083 #define DLSYM dlsym
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4084 #endif
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4085
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4086 #endif
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4087
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4088 static double fpkap[6];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4089 void fitpt_init(fp)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4090 fitpt *fp;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4091 {
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4092 dc(fp) = 0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4093 geth(fp) = GSTD;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4094 fp->nv = fp->nvm = 0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4095 if (fp->kap==NULL) fp->kap = fpkap;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4096 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4097
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4098 void lfit_init(lf)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4099 lfit *lf;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4100 {
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4101 lfdata_init(&lf->lfd);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4102 evstruc_init(&lf->evs);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4103 smpar_init(&lf->sp,&lf->lfd);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4104 deriv_init(&lf->dv);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4105 fitpt_init(&lf->fp);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4106 lf->mdl.np = 0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4107 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4108
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4109 void fitdefault(lf)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4110 lfit *lf;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4111 { WARN(("fitdefault deprecated -- use lfit_init()"));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4112 lfit_init(lf);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4113 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4114
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4115 void set_flim(lfd,evs)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4116 lfdata *lfd;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4117 evstruc *evs;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4118 { int i, j, d, n;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4119 double z, mx, mn, *bx;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4120
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4121 if (ev(evs)==ESPHR) return;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4122 d = lfd->d; n = lfd->n;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4123 bx = evs->fl;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4124 for (i=0; i<d; i++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4125 if (bx[i]==bx[i+d])
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4126 { if (lfd->sty[i]==STANGL)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4127 { bx[i] = 0.0; bx[i+d] = 2*PI*lfd->sca[i];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4128 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4129 else
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4130 { mx = mn = datum(lfd,i,0);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4131 for (j=1; j<n; j++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4132 { mx = MAX(mx,datum(lfd,i,j));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4133 mn = MIN(mn,datum(lfd,i,j));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4134 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4135 if (lfd->xl[i]<lfd->xl[i+d]) /* user set xlim; maybe use them. */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4136 { z = mx-mn;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4137 if (mn-0.2*z < lfd->xl[i]) mn = lfd->xl[i];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4138 if (mx+0.2*z > lfd->xl[i+d]) mx = lfd->xl[i+d];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4139 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4140 bx[i] = mn;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4141 bx[i+d] = mx;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4142 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4143 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4144 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4145
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4146 double vvari(v,n)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4147 double *v;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4148 int n;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4149 { int i;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4150 double xb, s2;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4151 xb = s2 = 0.0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4152 for (i=0; i<n; i++) xb += v[i];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4153 xb /= n;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4154 for (i=0; i<n; i++) s2 += SQR(v[i]-xb);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4155 return(s2/(n-1));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4156 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4157
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4158 void set_scales(lfd)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4159 lfdata *lfd;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4160 { int i;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4161 for (i=0; i<lfd->d; i++)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4162 if (lfd->sca[i]<=0) /* set automatic scales */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4163 { if (lfd->sty[i]==STANGL)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4164 lfd->sca[i] = 1.0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4165 else lfd->sca[i] = sqrt(vvari(lfd->x[i],lfd->n));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4166 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4167 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4168
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4169 void nstartlf(des,lf)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4170 design *des;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4171 lfit *lf;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4172 { int i, d, n;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4173
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4174 if (lf_debug>0) mut_printf("nstartlf\n");
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4175 n = lf->lfd.n;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4176 d = lf->lfd.d;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4177 npar(&lf->sp) = calcp(&lf->sp,d);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4178
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4179 des_init(des,n,npar(&lf->sp));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4180 set_scales(&lf->lfd);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4181 set_flim(&lf->lfd,&lf->evs);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4182 compparcomp(des,&lf->lfd,&lf->sp,&lf->pc,lf->mdl.nopc);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4183 if (lf_error) return;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4184 makecfn(&lf->sp,des,&lf->dv,lf->lfd.d);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4185
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4186 lf->lfd.ord = 0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4187 if ((d==1) && (lf->lfd.sty[0]!=STANGL))
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4188 { i = 1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4189 while ((i<n) && (datum(&lf->lfd,0,i)>=datum(&lf->lfd,0,i-1))) i++;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4190 lf->lfd.ord = (i==n);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4191 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4192 for (i=0; i<npar(&lf->sp); i++) des->fix[i] = 0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4193
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4194 lf->fp.d = lf->lfd.d;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4195 lf->fp.hasd = (des->ncoef==(1+lf->fp.d));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4196 lf->fp.nv = lf->evs.nce = 0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4197
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4198 if (lf_debug>1) mut_printf("call eval structure %d\n",ev(&lf->evs));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4199 switch(ev(&lf->evs))
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4200 { case EPHULL: triang_start(des,lf); break;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4201 case EDATA: dataf(des,lf); break;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4202 case ECROS: crossf(des,lf); break;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4203 case EGRID: gridf(des,lf); break;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4204 case ETREE: atree_start(des,lf); break;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4205 case EKDCE: kt(&lf->sp) = KCE;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4206 case EKDTR: kdtre_start(des,lf); break;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4207 case EPRES: preset(des,lf); break;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4208 case EXBAR: xbarf(des,lf); break;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4209 case ENONE: return;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4210 case ESPHR: sphere_start(des,lf); break;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4211 case ESPEC: lf->evs.espec(des,lf); break;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4212 default: LERR(("startlf: Invalid evaluation structure %d",ev(&lf->evs)));
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4213 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4214
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4215 /* renormalize for family=density */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4216 if ((de_renorm) && (fam(&lf->sp)==TDEN)) dens_renorm(lf,des);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4217 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4218
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4219 /*
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4220 * getnextdir() gets the next dir from a string dirpath="dir1:dir2:dir3:..."
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4221 * (;-separated on windows).
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4222 * The directory is returned through dirnext, and the function returns
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4223 * a pointer to the next string.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4224 * typical usage is recursive, dirpath = getnextdir(dirpath,dirnext).
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4225 * with the above example, this sets dirnext="dir1" and dirpath="dir2:dir3:...".
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4226 * if the input dirpath has no :, then it is copied to dirnext, and return is "".
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4227 * if input dirpath is "", dirnext is set to "", and null pointer returned.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4228 */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4229 char *getnextdir(dirpath,dirnext)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4230 char *dirpath, *dirnext;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4231 { char *z;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4232 if (strlen(dirpath)==0)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4233 { sprintf(dirnext,"");
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4234 return(NULL);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4235 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4236
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4237 z = strchr(dirpath,PATHSEP);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4238 if (z==NULL)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4239 { sprintf(dirnext,"%s%c",dirpath,DIRSEP);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4240 return(&dirpath[strlen(dirnext)]);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4241 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4242
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4243 *z = '\0';
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4244 sprintf(dirnext,"%s%c",dirpath,DIRSEP);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4245 return(++z);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4246 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4247
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4248 int initmodule(mdl, mod, dir, lf)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4249 module *mdl;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4250 lfit *lf;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4251 char *mod, *dir;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4252 { int n, d, p;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4253 #ifdef ALLOW_MODULES
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4254 #ifdef WINDOWS
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4255 HINSTANCE res;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4256 typedef void (CALLBACK* DLLFN)();
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4257 DLLFN init;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4258 #else
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4259 void *res;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4260 void (*init)();
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4261 #endif
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4262 char distname[500];
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4263 #endif
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4264
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4265 n = lf->lfd.n;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4266 d = lf->lfd.d;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4267 p = npar(&lf->sp) = calcp(&lf->sp,d);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4268
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4269 mdl->isset = 1;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4270 PPROC(lf) = NULL;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4271 if (strcmp(mod,"std")==0) { initstd(lf); return(1); }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4272 if (strcmp(mod,"simple")==0) { initsimple(lf); return(1); }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4273 if (strcmp(mod,"allcf")==0) { initallcf(lf); return(1); }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4274 if (strcmp(mod,"hatm")==0) { inithatm(lf); return(1); }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4275 if (strcmp(mod,"kappa")==0) { initkappa(lf); return(1); }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4276 if (strcmp(mod,"lscv")==0) { initlscv(lf); return(1); }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4277 if (strcmp(mod,"gamf")==0) { initgam(lf); return(1); }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4278 if (strcmp(mod,"gamp")==0) { initgam(lf); return(1); }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4279 if (strcmp(mod,"rband")==0) { initrband(lf); return(1); }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4280 if (strcmp(mod,"scb")==0) { initscb(lf); return(1); }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4281 if (strcmp(mod,"vord")==0) { initvord(lf); return(1); }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4282
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4283 #ifdef ALLOW_MODULES
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4284 while (dir != NULL)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4285 {
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4286 dir = getnextdir(dir,distname);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4287 sprintf(&distname[strlen(distname)],"mod%s.%s",mod,DLEXT);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4288 res = DLOPEN(distname);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4289 if (res==NULL)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4290 {
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4291 #ifdef WINDOWS
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4292 mut_printf("LoadLibrary failed: %s, %d\n",distname,GetLastError());
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4293 #else
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4294 mut_printf("dlopen failed: %s\n",dlerror());
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4295 #endif
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4296 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4297 else
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4298 {
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4299 #ifdef WINDOWS
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4300 mut_printf("LoadLibrary success: %s\n",distname);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4301 #else
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4302 mut_printf("dlopen success: %s\n",distname);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4303 #endif
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4304 sprintf(distname,"init%s",mod);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4305 init = (void *)DLSYM(res,distname);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4306 if (init==NULL)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4307 { mut_printf("I can't find %s() function.\n",distname);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4308 mdl->isset = 0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4309 return(0);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4310 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4311 init(lf);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4312 return(1);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4313 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4314 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4315 #endif
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4316
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4317 mdl->isset = 0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4318 return(0);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4319 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4320
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4321 /*
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4322 * startmodule is the entry point to launch the fit.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4323 * if mod is provided, will first initialize the module.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4324 * if mod==NULL, assumes the module has been initialized separately.
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4325 */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4326 void startmodule(lf,des,mod,dir)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4327 lfit *lf;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4328 design *des;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4329 char *mod, *dir;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4330 { int z;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4331
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4332 if (mod != NULL)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4333 { z = initmodule(&lf->mdl,mod,dir,lf);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4334 if (!z) return;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4335 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4336
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4337 lf->fp.nv = lf->evs.nce = 0;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4338 if (lf_error) return;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4339 if (PROCV(lf) != NULL) nstartlf(des,lf);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4340 if (lf_error) return;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4341 if (PPROC(lf) != NULL) PPROC(lf)(lf,des,lf->fp.kap);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4342 }
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4343
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4344 /* for compatability, more or less. */
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4345 void startlf(des,lf,vfun,nopc)
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4346 design *des;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4347 lfit *lf;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4348 int (*vfun)(), nopc;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4349 { int z;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4350 z = initmodule(&lf->mdl,"std",NULL,lf);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4351 if (!z) return;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4352 lf->mdl.procv = vfun;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4353 lf->mdl.nopc = nopc;
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4354 nstartlf(des,lf);
0f80a5141704 version 0.3 uploaded
vipints
parents:
diff changeset
4355 }