void NR::svdfit(Vec_I_DP &x, Vec_I_DP &y, Vec_I_DP &sig, Vec_O_DP &a,
Mat_O_DP &u, Mat_O_DP &v, Vec_O_DP &w, DP &chisq,
void funcs(const DP, Vec_O_DP &))
{
int i,j;
const DP TOL=1.0e-13;
DP wmax,tmp,thresh,sum;
int ndata=x.size();
int ma=a.size();
Vec_DP b(ndata),afunc(ma);
for (i=0;i<ndata;i++) {
funcs(x[i],afunc);
tmp=1.0/sig[i];
for (j=0;j<ma;j++) u[i][j]=afunc[j]*tmp;
b[i]=y[i]*tmp;
}
svdcmp(u,w,v);
wmax=0.0;
for (j=0;j<ma;j++)
if (w[j] > wmax) wmax=w[j];
thresh=TOL*wmax;
for (j=0;j<ma;j++)
if (w[j] < thresh) w[j]=0.0;
svbksb(u,w,v,b,a);
chisq=0.0;
for (i=0;i<ndata;i++) {
funcs(x[i],afunc);
sum=0.0;
for (j=0;j<ma;j++) sum += a[j]*afunc[j];
chisq += (tmp=(y[i]-sum)/sig[i],tmp*tmp);
}
}
/* Interface to numerical recipes: svbksb ---------------------------------- */
void svbksb(Matrix2D<double> &u, Matrix1D<double> &w, Matrix2D<double> &v,
Matrix1D<double> &b, Matrix1D<double> &x)
{
// Call to the numerical recipes routine. Results will be stored in X
svbksb(u.adaptForNumericalRecipes2(),
w.adaptForNumericalRecipes(),
v.adaptForNumericalRecipes2(),
u.mdimy, u.mdimx,
b.adaptForNumericalRecipes(),
x.adaptForNumericalRecipes());
}
void svdfit(int ndata,dfprec *a,int ma,dfprec *u,dfprec *v,dfprec *w, dfprec *b){
int j;
dfprec wmax,thresh;
svdcmp(u,ndata,ma,w,v);
wmax=0.0;
for (j=0;j<ma;j++)
if (w[j] > wmax) wmax=w[j];
thresh=TOL*wmax;
for (j=0;j<ma;j++)
if (w[j] < thresh) w[j]=0.0;
svbksb(u,w,v,ndata,ma,b,a);
}
/******************************************************************************
General linear least squares fit routine
from section 15.4 of Numerical Recipes.
yfit(x) = function which fills f[i],i=0..o-1 with the o
fitting functions evaluated at x.
fom = if nonzero figure-of-merit is returned here.
a = fitting parameters
av = if (av) error variances for the fitting parameters returned here.
x = n abscissas
y = n ordinates
ys = if (ys) = n error standard deviations for y values
tol = smallest fraction of maximum singular value (eigenvalues, roughly)
which a small singular value can equal -- smaller values are
set to zero, assumed to indicate redundancy. NR suggests
of order 10^-6
n = number of abscissas.
o = number of fitting parameters.
*/
static fit_rc fit_lsq(void (*yfit)(), double *fom, double *a, double *av,
const double *x, const double *y, const double *ys,
double tol, int n, int o) {
double wmax,wmin,xsq,sum ;
int i,j ;
const char *me = "fit_lsq" ;
if (check_memory(o,n) != OK) return(memfail(__LINE__,me)) ;
for(i=0;i<n;i++) {
yfit(x[i]) ;
for(j=0;j<o;j++) u[i][j] = f[j] * (ys ? 1.0/ys[i] : 1.0) ;
} ;
memcpy(b,y,n*sizeof(double)) ;
if (ys) for(i=0;i<n;i++) b[i] /= ys[i] ;
if (svdcmp(u,n,o) != OK)
return(punt(__LINE__,me,"singular value decomposition failed.")) ;
wmax = 0.0 ;
for(wmax=0.0,j=0;j<o;j++) if (w[j] > wmax) wmax = w[j] ;
wmin = tol * wmax ;
for(j=0;j<o;j++) if (w[j] < wmin) w[j] = 0.0 ;
if (svbksb(a,n,o) != OK)
return(punt(__LINE__,me,"back substitution failed.")) ;
if (av) {
if (svdvar(o) != OK)
return(punt(__LINE__,me,"variance calculation failed.")) ;
for(i=0;i<o;i++) av[i] = cvm[i][i] ;
} ;
if (fom) {
xsq = 0.0 ;
for(i=0;i<o;i++) {
yfit(x[i]) ;
sum = 0.0 ;
for(j=0;j<o;j++) sum += a[j] * f[j] ;
sum = (y[i] - sum)/(ys ? ys[i]*ys[i] : 1.0) ;
xsq += sum*sum ;
} ;
*fom = xsq ;
} ;
return(OK) ;
}
/* This is the SVD algorithm from numerical recipes in c second edition*/
result_t LeastSquaresSolve(float x[], float y[], float sig[], int ndata, float a[], int ma, float **u, float **v, float w[], float *chisq)
{
int j,i;
float wmax,tmp,thresh,sum;
float b[MAX_MEMBERS_AnchorHood+1], afunc[MAX_MEMBERS_AnchorHood+1];
if(ndata > MAX_MEMBERS_AnchorHood+1)
;
// dbg(DBG_ERR, "too large matrix needed\n"); //not really gives any error info when make mica(2). some err handling necessary here
for (i=1;i<=ndata;i++) {
LeastSquaresEvaluateBasisFunctions(x[i],afunc,ma);
tmp=1.0/sig[i];
for (j=1;j<=ma;j++) u[i][j]=afunc[j]*tmp;
b[i]=y[i]*tmp;
}
{
uint8_t i;
printf("z ");
for(i=1;i<=ndata;i++) {
uint8_t j;
for(j=1;j<=ma;j++) {
printf("%f ",u[i][j]);
}
}
printf("\n");
}
if(svdcmp(u,ndata,ma,w,v)==FAIL) return FAIL;
wmax=0.0;
for (j=1;j<=ma;j++)
if (w[j] > wmax) wmax=w[j];
thresh=TOL*wmax;
for (j=1;j<=ma;j++)
if (w[j] < thresh) w[j]=0.0;
svbksb(u,w,v,ndata,ma,b,a); //@@
*chisq=0.0;
for (i=1;i<=ndata;i++) {
LeastSquaresEvaluateBasisFunctions(x[i],afunc,ma);
for (sum=0.0,j=1;j<=ma;j++) sum += a[j]*afunc[j];
*chisq += (tmp=(y[i]-sum)/sig[i],tmp*tmp);
}
return SUCCESS;
}
int svdsolve(eusfloat_t **a, int m, int n, eusfloat_t *b, eusfloat_t *x)
{
int j;
eusfloat_t **v, *w, wmax, wmin;
v = nr_matrix(1,n,1,n);
w = nr_vector(1,n);
if ( svdcmp(a,m,n,w,v) < 0 ) {
free_nr_vector(w,1,n);
free_nr_matrix(v,1,n,1,n);
return -1;
}
wmax = 0.0;
for (j=1; j<=n; j++) if (w[j] > wmax) wmax = w[j];
wmin = wmax*1.0e-6;
for (j=1; j<=n; j++) if (w[j] < wmin) w[j] = 0.0;
svbksb(a,w,v,m,n,b,x);
free_nr_vector(w,1,n);
free_nr_matrix(v,1,n,1,n);
return 1;
}
boolean DL_largematrix::solve(DL_largevector *x, DL_largevector *b){
// returns if the solve_method has changed
switch (rep) {
case full:
case riss:
if (conjug_gradient(x,b)) {
// solution was diverging: so we have a singular matrix and
// we have to use SVD
reptofull();
set_solve_method(svd);
prep_for_solve();
solve(x,b);
return TRUE;
}
return FALSE;
case lud: lubksb(x,b); return FALSE;
case ludb: lubksbbw(x,b); return FALSE;
case svdcmpd: svbksb(x,b); return FALSE;
}
return FALSE;
}
/* static */
void _least_squares_solution(double **a, int M, int N, double *b, double *x)
{
/*
Solve the matrix equation
Ep z = f
Here we use SVD from Numerical Recipes since
we cannot ensure that M==N.
In other languages, such as IgorPro,
could use QR or LU decomposition instead
if the chosen routine allows the M!=N case.
*/
double *w, **v, wMax, wMin;
int j;
w = vector(1,N);
v = matrix(1,N, 1,N);
/*
Singular Value decomposition a[][] = u[][] w[] v[][]
a[][] is changed into u[][] by SVD
*/
svdcmp(a, M, N, w, v);
/* find and zero the insignificant singular values */
wMax = w[1];
for (j=1; j<=N; j++) if (w[j]>wMax) wMax = w[j];
wMin = wMax * SV_CUTOFF;
/* DEBUG_MARKER; SHOW_VECTOR("SVD w", w, 1, N, "%lg"); */
/* printf ("singular value cutoff = %lg\n", wMin); */
for (j=1; j<=N; j++) if (w[j]<wMin) w[j] = 0.0;
/*
Singular Value backsubstitution solution of a z = b
*/
svbksb(a, w, v, M, N, b, x);
/* DEBUG_MARKER; SHOW_VECTOR("SVD bksb x", x, 1, N, "%lg"); */
free_matrix(v, 1,N, 1,N);
free_vector(w, 1,N);
}
void svdfit(double **x, double *y, double *sig, int ndata, double *a, int ma,
double **u, double **v, double *w, double *chisq,
void (*funcs)(double *,double *,int))
{
int j,i;
double wmax,tmp,thresh,sum,*b,*afunc,*dvector();
void svdcmp(),svbksb(),free_dvector();
b=dvector(1,ndata);
afunc=dvector(1,ma);
for (i=1;i<=ndata;i++)
{ /* accumulate coefficients of the fitting matrix */
(*funcs)(x[i],afunc,ma);
tmp=1.0/sig[i];
for (j=1;j<=ma;j++) u[i][j]=afunc[j]*tmp;
b[i]=y[i]*tmp;
}
svdcmp(u,ndata,ma,w,v);
wmax=0.0;
for (j=1;j<=ma;j++)
if (w[j] > wmax) wmax=w[j];
thresh=TOL*wmax;
for (j=1;j<=ma;j++)
if (w[j] < thresh) w[j]=0.0;
svbksb(u,w,v,ndata,ma,b,a);
*chisq=0.0;
for (i=1;i<=ndata;i++)
{
(*funcs)(x[i],afunc,ma);
for (sum=0.0,j=1;j<=ma;j++) sum += a[j]*afunc[j];
*chisq += (tmp=(y[i]-sum)/sig[i],tmp*tmp);
}
free_dvector(afunc,1,ma);
free_dvector(b,1,ndata);
}
int svdfit(double *x, double *y, double *sig, int ndata, double *a, int ma,
double ***u, double ***v, double **w, double *chisq,
int (*funcs)(double, double *, int)) {
int i=0,j=0;
double wmax=0.0,tmp=0.0,thresh=0.0,sum=0.0;
double *b=NULL,*afunc=NULL;
/* Allocate memory for relevant arrays/matrices */
if ((b=darray(ndata))==NULL) {
nferrormsg("svdfit(): Cannot allocate memory to b\n\tarray of size %d",
ndata); return 0;
}
if ((afunc=darray(ma))==NULL) {
nferrormsg("svdfit(): Cannot allocate memory to afunc\n\tarray of size %d",
ma); return 0;
}
if ((*w=darray(ma))==NULL) {
nferrormsg("svdfit(): Cannot allocate memory to w\n\tarray of size %d",
ma); return 0;
}
if ((*u=dmatrix(ndata,ma))==NULL) {
nferrormsg("svdfit(): Cannot allocate memory to matrix\n\t of size %dx%d",
ndata,ma); return 0;
}
if ((*v=dmatrix(ma,ma))==NULL) {
nferrormsg("svdfit(): Cannot allocate memory to matrix\n\t of size %dx%d",
ma,ma); return 0;
}
/* Begin SVD fitting */
for (i=0; i<ndata; i++) {
if (!(*funcs)(x[i],afunc,ma)) {
nferrormsg("svdfit(): Error returned from fitting function");
return 0;
}
tmp=1.0/sig[i];
for (j=0; j<ma; j++) (*u)[i][j]=afunc[j]*tmp;
b[i]=y[i]*tmp;
}
if (!svdcmp(*u,ndata,ma,*w,*v)) {
nferrormsg("svdfit(): Error returned from svdcmp()"); return 0;
}
wmax=0.0; for (j=0; j<ma; j++) wmax=MAX(wmax,(*w)[j]); thresh=SVDFIT_TOL*wmax;
for (j=0; j<ma; j++) {
if ((*w)[j]<thresh) {
(*w)[j]=0.0;
warnmsg("svdfit(): Setting coefficient %d's singular value to zero",j);
}
}
if (!svbksb(*u,*w,*v,ndata,ma,b,a)) {
nferrormsg("svdfit(): Error returned from svbksb()"); return 0;
}
*chisq=0.0;
for (i=0; i<ndata; i++) {
if (!(*funcs)(x[i],afunc,ma)) {
nferrormsg("svdfit(): Error returned from fitting function");
return 0;
}
for (sum=0.0,j=0; j<ma; j++) sum+=a[j]*afunc[j];
*chisq+=(tmp=(y[i]-sum)/sig[i],tmp*tmp);
}
/* Clean up */
free(b);
free(afunc);
return 1;
}
void LinearModel::fitLM()
{
if (par::verbose)
{
for (int i=0; i<nind; i++)
{
cout << "VO " << i << "\t"
<< Y[i] << "\t";
for (int j=0; j<np; j++)
cout << X[i][j] << "\t";
cout << "\n";
}
}
// cout << "LM VIEW\n";
// display(Y);
// display(X);
// cout << "---\n";
coef.resize(np);
sizeMatrix(S,np,np);
if ( np==0 || nind==0 || ! all_valid )
{
return;
}
setVariance();
if ( par::standard_beta )
standardise();
sig.resize(nind, sqrt(1.0/sqrt((double)nind)) );
w.resize(np);
sizeMatrix(u,nind,np);
sizeMatrix(v,np,np);
// Perform "svdfit(C,Y,sig,b,u,v,w,chisq,function)"
int i,j;
const double TOL=1.0e-13;
double wmax,tmp,thresh,sum;
vector_t b(nind),afunc(np);
for (i=0;i<nind;i++) {
afunc = X[i];
tmp=1.0/sig[i];
for (j=0;j<np;j++)
u[i][j]=afunc[j]*tmp;
b[i]=Y[i]*tmp;
}
bool flag = svdcmp(u,w,v);
if ( ! flag )
{
all_valid = false;
return;
}
wmax=0.0;
for (j=0;j<np;j++)
if (w[j] > wmax) wmax=w[j];
thresh=TOL*wmax;
for (j=0;j<np;j++)
if (w[j] < thresh) w[j]=0.0;
svbksb(u,w,v,b,coef);
chisq=0.0;
for (i=0;i<nind;i++) {
afunc=X[i];
sum=0.0;
for (j=0;j<np;j++) sum += coef[j]*afunc[j];
chisq += (tmp=(Y[i]-sum)/sig[i],tmp*tmp);
}
/////////////////////////////////////////
// Obtain covariance matrix of estimates
// Robust cluster variance estimator
// V_cluster = (X'X)^-1 * \sum_{j=1}^{n_C} u_{j}' * u_j * (X'X)^-1
// where u_j = \sum_j cluster e_i * x_i
// Above, e_i is the residual for the ith observation and x_i is a
// row vector of predictors including the constant.
// For simplicity, I omitted the multipliers (which are close to 1)
// from the formulas for Vrob and Vclusters.
// The formula for the clustered estimator is simply that of the
// robust (unclustered) estimator with the individual ei*s replaced
// by their sums over each cluster.
// http://www.stata.com/support/faqs/stat/cluster.html
// SEE http://aje.oxfordjournals.org/cgi/content/full/kwm223v1#APP1
// Williams, R. L. 2000. A note on robust variance estimation for
// cluster-correlated data. Biometrics 56: 64
// t ( y - yhat X ) %*% ( y - yhat) / nind - np
// = variance of residuals
// j <- ( t( y- m %*% t(b) ) %*% ( y - m %*% t(b) ) ) / ( N - p )
// print( sqrt(kronecker( solve( t(m) %*% m ) , j ) ))
////////////////////////////////////////////////
// OLS variance estimator = s^2 * ( X'X )^-1
// where s^2 = (1/(N-k)) \sum_i=1^N e_i^2
// 1. Calcuate S = (X'X)^-1
matrix_t Xt;
sizeMatrix(Xt, np, nind);
for (int i=0; i<nind; i++)
for (int j=0; j<np; j++)
Xt[j][i] = X[i][j];
matrix_t S0;
multMatrix(Xt,X,S0);
flag = true;
S0 = svd_inverse(S0,flag);
if ( ! flag )
{
all_valid = false;
return;
}
if (par::verbose)
{
cout << "beta...\n";
display(coef);
cout << "Sigma(S0b)\n";
display(S0);
cout << "\n";
}
////////////////////////
// Calculate s^2 (sigma)
if (!cluster)
{
double sigma= 0.0;
for (int i=0; i<nind; i++)
{
double partial = 0.0;
for (int j=0; j<np; j++)
partial += coef[j] * X[i][j];
partial -= Y[i];
sigma += partial * partial;
}
sigma /= nind-np;
for (int i=0; i<np; i++)
for (int j=0; j<np; j++)
S[i][j] = S0[i][j] * sigma;
}
///////////////////////////
// Robust-cluster variance
if (cluster)
{
vector<vector_t> sc(nc);
for (int i=0; i<nc; i++)
sc[i].resize(np,0);
for (int i=0; i<nind; i++)
{
double partial = 0.0;
for (int j=0; j<np; j++)
partial += coef[j] * X[i][j];
partial -= Y[i];
for (int j=0; j<np; j++)
sc[clst[i]][j] += partial * X[i][j];
}
matrix_t meat;
sizeMatrix(meat, np, np);
for (int k=0; k<nc; k++)
{
for (int i=0; i<np; i++)
for (int j=0; j<np; j++)
meat[i][j] += sc[k][i] * sc[k][j];
}
matrix_t tmp1;
multMatrix( S0 , meat, tmp1);
multMatrix( tmp1 , S0, S);
}
if (par::verbose)
{
cout << "coefficients:\n";
display(coef);
cout << "var-cov matrix:\n";
display(S);
cout << "\n";
}
}
