SINFONI Pipeline Reference Manual  2.5.2
sinfo_svd.c
1 /*
2  * This file is part of the ESO SINFONI Pipeline
3  * Copyright (C) 2004,2005 European Southern Observatory
4  *
5  * This program is free software; you can redistribute it and/or modify
6  * it under the terms of the GNU General Public License as published by
7  * the Free Software Foundation; either version 2 of the License, or
8  * (at your option) any later version.
9  *
10  * This program is distributed in the hope that it will be useful,
11  * but WITHOUT ANY WARRANTY; without even the implied warranty of
12  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13  * GNU General Public License for more details.
14  *
15  * You should have received a copy of the GNU General Public License
16  * along with this program; if not, write to the Free Software
17  * Foundation, 51 Franklin St, Fifth Floor, Boston, MA 02111-1307 USA
18  */
19 /**************************************************************************
20  * E.S.O. - VLT project
21  *
22  *
23  *
24  * who when what
25  * -------- -------- ----------------------------------------------
26  * schreib 16/04/03 created
27  */
28 #ifdef HAVE_CONFIG_H
29 # include <config.h>
30 #endif
31 
32 #include "sinfo_svd.h"
33 #include "sinfo_msg.h"
41 void sinfo_fpol(float x, float *p, int np)
42 {
43  int j ;
44 
45  p[1] = 1.0 ;
46  for ( j = 2 ; j <= np ; j++ )
47  {
48  p[j] = p[j-1]*x ;
49  }
50 }
51 
52 void
53 sinfo_svb_kas(float **u, float w[], float **v, int m,
54  int n, float b[],float x[])
55 
56 
57 {
58  int jj,j,i;
59  float s,*tmp;
60 
61  tmp=sinfo_vector(1,n);
62  for (j=1;j<=n;j++) {
63  s=0.0;
64  if (w[j]) {
65  for (i=1;i<=m;i++) s += u[i][j]*b[i];
66  s /= w[j];
67  }
68  tmp[j]=s;
69  }
70  for (j=1;j<=n;j++) {
71  s=0.0;
72  for (jj=1;jj<=n;jj++) s += v[j][jj]*tmp[jj];
73  x[j]=s;
74  }
75  sinfo_free_vector(tmp,1/*,n*/);
76 }
77 
78 void sinfo_svd_variance(float **v , int ma , float w[] , float **cvm)
79 {
80  int k,j,i;
81  float sum,*wti;
82 
83  wti=sinfo_vector(1,ma);
84  for (i=1;i<=ma;i++) {
85  wti[i]=0.0;
86  if (w[i]) wti[i]=1.0/(w[i]*w[i]);
87  }
88  for (i=1;i<=ma;i++) {
89  for (j=1;j<=i;j++) {
90  for (sum=0.0,k=1;k<=ma;k++) sum += (v[i][k]*v[j][k]*wti[k]);
91  cvm[j][i]=cvm[i][j]=sum;
92  }
93  }
94  sinfo_free_vector(wti,1/*,ma*/);
95 }
96 
97 #define TOL 1.0e-5
98 
99 void sinfo_svd_fitting ( float *x,
100  float *y,
101  float *sig,
102  int ndata,
103  float *a,
104  int ma,
105  float **u,
106  float **v,
107  float *w,
108  float **cvm,
109  float *chisq,
110  void (*funcs)(float,float *,int) )
111 {
112  int j,i;
113  float /*sini,*/wmax,tmp,thresh,sum,*b,*afunc;
114 
115 
116  b=sinfo_vector(1,ndata);
117  afunc=sinfo_vector(1,ma);
118  for (i=1;i<=ndata;i++) {
119 
120  (*funcs)(x[i],afunc,ma);
121  tmp=1.0/sig[i];
122  for (j=1;j<=ma;j++) {
123  u[i][j]=afunc[j]*tmp;
124  }
125  b[i]=y[i]*tmp;
126  }
127  sinfo_svd_compare(u,ndata,ma,w,v);
128 
129  wmax=0.0;
130  for (j=1;j<=ma;j++)
131  if (w[j] > wmax) wmax=w[j];
132  thresh=TOL*wmax;
133  for (j=1;j<=ma;j++) {
134  if (w[j] < thresh) {
135  w[j]=0.0;
136  sinfo_msg_warning("SVD_FITTING detected singular value in fit !");
137  }
138  }
139  sinfo_svb_kas(u,w,v,ndata,ma,b,a);
140  *chisq=0.0;
141  for (i=1;i<=ndata;i++) {
142  (*funcs)(x[i],afunc,ma);
143  for (sum=0.0,j=1;j<=ma;j++) sum += a[j]*afunc[j];
144  *chisq += (tmp=(y[i]-sum)/sig[i],tmp*tmp);
145  }
146  sinfo_free_vector(afunc,1/*,ma*/);
147  sinfo_free_vector(b,1/*,ndata*/);
148  sinfo_svd_variance(v,ma,w,cvm);
149 
150 }
151 
152 #undef TOL
153 
154 
155 
156 static float at,bt,ct;
157 #define SINFO_PYTHAG(a,b) ((at=fabs(a)) > (bt=fabs(b)) ? \
158  (ct=bt/at,at*sqrt(1.0+ct*ct)) : (bt ? (ct=at/bt,bt*sqrt(1.0+ct*ct)): 0.0))
159 
160 
161 static float maxarg1,maxarg2;
162 #define SINFO_MAX(a,b) (maxarg1=(a),maxarg2=(b),(maxarg1) > (maxarg2) ?\
163  (maxarg1) : (maxarg2))
164 #define SINFO_SIGN(a,b) ((b) >= 0.0 ? fabs(a) : -fabs(a))
165 
166 void sinfo_svd_compare(float **a,int m,int n,float w[],float **v)
167 {
168  int flag,i,its,j,jj,k,l=0,nm=0;
169  float c,f,h,s,x,y,z;
170  float anorm=0.0,g=0.0,scale=0.0;
171  float *rv1;
172 
173  if (m < n) {
174  sinfo_msg_error("SVDCMP: You must augment A with extra zero rows");
175  }
176  rv1=sinfo_vector(1,n);
177  for (i=1;i<=n;i++) {
178  l=i+1;
179  rv1[i]=scale*g;
180  g=s=scale=0.0;
181  if (i <= m) {
182  for (k=i;k<=m;k++) scale += fabs(a[k][i]);
183  if (scale) {
184  for (k=i;k<=m;k++) {
185  a[k][i] /= scale;
186  s += a[k][i]*a[k][i];
187  }
188  f=a[i][i];
189 
190  g = -SINFO_SIGN(sqrt(s),f);
191  h=f*g-s;
192  a[i][i]=f-g;
193  if (i != n) {
194  for (j=l;j<=n;j++) {
195  for (s=0.0,k=i;k<=m;k++) {
196  s += a[k][i]*a[k][j];
197  }
198  f=s/h;
199  for (k=i;k<=m;k++) {
200  a[k][j] += f*a[k][i];
201  }
202  }
203  }
204  for (k=i;k<=m;k++) a[k][i] *= scale;
205  }
206  }
207  w[i]=scale*g;
208  g=s=scale=0.0;
209  if (i <= m && i != n) {
210  for (k=l;k<=n;k++) scale += fabs(a[i][k]);
211  if (scale) {
212  for (k=l;k<=n;k++) {
213  a[i][k] /= scale;
214  s += a[i][k]*a[i][k];
215  }
216  f=a[i][l];
217 
218  g = -SINFO_SIGN(sqrt(s),f);
219  h=f*g-s;
220  a[i][l]=f-g;
221  for (k=l;k<=n;k++) rv1[k]=a[i][k]/h;
222  if (i != m) {
223  for (j=l;j<=m;j++) {
224  for (s=0.0,k=l;k<=n;k++) s += a[j][k]*a[i][k];
225  for (k=l;k<=n;k++) a[j][k] += s*rv1[k];
226  }
227  }
228  for (k=l;k<=n;k++) a[i][k] *= scale;
229  }
230  }
231  anorm=SINFO_MAX(anorm,(fabs(w[i])+fabs(rv1[i])));
232  }
233 
234  for (i=n;i>=1;i--) {
235  if (i < n) {
236  if (g) {
237  for (j=l;j<=n;j++)
238  v[j][i]=(a[i][j]/a[i][l])/g;
239  for (j=l;j<=n;j++) {
240  for (s=0.0,k=l;k<=n;k++) s += a[i][k]*v[k][j];
241  for (k=l;k<=n;k++) v[k][j] += s*v[k][i];
242  }
243  }
244  for (j=l;j<=n;j++) v[i][j]=v[j][i]=0.0;
245  }
246  v[i][i]=1.0;
247  g=rv1[i];
248  l=i;
249  }
250  for (i=n;i>=1;i--) {
251  l=i+1;
252  g=w[i];
253  if (i < n)
254  for (j=l;j<=n;j++) a[i][j]=0.0;
255  if (g) {
256  g=1.0/g;
257  if (i != n) {
258  for (j=l;j<=n;j++) {
259  for (s=0.0,k=l;k<=m;k++) s += a[k][i]*a[k][j];
260  f=(s/a[i][i])*g;
261  for (k=i;k<=m;k++) a[k][j] += f*a[k][i];
262  }
263  }
264  for (j=i;j<=m;j++) a[j][i] *= g;
265  } else {
266  for (j=i;j<=m;j++) a[j][i]=0.0;
267  }
268  ++a[i][i];
269  }
270  for (k=n;k>=1;k--) {
271  for (its=1;its<=30;its++) {
272  flag=1;
273  for (l=k;l>=1;l--) {
274  nm=l-1;
275  if (fabs(rv1[l])+anorm == anorm) {
276  flag=0;
277  break;
278  }
279  if (fabs(w[nm])+anorm == anorm) break;
280  }
281  if (flag) {
282  c=0.0;
283  s=1.0;
284  for (i=l;i<=k;i++) {
285  f=s*rv1[i];
286  if (fabs(f)+anorm != anorm) {
287  g=w[i];
288 
289  h=SINFO_PYTHAG(f,g);
290  w[i]=h;
291  h=1.0/h;
292  c=g*h;
293  s=(-f*h);
294  for (j=1;j<=m;j++) {
295  y=a[j][nm];
296  z=a[j][i];
297  a[j][nm]=y*c+z*s;
298  a[j][i]=z*c-y*s;
299  }
300  }
301  }
302  }
303  z=w[k];
304  if (l == k) {
305  if (z < 0.0) {
306  w[k] = -z;
307  for (j=1;j<=n;j++) v[j][k]=(-v[j][k]);
308  }
309  break;
310  }
311  if (its == 30) {
312  sinfo_msg_error("No convergence in 30 "
313  "SVDCMP iterations");
314  }
315  x=w[l];
316  nm=k-1;
317  y=w[nm];
318  g=rv1[nm];
319  h=rv1[k];
320  f=((y-z)*(y+z)+(g-h)*(g+h))/(2.0*h*y);
321 
322  g=SINFO_PYTHAG(f,1.0);
323  f=((x-z)*(x+z)+h*((y/(f+SINFO_SIGN(g,f)))-h))/x;
324  c=s=1.0;
325  for (j=l;j<=nm;j++) {
326  i=j+1;
327  g=rv1[i];
328  y=w[i];
329  h=s*g;
330  g=c*g;
331 
332  z=SINFO_PYTHAG(f,h);
333  rv1[j]=z;
334  c=f/z;
335  s=h/z;
336  f=x*c+g*s;
337  g=g*c-x*s;
338  h=y*s;
339  y=y*c;
340  for (jj=1;jj<=n;jj++) {
341  x=v[jj][j];
342  z=v[jj][i];
343  v[jj][j]=x*c+z*s;
344  v[jj][i]=z*c-x*s;
345  }
346 
347  z=SINFO_PYTHAG(f,h);
348  w[j]=z;
349  if (z) {
350  z=1.0/z;
351  c=f*z;
352  s=h*z;
353  }
354  f=(c*g)+(s*y);
355  x=(c*y)-(s*g);
356  for (jj=1;jj<=m;jj++) {
357  y=a[jj][j];
358  z=a[jj][i];
359  a[jj][j]=y*c+z*s;
360  a[jj][i]=z*c-y*s;
361  }
362  }
363  rv1[l]=0.0;
364  rv1[k]=f;
365  w[k]=x;
366  }
367  }
368  sinfo_free_vector(rv1,1/*,n*/);
369 }
370 
371 #undef SINFO_SIGN
372 #undef SINFO_MAX
373 #undef SINFO_PYTHAG
374 
375 #define NR_END 1
376 #define FREE_ARG char*
377 
378 void sinfo_nerror(const char error_text[])
379 {
380  fprintf(stderr,"Runtime ERROR ...\n");
381  fprintf(stderr,"%s\n",error_text);
382  fprintf(stderr,"exiting system \n");
383  return;
384 }
385 
386 float *sinfo_vector(long nl, long nh)
387 {
388  float *v;
389 
390  v=(float *)cpl_malloc((size_t) ((nh-nl+1+NR_END)*sizeof(float)));
391  if (!v) {
392  sinfo_msg_error("allocation failure in sinfo_vector()");
393  }
394  return v-nl+NR_END;
395 
396 }
397 
398 void sinfo_free_vector(float *v, long nl/* , long nh*/)
399 
400 {
401  cpl_free((FREE_ARG) (v+nl-NR_END));
402 }
403 
404 float **sinfo_matrix(long nrl, long nrh, long ncl, long nch)
405 {
406  long i, nrow=nrh-nrl+1,ncol=nch-ncl+1;
407  float **m;
408 
409  m=(float **) cpl_malloc((size_t)((nrow+NR_END)*sizeof(float*)));
410  if (!m) {
411  sinfo_msg_error("aloccation failure 1 in sinfo_matrix()");
412  }
413  m += NR_END;
414  m -= nrl;
415 
416  m[nrl]=(float *)cpl_malloc((size_t)((nrow*ncol+NR_END)*sizeof(float)));
417  if (!m[nrl]) {
418  sinfo_msg_error("allocation failure 2 in sinfo_matrix()");
419  }
420  m[nrl] += NR_END;
421  m[nrl] -= ncl;
422 
423  for(i=nrl+1;i<=nrh;i++) m[i] = m[i-1]+ncol;
424  return m;
425 }
426 
427 void sinfo_free_matrix(float **m,long nrl/*, long nrh*/, long ncl/*, long nch*/)
428 {
429  cpl_free((FREE_ARG)(m[nrl]+ncl-NR_END));
430  cpl_free((FREE_ARG)(m+nrl-NR_END));
431 }
432