Пример #1
0
/* 
QL algorithm with implicit shifts, to determine the eigenvalues and
eigenvectors of a real, symmetric, tridiagonal matrix, or of a real,
symmetric matrix previously reduced by tred2 x 11.2. On input,
d[1..n] contains the diagonal elements of the tridiagonal matrix.

On output, it returns the eigenvalues. The vector e[1..n] inputs the
subdiagonal elements of the tridiagonal matrix, with e[1] arbitrary.
On output e is destroyed. When finding only the eigenvalues, several
lines may be omitted, as noted in the comments. If the eigenvectors
of a tridiagonal matrix are desired, the matrix z[1..n][1..n] is
input as the identity matrix. If the eigenvectors of a matrix that
has been reduced by tred2 are required, then z is input as the matrix
output by tred2.

In either case, the kth column of z returns the normalized
eigenvector corresponding to d[k]. 
*/
void tqli(gdouble d[], gdouble e[], gint n, gdouble **z)
{
  gint m,l,iter,i,k;
  gdouble s,r,p,g,f,dd,c,b;

  /*  Convenient to renumber the elements of e.  */
  for (i=1;i<n;i++) e[i-1]=e[i]; 
  e[n-1]=0.0;

  for (l=0;l<n;l++) {
    iter=0;
    do {
      /*  Look for a single small subdiagonal element to split
          the matrix.  */
      for (m=l;m<n-1;m++) { 
        dd=fabs(d[m])+fabs(d[m+1]);
        if ((gdouble)(fabs(e[m])+dd) == dd) break;
      }
      if (m != l) {
        if (iter++ == 30) nrerror("Too many iterations in tqli");
        g=(d[l+1]-d[l])/(2.0*e[l]);  /*   Form shift.  */
        r=pythag(g,1.0);
        g=d[m]-d[l]+e[l]/(g+SIGN(r,g));  /*  This is d_m - k_s  */
        s=c=1.0;
        p=0.0;
        /*  A plane rotation as in the original QL, followed by Givens
            rotations to restore tridiagonal form.  */
        for (i=m-1;i>=l;i--) { 
          f=s*e[i];
          b=c*e[i];      
          e[i+1]=(r=pythag(f,g));
          if (r == 0.0) {  /*  Recover from underflow.  */
            d[i+1] -= p;
            e[m]=0.0;
            break;
          }
          s=f/r;
          c=g/r;
          g=d[i+1]-p;
          r=(d[i]-g)*s+2.0*c*b;
          p=s*r;
          d[i+1]=g+p;
          g=c*r-b;
          /* Next loop can be omitted if eigenvectors not wanted*/
          for (k=0;k<n;k++) {  /*  Form eigenvectors.  */
            f=z[k][i+1];
            z[k][i+1]=s*z[k][i]+c*f;
            z[k][i]=c*z[k][i]-s*f;
          }
        }
        if (r == 0.0 && i >= l) continue;
        d[l] -= p;
        e[l]=g;
        e[m]=0.0;
      }
    } while (m != l);
  }
}
Пример #2
0
int main() {
	int long answer12 = pythag(12);
	int long answer = pythag(1000);
	int long answer30 = pythag(30);
	int long answer_mathy = pyth_mathy(1000);	
	printf("pythag trip (12) = %ld\n",answer12);
	printf("pythage trip (30) = %ld\n",answer30);
	printf("pythag trip (1000) = %ld or %ld\n",answer,answer_mathy);
}
// Compute the eigen values and vectors of a symmetric tridiagonal matrix
//
// QL algorithm with implicit shifts, to determine the eigenvalues and eigenvectors
// of a real, symmetric, tridiagonal matrix, or of a real, symmetric matrix
// previously reduced by householder sec. 11.2. On input, d[0..n-1] contains the diagonal
// elements of the tridiagonal matrix. On output, it returns the eigenvalues. The
// vector e[0..n-1] inputs the subdiagonal elements of the tridiagonal matrix, with
// e[0] arbitrary. On output e is destroyed. When finding only the eigenvalues,
// several lines may be omitted, as noted in the comments. If the eigenvectors of
// a tridiagonal matrix are desired, the matrix z[0..n-1][0..n-1] is input as the
// identity matrix. If the eigenvectors of a matrix that has been reduced by householder
// are required, then z is input as the matrix output by householder. In either case,
// the kth column of z returns the normalized eigenvector corresponding to d[k].
//
// input: d - diagonal of symmetric tridiagonal matrix
//        e - offdiagonal of symmetric tridiagonal matrix
//        z - identity if you want eigensystem of symmetric tridiagonal matrix
//          - OR the householder reduction of a symmetric matrix
// output: d - eigenvalues
//         z - the corresponding eigen vectors in the COLUMNS!!!
static void eigen(double *d, double *e, int n, double **z)
{
    double pythag(double a, double b);
    int m, l, iter, i, k;
    double s, r, p, g, f, dd, c, b;

      // Convenient to renumber the elements of e.
    for (i=1; i<n; i++) e[i-1]=e[i];
    e[n-1]=0.0;

    for (l=0; l<n; l++) {
        iter=0;
        do {
            // Look for a single small subdiagonal element to split the matrix.
            for (m=l; m<n-1; m++) {
                dd=fabs(d[m])+fabs(d[m+1]);
                if ((double)(fabs(e[m])+dd) == dd) break;
            }

            if (m != l) {
                if (iter++ == 30) printf("Too many iterations in tqli");
                g=(d[l+1]-d[l])/(2.0*e[l]);       // Form shift.
                r=pythag(g, 1.0);
                g=d[m]-d[l]+e[l]/(g+SIGN(r, g));       // This is dm - ks.
                s=c=1.0;
                p=0.0;
                for (i=m-1; i>=l; i--) {      // A plane rotation as in the original QL, followed by Givens
                    f=s*e[i];                // rotations to restore tridiagonal form.
                    b=c*e[i];
                    e[i+1]=(r=pythag(f, g));
                    if (r == 0.0) {      // Recover from underflow.
                        d[i+1] -= p;
                        e[m]=0.0;
                        break;
                    }
                    s=f/r;
                    c=g/r;
                    g=d[i+1]-p;
                    r=(d[i]-g)*s+2.0*c*b;
                    d[i+1]=g+(p=s*r);
                    g=c*r-b;
                    // Next loop can be omitted if eigenvectors not wanted
                    // Form eigenvectors.
                    for (k=0; k<n; k++) {
                        f=z[k][i+1];
                        z[k][i+1]=s*z[k][i]+c*f;
                        z[k][i]=c*z[k][i]-s*f;
                    }
                }
                if (r == 0.0 && i >= l) continue;
                d[l] -= p;
                e[l]=g;
                e[m]=0.0;
            }
        } while (m != l);
    }
}
Пример #4
0
void tqli(double d[], double e[], int n, double **z)
{
	double pythag(double a, double b);
	int m,l,iter,i,k,IT=0;
	double s,r,p,g,f,dd,c,b;

	for (i=2;i<=n;i++) e[i-1]=e[i];
	e[n]=0.0;
	for (l=1;l<=n;l++) {
		iter=0;
		do {
			for (m=l;m<=n-1;m++) {
				dd=fabs(d[m])+fabs(d[m+1]);
				if ((double)(fabs(e[m])+dd) == dd) break;
			}
			if (m != l) {
				if (iter++ == 30) nrerror("Too many iterations in tqli");
				g=(d[l+1]-d[l])/(2.0*e[l]);
				r=pythag(g,1.0);
				g=d[m]-d[l]+e[l]/(g+SIGN(r,g));
				s=c=1.0;
				p=0.0;
				for (i=m-1;i>=l;i--) {
					f=s*e[i];
					b=c*e[i];
					e[i+1]=(r=pythag(f,g));
					if (r == 0.0) {
						d[i+1] -= p;
						e[m]=0.0;
						break;
					}
					s=f/r;
					c=g/r;
					g=d[i+1]-p;
					r=(d[i]-g)*s+2.0*c*b;
					d[i+1]=g+(p=s*r);
					g=c*r-b;
					for (k=1;k<=n;k++) {
						f=z[k][i+1];
						z[k][i+1]=s*z[k][i]+c*f;
						z[k][i]=c*z[k][i]-s*f;
					}
				}
				if (r == 0.0 && i >= l) continue;
				d[l] -= p;
				e[l]=g;
				e[m]=0.0;
			}
		} while (m != l);
		IT+=iter;
	}
	printf("\nnumber of iterations %d\n",IT);
}
Пример #5
0
void tqli(double *d, double *e, int n, double **z)
{
register int   m,l,iter,i,k;
double         s,r,p,g,f,dd,c,b;

for(i = 1; i < n; i++) e[i-1] = e[i];
e[n] = 0.0;
for(l = 0; l < n; l++) {
   iter = 0;
   do {
      for(m = l; m < n-1; m++) {
         dd = fabs(d[m]) + fabs(d[m+1]);
         if((double)(fabs(e[m])+dd) == dd) break;
      }
      if(m != l) {
         if(iter++ == 30) {
            printf("\n\nToo many iterations in tqli.\n");
            exit(1);
         }
         g = (d[l+1] - d[l])/(2.0 * e[l]);
         r = pythag(g,1.0);
         g = d[m]-d[l]+e[l]/(g+SIGN(r,g));
         s = c = 1.0;
         p = 0.0;
         for(i = m-1; i >= l; i--) {
            f      = s * e[i];
            b      = c*e[i];
            e[i+1] = (r=pythag(f,g));
            if(r == 0.0) {
               d[i+1] -= p;
               e[m]    = 0.0;
               break;
            }
            s      = f/r;
            c      = g/r;
            g      = d[i+1] - p;
            r      = (d[i] - g) * s + 2.0 * c * b;
            d[i+1] = g + (p = s * r);
            g      = c * r - b;
            for(k = 0; k < n; k++) {
               f         = z[k][i+1];
               z[k][i+1] = s * z[k][i] + c * f;
               z[k][i]   = c * z[k][i] - s * f;
            } /* end k-loop */
         } /* end i-loop */
         if(r == 0.0 && i >= l) continue;
         d[l] -= p;
         e[l]  = g;
         e[m]  = 0.0;
      } /* end if-loop for m != 1 */
   } while(m != l);
} /* end l-loop */
} /* End: function tqli(), (C) Copr. 1986-92 Numerical Recipes Software )%. */
Пример #6
0
int tqli(eusfloat_t d[], eusfloat_t e[], int n, eusfloat_t **z)
{
  eusfloat_t pythag(eusfloat_t a, eusfloat_t b);
  int m,l,iter,i,k;
  eusfloat_t s,r,p,g,f,dd,c,b;

  for (i=2;i<=n;i++) e[i-1]=e[i]; // Convenient to renumber the elements of e. 
  e[n]=0.0;
  for (l=1;l<=n;l++) {
    iter=0;
    do {
      for (m=l;m<=n-1;m++) { // Look for a single small subdiagonal element to split the matrix.
	dd=fabs(d[m])+fabs(d[m+1]);
	if ((eusfloat_t)(fabs(e[m])+dd) == dd) break;
      }
      if (m != l) {
	if (iter++ == 30) {nrerror("Too many iterations in tqli"); return -1;}
	g=(d[l+1]-d[l])/(2.0*e[l]); // Form shift.
	r=pythag(g,1.0);
	g=d[m]-d[l]+e[l]/(g+SIGN(r,g)); // This is dm . ks.
	s=c=1.0;
	p=0.0;
	for (i=m-1;i>=l;i--) { // A plane rotation as in the original QL, followed by Givens rotations to restore tridiagonal form.
	  f=s*e[i];
	  b=c*e[i];
	  e[i+1]=(r=pythag(f,g));
	  if (r == 0.0) { // Recover from underflow.
	    d[i+1] -= p;
	    e[m]=0.0;
	    break;
	  }
	  s=f/r;
	  c=g/r;
	  g=d[i+1]-p;
	  r=(d[i]-g)*s+2.0*c*b;
	  d[i+1]=g+(p=s*r);
	  g=c*r-b;
	  /* Next loop can be omitted if eigenvectors not wanted*/
	  for (k=1;k<=n;k++) { // Form eigenvectors.
	    f=z[k][i+1];
	    z[k][i+1]=s*z[k][i]+c*f;
	    z[k][i]=c*z[k][i]-s*f;
	  }
	}
	if (r == 0.0 && i >= l) continue;
	d[l] -= p;
	e[l]=g;
	e[m]=0.0;
      }
    } while (m != l);
  }
  return 1;
}
Пример #7
0
void tqli(double *d, double *e, int n, double **z)
{
	int m,l,iter,i,k;
	double s,r,p,g,f,dd,c,b;

	for (i=1;i<n;i++) e[i-1]=e[i];
	e[n-1]=0.0;
	for (l=0;l<n;l++) {
		iter=0;
		do {
			for (m=l;m<n-1;m++) {
				dd=fabs(d[m])+fabs(d[m+1]);
				if ((double)(fabs(e[m])+dd) == dd) break;
			}
			if (m != l) {
				if (iter++ == 30) {
					printf("ERROR: Too many iterations in tqli\n");
					Finalize(1);
				}
				g=(d[l+1]-d[l])/(2.0*e[l]);
				r=pythag(g,1.0);
				g=d[m]-d[l]+e[l]/(g+SIGN(r,g));
				s=c=1.0;
				p=0.0;
				for (i=m-1;i>=l;i--) {
					f=s*e[i];
					b=c*e[i];
					e[i+1]=(r=pythag(f,g));
					if (r == 0.0) {
						d[i+1] -= p;
						e[m]=0.0;
						break;
					}
					s=f/r;
					c=g/r;
					g=d[i+1]-p;
					r=(d[i]-g)*s+2.0*c*b;
					d[i+1]=g+(p=s*r);
					g=c*r-b;
					for (k=0;k<n;k++) {
						f=z[k][i+1];
						z[k][i+1]=s*z[k][i]+c*f;
						z[k][i]=c*z[k][i]-s*f;
					}
				}
				if (r == 0.0 && i >= l) continue;
				d[l] -= p;
				e[l]=g;
				e[m]=0.0;
			}
		} while (m != l);
	}
}
void C_toolbox_eigen_sym::tqli()
{
	int m,l,iter,i,k;
	double s,r,p,g,f,dd,c,b;
	const double EPS=DBL_EPSILON;
	for (i=1;i<n;i++) e[i-1]=e[i];
	e[n-1]=0.0;
	for (l=0;l<n;l++) {
		iter=0;
		do {
			for (m=l;m<n-1;m++) {
				dd=abs(d[m])+abs(d[m+1]);
				if (abs(e[m]) <= EPS*dd) break;
			}
			if (m != l) {
				if (iter++ == 90) throw("Too many iterations in tqli"); //used to be 30
				g=(d[l+1]-d[l])/(2.0*e[l]);
				r=pythag(g,1.0);
				g=d[m]-d[l]+e[l]/(g+SIGN(r,g));
				s=c=1.0;
				p=0.0;
				for (i=m-1;i>=l;i--) {
					f=s*e[i];
					b=c*e[i];
					e[i+1]=(r=pythag(f,g));
					if (r == 0.0) {
						d[i+1] -= p;
						e[m]=0.0;
						break;
					}
					s=f/r;
					c=g/r;
					g=d[i+1]-p;
					r=(d[i]-g)*s+2.0*c*b;
					d[i+1]=g+(p=s*r);
					g=c*r-b;
					if (yesvecs) {
						for (k=0;k<n;k++) {
							f=z[k][i+1];
							z[k][i+1]=s*z[k][i]+c*f;
							z[k][i]=c*z[k][i]-s*f;
						}
					}
				}
				if (r == 0.0 && i >= l) continue;
				d[l] -= p;
				e[l]=g;
				e[m]=0.0;
			}
		} while (m != l);
	}
}
Пример #9
0
void tqli(float d[], float e[], int n, float **z)
{
	float pythag(float a, float b);
	int m,l,iter,i,k;
	float s,r,p,g,f,dd,c,b;

	for (;i<=n;i++) e[i-1]=e[i];
	e[n]=0.0;
	for (;l<=n;l++) {
		iter=0;
		do {
			for (;m<=n-1;m++) {
				dd=fabs(d[m])+fabs(d[m+1]);
				if ((float)(fabs(e[m])+dd) == dd) break;
			}
			if (m != l) {
				if (iter++ == 30) nrerror("Too many iterations in tqli");
				g=(d[l+1]-d[l])/(2.0*e[l]);
				r=pythag(g,1.0);
				g=d[m]-d[l]+e[l]/(g+SIGN(r,g));
				s=c=1.0;
				p=0.0;
				for (;i>=l;i--) {
					f=s*e[i];
					b=c*e[i];
					e[i+1]=(r=pythag(f,g));
					if (r == 0.0) {
						d[i+1] -= p;
						e[m]=0.0;
						break;
					}
					s=f/r;
					c=g/r;
					g=d[i+1]-p;
					r=(d[i]-g)*s+2.0*c*b;
					d[i+1]=g+(p=s*r);
					g=c*r-b;
					for (;k<=n;k++) {
						f=z[k][i+1];
						z[k][i+1]=s*z[k][i]+c*f;
						z[k][i]=c*z[k][i]-s*f;
					}
				}
				if (r == 0.0 && i >= l) continue;
				d[l] -= p;
				e[l]=g;
				e[m]=0.0;
			}
		} while (m != l);
	}
}
Пример #10
0
	std::vector<Cell*> Cell::getCellsTouching() {
		std::vector<Cell*> returncells;
		for (int i=0; i<container->size(); i++) {
			Cell* cellp = &(*container)[i];
			if (pythag(cellp->x-x,cellp->y-y,cellp->z-z) < cellp->size/2 + size/2) {
				returncells.push_back(cellp);
			}
		}
		return returncells;
	}
// produces the Cholesky decomposition of EAE where A = chol.t() * chol
// and E produces a LEFT circular shift of the rows and columns from
// 1,...,k-1,k,k+1,...l,l+1,...,p to
// 1,...,k-1,k+1,...l,k,l+1,...,p to
void left_circular_update_Cholesky(UpperTriangularMatrix &chol, int k, int l)
{
   int nRC = chol.Nrows();
   int i, j;

   // I. compute shift of column k to the lth position
   Matrix cholCopy = chol;
   // a. grab column k
   ColumnVector columnK = cholCopy.Column(k);
   // b. shift columns k+1,...l to the LEFT
   for(j = k+1; j <= l; ++j)
      cholCopy.Column(j-1) = cholCopy.Column(j);
   // c. copy the elements of columnK into the lth column of cholCopy
   cholCopy.Column(l) = 0.0;
   for(i = 1; i <= k; ++i)
      cholCopy(i,l) = columnK(i);

   // II. apply and compute Given's rotations
   int nGivens = l-k;
   ColumnVector cGivens(nGivens); cGivens = 0.0;
   ColumnVector sGivens(nGivens); sGivens = 0.0;
   for(j = k; j <= nRC; ++j)
   {
      ColumnVector columnJ = cholCopy.Column(j);

      // apply the previous Givens rotations to columnJ
      int imax = j - k; if (imax > nGivens) imax = nGivens;
      for(int i = 1; i <= imax; ++i)
      {
         int gIndex = i;
         int topRowIndex = k + i - 1;
         GivensRotationR(cGivens(gIndex), sGivens(gIndex),
            columnJ(topRowIndex), columnJ(topRowIndex+1));
      }

      // compute a new Given's rotation when j < l
      if(j < l)
      {
         int gIndex = j-k+1;
         columnJ(j) = pythag(columnJ(j), columnJ(j+1), cGivens(gIndex),
            sGivens(gIndex));
         columnJ(j+1) = 0.0;
      }

      cholCopy.Column(j) = columnJ;
   }

   chol << cholCopy;
	
}
// produces the Cholesky decomposition of EAE where A = chol.t() * chol
// and E produces a RIGHT circular shift of the rows and columns from
// 1,...,k-1,k,k+1,...l,l+1,...,p to
// 1,...,k-1,l,k,k+1,...l-1,l+1,...p
void right_circular_update_Cholesky(UpperTriangularMatrix &chol, int k, int l)
{
   int nRC = chol.Nrows();
   int i, j;
	
   // I. compute shift of column l to the kth position
   Matrix cholCopy = chol;
   // a. grab column l
   ColumnVector columnL = cholCopy.Column(l);
   // b. shift columns k,...l-1 to the RIGHT
   for(j = l-1; j >= k; --j)
      cholCopy.Column(j+1) = cholCopy.Column(j);
   // c. copy the top k-1 elements of columnL into the kth column of cholCopy
   cholCopy.Column(k) = 0.0;
   for(i = 1; i < k; ++i) cholCopy(i,k) = columnL(i);

    // II. determine the l-k Given's rotations
   int nGivens = l-k;
   ColumnVector cGivens(nGivens); cGivens = 0.0;
   ColumnVector sGivens(nGivens); sGivens = 0.0;
   for(i = l; i > k; i--)
   {
      int givensIndex = l-i+1;
      columnL(i-1) = pythag(columnL(i-1), columnL(i),
         cGivens(givensIndex), sGivens(givensIndex));
      columnL(i) = 0.0;
   }
   // the kth entry of columnL is the new diagonal element in column k of cholCopy
   cholCopy(k,k) = columnL(k);
	
   // III. apply these Given's rotations to subsequent columns
   // for columns k+1,...,l-1 we only need to apply the last nGivens-(j-k) rotations
   for(j = k+1; j <= nRC; ++j)
   {
      ColumnVector columnJ = cholCopy.Column(j);
      int imin = nGivens - (j-k) + 1; if (imin < 1) imin = 1;
      for(int gIndex = imin; gIndex <= nGivens; ++gIndex)
      {
         // apply gIndex Given's rotation
         int topRowIndex = k + nGivens - gIndex;
         GivensRotationR(cGivens(gIndex), sGivens(gIndex),
            columnJ(topRowIndex), columnJ(topRowIndex+1));
      }
      cholCopy.Column(j) = columnJ;
   }

   chol << cholCopy;
}
Пример #13
0
T HouseholderTransform(VectorTemplate<T>& v)
{
  Assert(v.n != 0);
  if (v.n == 1) return 0;
  T alpha, beta, tau ;   
  VectorTemplate<T> x; x.setRef(v,1); 
  T xnorm = x.norm();
  if (xnorm == 0)  {
    return 0;
  }
      
  alpha = v(0);
  beta = - (alpha >= 0.0 ? 1 : -1) * pythag(alpha, xnorm);
  tau = (beta - alpha) / beta ;
  
  x.inplaceDiv(alpha-beta);
  v(0)=beta;
  return tau;
}
Пример #14
0
void TransformCosSin_Sin(Real a,Real b,Real& c,Real& d)
{
  //use sin(x+d) = sin(x)cos(d) + cos(x)sin(d)
  //=> a=c*sin(d), b=c*cos(d)
  //=> c^2 = a^2+b^2
  if(a==0 && b==0) { c=d=0; }
  else {
    d = Atan2(a,b);
    c = pythag(a,b);
  }
  Real x=0.5;
  if(!FuzzyEquals(c*Sin(x+d),a*Cos(x)+b*Sin(x))) {
    printf("Error in TransformCosSin\n");
    printf("a: %f, b: %f\n",a,b);
    printf("c: %f, d: %f\n",c,d);
    printf("f(x): %f\n",a*Cos(x)+b*Sin(x));
    printf("g(x): %f\n",c*Sin(x+d));
  }
  Assert(FuzzyEquals(c*Sin(x+d),a*Cos(x)+b*Sin(x)));
}
Пример #15
0
int updatePid(Pid* pid, float x, float y, int dt = 20) {
	pid->valLast[0] = pid->val[0];
	pid->valLast[1] = pid->val[1];
	pid->val[0] = x;
	pid->val[1] = y;
	pid->err = pythag(
		(pid->targ[0] - pid->val[0]),
		(pid->targ[1] - pid->val[1])
	);
	pid->prop = pid->err * pid->kP;
	pid->integ += pid->err * pid->kI;
	pid->integ =
		(fabs(pid->integ) > pid->integLim)
		? pid->integ
		: pid->integLim * sgn(pid->integ);
	pid->deriv = (pid->val - pid->valLast) * pid->kD * 20 / dt;

	pid->out = (int) round(pid->prop + pid->integ + pid->deriv);
	return pid->out;
}
// produces the Cholesky decomposition of A - x.t() * x where A = chol.t() * chol
void downdate_Cholesky(UpperTriangularMatrix &chol, RowVector x)
{
   int nRC = chol.Nrows();
	
   // solve R^T a = x
   LowerTriangularMatrix L = chol.t();
   ColumnVector a(nRC); a = 0.0;
   int i, j;
	
   for (i = 1; i <= nRC; ++i)
   {
      // accumulate subtr sum
      Real subtrsum = 0.0;
      for(int k = 1; k < i; ++k) subtrsum += a(k) * L(i,k);

      a(i) = (x(i) - subtrsum) / L(i,i);
   }

   // test that l2 norm of a is < 1
   Real squareNormA = a.SumSquare();
   if (squareNormA >= 1.0)
      Throw(ProgramException("downdate_Cholesky() fails", chol));

   Real alpha = sqrt(1.0 - squareNormA);

   // compute and apply Givens rotations to the vector a
   ColumnVector cGivens(nRC);  cGivens = 0.0;
   ColumnVector sGivens(nRC);  sGivens = 0.0;
   for(i = nRC; i >= 1; i--)
      alpha = pythag(alpha, a(i), cGivens(i), sGivens(i));

   // apply Givens rotations to the jth column of chol
   ColumnVector xtilde(nRC); xtilde = 0.0;
   for(j = nRC; j >= 1; j--)
   {
      // only the first j rotations have an affect on chol,0
      for(int k = j; k >= 1; k--)
         GivensRotation(cGivens(k), -sGivens(k), chol(k,j), xtilde(j));
   }
}
Пример #17
0
void edgelength(double *nodeXlist,double *nodeYlist,int *n, double *edgelength, int *longlat)
{
	int N=*n, i;
	double el[1],gel[1];
	el[0]=(double)0;
	if (longlat[0]==0)
	{
		for(i=0; i<N-1; i++)
		{
		    el[0]=el[0]+pythag((nodeXlist[i+1]-nodeXlist[i]),(nodeYlist[i+1]-nodeYlist[i]));
			} 
		}
	else
	{
		for(i=0; i<N-1; i++)
		{
			gc_el(nodeXlist+i+1,nodeXlist+i,nodeYlist+i+1,nodeYlist+i+1, gel);
		    el[0]=el[0]+gel[0];
			} 
		}
		edgelength[0]=el[0];			
	}
// produces the Cholesky decomposition of A + x.t() * x where A = chol.t() * chol
void update_Cholesky(UpperTriangularMatrix &chol, RowVector x)
{
   int nc = chol.Nrows();
   ColumnVector cGivens(nc); cGivens = 0.0;
   ColumnVector sGivens(nc); sGivens = 0.0;
	
   for(int j = 1; j <= nc; ++j) // process the jth column of chol
   {
      // apply the previous Givens rotations k = 1,...,j-1 to column j
      for(int k = 1; k < j; ++k)
         GivensRotation(cGivens(k), sGivens(k), chol(k,j), x(j));

      // determine the jth Given's rotation
      pythag(chol(j,j), x(j), cGivens(j), sGivens(j));

      // apply the jth Given's rotation
      {
         Real tmp0 = cGivens(j) * chol(j,j) + sGivens(j) * x(j);
         chol(j,j) = tmp0; x(j) = 0.0;
      }

   }

}
Пример #19
0
LOCAL VOID tql1 P4C(int, n,
                    double *, d,
                    double *, e,
                    int *, ierr)
{
    /* System generated locals */
    double d__1, d__2;

    /* Local variables */
    double c, f, g, h;
    int i, j, l, m;
    double p, r, s, c2, c3 = 0.0;
    int l1, l2;
    double s2 = 0.0;
    int ii;
    double dl1, el1;
    int mml;
    double tst1, tst2;

    /* this subroutine is a translation of the algol procedure tql1, */
    /* num. math. 11, 293-306(1968) by bowdler, martin, reinsch, and */
    /* wilkinson. */
    /* handbook for auto. comp., vol.ii-linear algebra, 227-240(1971). */

    /* this subroutine finds the eigenvalues of a symmetric */
    /* tridiagonal matrix by the ql method. */

    /* on input */

    /*    n is the order of the matrix. */

    /*    d contains the diagonal elements of the input matrix. */

    /*    e contains the subdiagonal elements of the input matrix */
    /*      in its last n-1 positions.  e(1) is arbitrary. */

    /*  on output */

    /*    d contains the eigenvalues in ascending order.  if an */
    /*      error exit is made, the eigenvalues are correct and */
    /*      ordered for indices 1,2,...ierr-1, but may not be */
    /*      the smallest eigenvalues. */

    /*    e has been destroyed. */

    /*    ierr is set to */
    /*      zero       for normal return, */
    /*      j          if the j-th eigenvalue has not been */
    /*                 determined after 30 iterations. */

    /* calls pythag for  dsqrt(a*a + b*b) . */

    /* questions and comments should be directed to burton s. garbow, */
    /* mathematics and computer science div, argonne national laboratory */

    /* this version dated august 1983. */

    /* ------------------------------------------------------------------ */

    /* Parameter adjustments */
    --e;
    --d;

    /* Function Body */
    *ierr = 0;
    if (n == 1) {
        goto L1001;
    }

    for (i = 2; i <= n; ++i) {
        e[i - 1] = e[i];
    }

    f = 0.;
    tst1 = 0.;
    e[n] = 0.;

    for (l = 1; l <= n; ++l) {
        j = 0;
        h = (d__1 = d[l], abs(d__1)) + (d__2 = e[l], abs(d__2));
        if (tst1 < h) {
            tst1 = h;
        }
        /* .......... look for small sub-diagonal element .......... */
        for (m = l; m <= n; ++m) {
            tst2 = tst1 + (d__1 = e[m], abs(d__1));
            if (tst2 == tst1) {
                goto L120;
            }
            /* .......... e(n) is always zero, so there is no exit */
            /*            through the bottom of the loop .......... */
        }

L120:
        if (m == l) {
            goto L210;
        }
L130:
        if (j == 30) {
            goto L1000;
        }
        ++j;
        /* .......... form shift .......... */
        l1 = l + 1;
        l2 = l1 + 1;
        g = d[l];
        p = (d[l1] - g) / (e[l] * 2.);
        r = pythag(p, 1.0);
        d[l] = e[l] / (p + d_sign(&r, &p));
        d[l1] = e[l] * (p + d_sign(&r, &p));
        dl1 = d[l1];
        h = g - d[l];
        if (l2 > n) {
            goto L145;
        }

        for (i = l2; i <= n; ++i) {
            d[i] -= h;
        }

L145:
        f += h;
        /* .......... ql transformation .......... */
        p = d[m];
        c = 1.;
        c2 = c;
        el1 = e[l1];
        s = 0.;
        mml = m - l;
        /* .......... for i=m-1 step -1 until l do -- .......... */
        for (ii = 1; ii <= mml; ++ii) {
            c3 = c2;
            c2 = c;
            s2 = s;
            i = m - ii;
            g = c * e[i];
            h = c * p;
            r = pythag(p, e[i]);
            e[i + 1] = s * r;
            s = e[i] / r;
            c = p / r;
            p = c * d[i] - s * g;
            d[i + 1] = h + s * (c * g + s * d[i]);
        }

        p = -s * s2 * c3 * el1 * e[l] / dl1;
        e[l] = s * p;
        d[l] = c * p;
        tst2 = tst1 + (d__1 = e[l], abs(d__1));
        if (tst2 > tst1) {
            goto L130;
        }
L210:
        p = d[l] + f;
        /* .......... order eigenvalues .......... */
        if (l == 1) {
            goto L250;
        }
        /* .......... for i=l step -1 until 2 do -- .......... */
        for (ii = 2; ii <= l; ++ii) {
            i = l + 2 - ii;
            if (p >= d[i - 1]) {
                goto L270;
            }
            d[i] = d[i - 1];
        }

L250:
        i = 1;
L270:
        d[i] = p;
    }

    goto L1001;
    /* .......... set error -- no convergence to an */
    /*            eigenvalue after 30 iterations .......... */
L1000:
    *ierr = l;
L1001:
    return;
}
long int C_toolbox_SVD::dsvd(double **a, long int m, long int n, double *w, double **v)
{
    long int flag, i, its, j, jj, k, l, nm;
    double c, f, h, s, x, y, z;
    double anorm = 0.0, g = 0.0, scale = 0.0;
    double *rv1;

    if (m < n)
    {
        throw "#rows must be > #cols";
        return 0;
    }

    rv1 = new double[n];//(double *)malloc((unsigned int) n*sizeof(double));

/* Householder reduction to bidiagonal form */
    for (i = 0; i < n; i++)
    {
        /* left-hand reduction */
        l = i + 1;
        rv1[i] = scale * g;
        g = s = scale = 0.0;
        if (i < m)
        {
            for (k = i; k < m; k++)
                scale += ABS((double)a[k][i]);
            if (scale)
            {
                for (k = i; k < m; k++)
                {
                    a[k][i] = (double)((double)a[k][i]/scale);
                    s += ((double)a[k][i] * (double)a[k][i]);
                }
                f = (double)a[i][i];
                g = -SIGN(sqrt(s), f);
                h = f * g - s;
                a[i][i] = (double)(f - g);
                if (i != n - 1)
                {
                    for (j = l; j < n; j++)
                    {
                        for (s = 0.0, k = i; k < m; k++)
                            s += ((double)a[k][i] * (double)a[k][j]);
                        f = s / h;
                        for (k = i; k < m; k++)
                            a[k][j] += (double)(f * (double)a[k][i]);
                    }
                }
                for (k = i; k < m; k++)
                    a[k][i] = (double)((double)a[k][i]*scale);
            }
        }
        w[i] = (double)(scale * g);

        /* right-hand reduction */
        g = s = scale = 0.0;
        if (i < m && i != n - 1)
        {
            for (k = l; k < n; k++)
                scale += ABS((double)a[i][k]);
            if (scale)
            {
                for (k = l; k < n; k++)
                {
                    a[i][k] = (double)((double)a[i][k]/scale);
                    s += ((double)a[i][k] * (double)a[i][k]);
                }
                f = (double)a[i][l];
                g = -SIGN(sqrt(s), f);
                h = f * g - s;
                a[i][l] = (double)(f - g);
                for (k = l; k < n; k++)
                    rv1[k] = (double)a[i][k] / h;
                if (i != m - 1)
                {
                    for (j = l; j < m; j++)
                    {
                        for (s = 0.0, k = l; k < n; k++)
                            s += ((double)a[j][k] * (double)a[i][k]);
                        for (k = l; k < n; k++)
                            a[j][k] += (double)(s * rv1[k]);
                    }
                }
                for (k = l; k < n; k++)
                    a[i][k] = (double)((double)a[i][k]*scale);
            }
        }
        anorm = MAX(anorm, (ABS((double)w[i]) + ABS(rv1[i])));
    }

    /* accumulate the right-hand transformation */
    for (i = n - 1; i >= 0; i--)
    {
        if (i < n - 1)
        {
            if (g)
            {
                for (j = l; j < n; j++)
                    v[j][i] = (double)(((double)a[i][j] / (double)a[i][l]) / g);
                    /* double division to avoid underflow */
                for (j = l; j < n; j++)
                {
                    for (s = 0.0, k = l; k < n; k++)
                        s += ((double)a[i][k] * (double)v[k][j]);
                    for (k = l; k < n; k++)
                        v[k][j] += (double)(s * (double)v[k][i]);
                }
            }
            for (j = l; j < n; j++)
                v[i][j] = v[j][i] = 0.0;
        }
        v[i][i] = 1.0;
        g = rv1[i];
        l = i;
    }

    /* accumulate the left-hand transformation */
    for (i = n - 1; i >= 0; i--)
    {
        l = i + 1;
        g = (double)w[i];
        if (i < n - 1)
            for (j = l; j < n; j++)
                a[i][j] = 0.0;
        if (g)
        {
            g = 1.0 / g;
            if (i != n - 1)
            {
                for (j = l; j < n; j++)
                {
                    for (s = 0.0, k = l; k < m; k++)
                        s += ((double)a[k][i] * (double)a[k][j]);
                    f = (s / (double)a[i][i]) * g;
                    for (k = i; k < m; k++)
                        a[k][j] += (double)(f * (double)a[k][i]);
                }
            }
            for (j = i; j < m; j++)
                a[j][i] = (double)((double)a[j][i]*g);
        }
        else
        {
            for (j = i; j < m; j++)
                a[j][i] = 0.0;
        }
        ++a[i][i];
    }

    /* diagonalize the bidiagonal form */
    for (k = n - 1; k >= 0; k--)
    {                             /* loop over singular values */
        for (its = 0; its < 30; its++)
        {                         /* loop over allowed iterations */
            flag = 1;
            for (l = k; l >= 0; l--)
            {                     /* test for splitting */
                nm = l - 1;
                if (ABS(rv1[l]) + anorm == anorm)
                {
                    flag = 0;
                    break;
                }
                if (ABS((double)w[nm]) + anorm == anorm)
                    break;
            }
            if (flag)
            {
                c = 0.0;
                s = 1.0;
                for (i = l; i <= k; i++)
                {
                    f = s * rv1[i];
                    if (ABS(f) + anorm != anorm)
                    {
                        g = (double)w[i];
                        h = pythag(f, g);
                        w[i] = (double)h;
                        h = 1.0 / h;
                        c = g * h;
                        s = (- f * h);
                        for (j = 0; j < m; j++)
                        {
                            y = (double)a[j][nm];
                            z = (double)a[j][i];
                            a[j][nm] = (double)(y * c + z * s);
                            a[j][i] = (double)(z * c - y * s);
                        }
                    }
                }
            }
            z = (double)w[k];
            if (l == k)
            {                  /* convergence */
                if (z < 0.0)
                {              /* make singular value nonnegative */
                    w[k] = (double)(-z);
                    for (j = 0; j < n; j++)
                        v[j][k] = (-v[j][k]);
                }
                break;
            }
            if (its >= 30) {
                delete rv1;
                throw "No convergence after 30,000! iterations";
                return(0);
            }

            /* shift from bottom 2 x 2 minor */
            x = (double)w[l];
            nm = k - 1;
            y = (double)w[nm];
            g = rv1[nm];
            h = rv1[k];
            f = ((y - z) * (y + z) + (g - h) * (g + h)) / (2.0 * h * y);
            g = pythag(f, 1.0);
            f = ((x - z) * (x + z) + h * ((y / (f + SIGN(g, f))) - h)) / x;

            /* next QR transformation */
            c = s = 1.0;
            for (j = l; j <= nm; j++)
            {
                i = j + 1;
                g = rv1[i];
                y = (double)w[i];
                h = s * g;
                g = c * g;
                z = pythag(f, h);
                rv1[j] = z;
                c = f / z;
                s = h / z;
                f = x * c + g * s;
                g = g * c - x * s;
                h = y * s;
                y = y * c;
                for (jj = 0; jj < n; jj++)
                {
                    x = (double)v[jj][j];
                    z = (double)v[jj][i];
                    v[jj][j] = (double)(x * c + z * s);
                    v[jj][i] = (double)(z * c - x * s);
                }
                z = pythag(f, h);
                w[j] = (double)z;
                if (z)
                {
                    z = 1.0 / z;
                    c = f * z;
                    s = h * z;
                }
                f = (c * g) + (s * y);
                x = (c * y) - (s * g);
                for (jj = 0; jj < m; jj++)
                {
                    y = (double)a[jj][j];
                    z = (double)a[jj][i];
                    a[jj][j] = (double)(y * c + z * s);
                    a[jj][i] = (double)(z * c - y * s);
                }
            }
            rv1[l] = 0.0;
            rv1[k] = f;
            w[k] = (double)x;
        }
    }
    //free((void*) rv1);
    delete rv1;
    return 1;
}
Пример #21
0
	/*The lengths of nodeXlist and nodeYlist are all supposed to be 2*/
void footxy(double *nodeXlist,double *nodeYlist, double *X,double *Y, double *dist, double *fx, double *fy)
{
	double A,B,C;
	int Xmax, Xmin, Ymax, Ymin;
	A=nodeYlist[1]-nodeYlist[0];
	B=nodeXlist[0]-nodeXlist[1];
	C=nodeYlist[0]*nodeXlist[1]-nodeYlist[1]*nodeXlist[0];
	dist[0]=fabs(A*X[0]+B*Y[0]+C)/sqrt(A*A+B*B);
	if (A==(double)0)
	{
		if (B==(double)0)
		{
			fx[0]=nodeXlist[0];
			fy[0]=nodeYlist[0];
			}
		else
		{
			fy[0]=nodeYlist[0];
			fx[0]=X[0];
			}
		}
	else
	{
		if (B==(double)0)
		{
			fx[0]=nodeXlist[0];
			fy[0]=Y[0];
			}
		else
		{
			fx[0]=B*B*X[0]/(A*A+B*B)-A*B*Y[0]/(A*A+B*B)-A*C/(A*A+B*B);
			fy[0]=-A*B*X[0]/(A*A+B*B)+A*A*Y[0]/(A*A+B*B)-B*C/(A*A+B*B);
			}
		}
	
	if (A==(double)0)
	{
		Xmax=maxindex(nodeXlist, (int)2);
		Xmin=minindex(nodeXlist, (int)2);
		if (fx[0]<nodeXlist[Xmin])
		{
			dist[0]=pythag((nodeXlist[Xmin]-X[0]),(nodeYlist[Xmin]-Y[0]));
			fx[0]=nodeXlist[Xmin];
			}
		if (fx[0]>nodeXlist[Xmax])
		{
			dist[0]=pythag((nodeXlist[Xmax]-X[0]),(nodeYlist[Xmax]-Y[0]));
			fx[0]=nodeXlist[Xmin];
			}
		}
	else
	{
		Ymax=maxindex(nodeYlist, (int)2);
		Ymin=minindex(nodeYlist, (int)2);
		if (fy[0]<nodeYlist[Ymin])
		{
			dist[0]=pythag((nodeXlist[Ymin]-X[0]),(nodeYlist[Ymin]-Y[0]));
			fx[0]=nodeXlist[Ymin];
			fy[0]=nodeYlist[Ymin];
			}
		if (fy[0]>nodeYlist[Ymax])
		{
			dist[0]=pythag((nodeXlist[Ymax]-X[0]),(nodeYlist[Ymax]-Y[0]));
			fx[0]=nodeXlist[Ymax];
			fy[0]=nodeYlist[Ymax];
			}
		}
	}
Пример #22
0
static CvStatus
icvSVD_32f( float* a, int lda, float* w,
            float* u, int ldu, float* v, int ldv,
            CvSize size, float* buffer )
{
    float* e;
    float* temp;
    float  *w1, *e1;
    float  *hv;
    double ku0 = 0, kv0 = 0;
    double anorm = 0;
    float  *a1 = a, *u0 = u, *v0 = v;
    float  *u1, *v1;
    int ldu1, ldv1;
    double scale, h;
    int i, j, k, l;
    int n = size.width, m = size.height;
    int nm, m1, n1;
    int iters = 0;

    e = buffer;

    if( m >= n )
    {
        w1 = w;
        e1 = e + 1;
        nm = n;
    }
    else
    {
        w1 = e + 1;
        e1 = w;
        nm = m;
    }
    
    temp = buffer + nm;

    memset( w, 0, nm * sizeof( w[0] ));
    memset( e, 0, nm * sizeof( e[0] ));

    m1 = m;
    n1 = n;

    if( m < n )
        goto row_transform;

    for( ;; )
    {
        if( m1 == 0 )
            break;

        scale = h = 0;

        a = a1;
        hv = u ? u : w1;

        for( j = 0; j < m1; j++, a += lda )
        {
            double t = a[0];
            hv[j] = (float)t;
            scale += fabs(t);
        }

        if( scale != 0 )
        {
            double f = 1./scale, g, s = 0;

            for( j = 0; j < m1; j++ )
            {
                double t = hv[j]*f;
                hv[j] = (float)t;
                s += t * t;
            }

            g = sqrt( s );
            f = hv[0];
            if( f >= 0 )
                g = -g;
            hv[0] = (float)(f - g);
            h = 1. / (f * g - s);

            memset( temp, 0, n1 * sizeof( temp[0] ));

            a = a1;

            /* calc temp[0:n-i] = a[i:m,i:n]'*hv[0:m-i] */
            icvMatrAXPY1_32f( m1, n1 - 1, a + 1, lda, hv, temp + 1 );

            for( k = 1; k < n1; k++ ) temp[k] = (float)(temp[k]*h);
            a = a1;

            /* modify a: a[i:m,i:n] = a[i:m,i:n] + hv[0:m-i]*temp[0:n-i]' */
            icvMatrAXPY2_32f( m1, n1 - 1, temp + 1, lda, hv, a + 1 );
            *w1++ = (float)(g*scale);
        }
        /* store -2/(hv'*hv) */
        if( u )
        {
            if( m1 == m )
                ku0 = h;
            else
                hv[-1] = (float)h;
        }

        a1++;
        n1--;
        if( v )
            v += ldv + 1;

    row_transform:

        if( n1 == 0 )
            break;

        scale = h = 0;

        a = a1;
        hv = v ? v : e1;

        for( j = 0; j < n1; j++ )
        {
            double t = a[j];
            hv[j] = (float)t;
            scale += fabs(t);
        }

        if( scale != 0 )
        {
            double f = 1./scale, g, s = 0;

            for( j = 0; j < n1; j++ )
            {
                double t = hv[j] * f;
                hv[j] = (float)t;
                s += t * t;
            }

            g = sqrt( s );
            f = hv[0];
            if( f >= 0 )
                g = -g;
            hv[0] = (float)(f - g);
            h = 1. / (f * g - s);

            /* update a[i:m:i+1:n] = a[i:m,i+1:n] + (a[i:m,i+1:n]*hv[0:m-i])*... */
            icvMatrAXPY3_32f( m1, n1, hv, lda, a, h );

            *e1++ = (float)(g*scale);
        }

        /* store -2/(hv'*hv) */
        if( v )
        {
            if( n1 == n )
                kv0 = h;
            else
                hv[-1] = (float)h;
        }

        a1 += lda;
        m1--;
        if( u )
            u += ldu + 1;
    }

    m1 -= m1 != 0;
    n1 -= n1 != 0;

    /* accumulate left transformations */
    if( u )
    {
        m1 = m - m1;
        u = u0 + m1 * ldu;
        for( i = m1; i < m; i++, u += ldu )
        {
            memset( u + m1, 0, (m - m1) * sizeof( u[0] ));
            u[i] = 1.;
        }

        for( i = m1 - 1; i >= 0; i-- )
        {
            double h, s;

            l = m - i;
            hv = u0 + (ldu + 1) * i;
            h = i == 0 ? ku0 : hv[-1];

            assert( h <= 0 );

            if( h != 0 )
            {
                u = hv;
                icvMatrAXPY3_32f( l, l-1, hv+1, ldu, u+1, h );

                s = hv[0] * h;
                for( k = 0; k < l; k++ )
                    hv[k] = (float)(hv[k]*s);
                hv[0] += 1;
            }
            else
            {
                for( j = 1; j < l; j++ )
                    hv[j] = hv[j * ldu] = 0;
                hv[0] = 1;
            }
        }
        u = u0;
    }

    /* accumulate right transformations */
    if( v )
    {
        n1 = n - n1;
        v = v0 + n1 * ldv;
        for( i = n1; i < n; i++, v += ldv )
        {
            memset( v + n1, 0, (n - n1) * sizeof( v[0] ));
            v[i] = 1.;
        }

        for( i = n1 - 1; i >= 0; i-- )
        {
            double h, s;

            l = n - i;
            hv = v0 + (ldv + 1) * i;
            h = i == 0 ? kv0 : hv[-1];

            assert( h <= 0 );

            if( h != 0 )
            {
                v = hv;
                icvMatrAXPY3_32f( l, l-1, hv+1, ldv, v+1, h );

                s = hv[0] * h;
                for( k = 0; k < l; k++ )
                    hv[k] = (float)(hv[k]*s);
                hv[0] += 1;
            }
            else
            {
                for( j = 1; j < l; j++ )
                    hv[j] = hv[j * ldv] = 0;
                hv[0] = 1;
            }
        }
        v = v0;
    }

    for( i = 0; i < nm; i++ )
    {
        double tnorm = fabs( w[i] ) + fabs( e[i] );

        if( anorm < tnorm )
            anorm = tnorm;
    }

    if( m >= n )
    {
        m1 = m;
        n1 = n;
        u1 = u;
        ldu1 = ldu;
        v1 = v;
        ldv1 = ldv;
    }
    else
    {
        m1 = n;
        n1 = m;
        u1 = v;
        ldu1 = ldv;
        v1 = u;
        ldv1 = ldu;
    }

    /* diagonalization of the bidiagonal form */
    for( k = nm - 1; k >= 0; k-- )
    {
        double z = 0;
        iters = 0;

        for( ;; )               /* do iterations */
        {
            double c, s, f, g, h, x, y;
            int flag = 0;

            /* test for splitting */
            for( l = k; l >= 0; l-- )
            {
                if( anorm + fabs( e[l] ) == anorm )
                {
                    flag = 1;
                    break;
                }
                assert( l > 0 );
                if( anorm + fabs( w[l - 1] ) == anorm )
                    break;
            }

            if( !flag )
            {
                c = 0;
                s = 1;

                for( i = l; i <= k; i++ )
                {
                    double f = s * e[i];
                    e[i] = (float)(e[i]*c);

                    if( anorm + fabs( f ) == anorm )
                        break;

                    g = w[i];
                    h = pythag( f, g );
                    w[i] = (float)h;
                    c = g / h;
                    s = -f / h;

                    if( u1 )
                    {
                        icvGivens_32f( m1, u1 + ldu1 * (i - 1), u1 + ldu1 * i, c, s );
                    }
                }
            }

            z = w[k];
            if( l == k || iters++ == MAX_ITERS )
                break;

            /* shift from bottom 2x2 minor */
            x = w[l];
            y = w[k - 1];
            g = e[k - 1];
            h = e[k];
            f = 0.5 * (((g + z) / h) * ((g - z) / y) + y / h - h / y);
            g = pythag( f, 1 );
            if( f < 0 )
                g = -g;
            f = x - (z / x) * z + (h / x) * (y / (f + g) - h);
            /* next QR transformation */
            c = s = 1;

            for( i = l + 1; i <= k; i++ )
            {
                g = e[i];
                y = w[i];
                h = s * g;
                g *= c;
                z = pythag( f, h );
                e[i - 1] = (float)z;
                c = f / z;
                s = h / z;
                f = x * c + g * s;
                g = -x * s + g * c;
                h = y * s;
                y *= c;

                if( v1 )
                {
                    icvGivens_32f( n1, v1 + ldv1 * (i - 1), v1 + ldv1 * i, c, s );
                }

                z = pythag( f, h );
                w[i - 1] = (float)z;

                /* rotation can be arbitrary if z == 0 */
                if( z != 0 )
                {
                    c = f / z;
                    s = h / z;
                }
                f = c * g + s * y;
                x = -s * g + c * y;

                if( u1 )
                {
                    icvGivens_32f( m1, u1 + ldu1 * (i - 1), u1 + ldu1 * i, c, s );
                }
            }

            e[l] = 0;
            e[k] = (float)f;
            w[k] = (float)x;
        }                       /* end of iteration loop */

        if( iters > MAX_ITERS )
            break;

        if( z < 0 )
        {
            w[k] = (float)(-z);
            if( v )
            {
                for( j = 0; j < n; j++ )
                    v[j + k * ldv] = -v[j + k * ldv];
            }
        }
    }                           /* end of diagonalization loop */

    /* sort singular values */
    for( i = 0; i < nm; i++ )
    {
        k = i;
        for( j = i + 1; j < nm; j++ )
            if( w[k] < w[j] )
                k = j;

        if( k != i )
        {
            /* swap i & k values */
            float t = w[k];

            w[k] = w[i];
            w[i] = t;

            if( v )
            {
                for( j = 0; j < n; j++ )
                {
                    t = v[j + ldv * k];
                    v[j + ldv * k] = v[j + ldv * i];
                    v[j + ldv * i] = t;
                }
            }

            if( u )
            {
                for( j = 0; j < m; j++ )
                {
                    t = u[j + k * ldu];
                    u[j + ldu * k] = u[j + i * ldu];
                    u[j + ldu * i] = t;
                }
            }
        }
    }

    return CV_NO_ERR;
}
Пример #23
0
void svdcmp(double **a, int m, int n, double *w, double **v)
{
  int flag,i,its,j,jj,k,l,nm;
  double c,f,h,s,x,y,z;
  double anorm=0.0,g=0.0,scale=0.0;
  double *rv1,*dvector(),pythag();
  void nrerror(),free_dvector();

  l = 0;
  nm = 0;

  rv1=dvector(1,n);

  for (i=1;i<=n;i++) {
    l=i+1;
    rv1[i]=scale*g;
    g=s=scale=0.0;
    if (i <= m)
      {
	for (k=i;k<=m;k++) scale += fabs(a[k][i]);
	if (scale)
	  {
	    for (k=i;k<=m;k++)
	      {
		a[k][i] /= scale;
		s += a[k][i]*a[k][i];
	      }
	    f=a[i][i];
	    g = -SIGN(sqrt(s),f);
	    h=f*g-s;
	    a[i][i]=f-g;
	    for (j=l;j<=n;j++)
	      {
		for (s=0.0,k=i;k<=m;k++) s += a[k][i]*a[k][j];
		f=s/h;
		for (k=i;k<=m;k++) a[k][j] += f*a[k][i];
	      }
	    for (k=i;k<=m;k++) a[k][i] *= scale;
	  }
      }
    w[i]=scale*g;
    g=s=scale=0.0;
    if (i <= m && i != n)
      {
	for (k=l;k<=n;k++) scale += fabs(a[i][k]);
	if (scale)
	  {
	    for (k=l;k<=n;k++)
	      {
		a[i][k] /= scale;
		s += a[i][k]*a[i][k];
	      }
	    f=a[i][l];
	    g = -SIGN(sqrt(s),f);
	    h=f*g-s;
	    a[i][l]=f-g;
	    for (k=l;k<=n;k++) rv1[k]=a[i][k]/h;
	    for (j=l;j<=m;j++)
	      {
		for (s=0.0,k=l;k<=n;k++) s += a[j][k]*a[i][k];
		for (k=l;k<=n;k++) a[j][k] += s*rv1[k];
	      }
	    for (k=l;k<=n;k++) a[i][k] *= scale;
	  }
      }
    anorm=max(anorm,(fabs(w[i])+fabs(rv1[i])));
  }
  for (i=n;i>=1;i--)
    {
      if (i < n)
	{
	  if (g)
	    {
	      for (j=l;j<=n;j++)
		  v[j][i]=(a[i][j]/a[i][l])/g;
	      for (j=l;j<=n;j++)
		{
		  for (s=0.0,k=l;k<=n;k++) s += a[i][k]*v[k][j];
		  for (k=l;k<=n;k++) v[k][j] += s*v[k][i];
		}
	    }
	  for (j=l;j<=n;j++) v[i][j]=v[j][i]=0.0;
	}
      v[i][i]=1.0;
      g=rv1[i];
      l=i;
    }
  for (i=min(m,n);i>=1;i--)
    {
      l=i+1;
      g=w[i];
      for (j=l;j<=n;j++) a[i][j]=0.0;
      if (g)
	{
	  g=1.0/g;
	  for (j=l;j<=n;j++)
	    {
	      for (s=0.0,k=l;k<=m;k++) s += a[k][i]*a[k][j];
	      f=(s/a[i][i])*g;
	      for (k=i;k<=m;k++) a[k][j] += f*a[k][i];
	    }
	  for (j=i;j<=m;j++) a[j][i] *= g;
	}
      else
	for (j=i;j<=m;j++) a[j][i]=0.0;
      ++a[i][i];
    }
  for (k=n;k>=1;k--)
    {
      for (its=1;its<=30;its++)
       {
	  flag=1;
	  for (l=k;l>=1;l--)
	    {
	      nm=l-1;
	      if (fabs(rv1[l])+anorm == anorm)
		{
		  flag=0;
		  break;
		}
	      if (fabs(w[nm])+anorm == anorm) break;
	    }
	  if (flag)
	    {
	      c=0.0;
	      s=1.0;
	      for (i=l;i<=k;i++)
		{
		  f=s*rv1[i];
		  rv1[i]=c*rv1[i];
		  if (fabs(f)+anorm == anorm) break;
		  g=w[i];
		  h=pythag(f,g);
		  w[i]=h;
		  h=1.0/h;
		  c=g*h;
		  s=(-f*h);
		  for (j=1;j<=m;j++)
		    {
		      y=a[j][nm];
		      z=a[j][i];
		      a[j][nm]=y*c+z*s;
		      a[j][i]=z*c-y*s;
		    }
		}
	    }
	  z=w[k];
	  if (l == k)
	    {
	      if (z < 0.0)
		{
		  w[k] = -z;
		  for (j=1;j<=n;j++)
		    {
		      v[j][k]=(-v[j][k]);
		    }
		}
	      break;
	    }
	  if (its == 30)
	    nrerror("No convergence in 30 SVDCMP iterations");
	  x=w[l];
	  nm=k-1;
	  y=w[nm];
	  g=rv1[nm];
	  h=rv1[k];
	  f=((y-z)*(y+z)+(g-h)*(g+h))/(2.0*h*y);
	  g=pythag(f,1.0);
	  f=((x-z)*(x+z)+h*((y/(f+SIGN(g,f)))-h))/x;
	  c=s=1.0;
	  for (j=l;j<=nm;j++)
	    {
	      i=j+1;
	      g=rv1[i];
	      y=w[i];
	      h=s*g;
	      g=c*g;
	      z=pythag(f,h);
	      rv1[j]=z;
	      c=f/z;
	      s=h/z;
	      f=x*c+g*s;
	      g=g*c-x*s;
	      h=y*s;
	      y *= c;
	      for (jj=1;jj<=n;jj++)
		{
		  x=v[jj][j];
		  z=v[jj][i];
		  v[jj][j]=x*c+z*s;
		  v[jj][i]=z*c-x*s;
		}
	      z=pythag(f,h);
	      w[j]=z;
	      if (z)
		{
		  z=1.0/z;
		  c=f*z;
		  s=h*z;
		}
	      f=c*g+s*y;
	      x=c*y-s*g;
	      for (jj=1;jj<=m;jj++)
		{
		  y=a[jj][j];
		  z=a[jj][i];
		  a[jj][j]=y*c+z*s;
		  a[jj][i]=z*c-y*s;
		}
	    }
	  rv1[l]=0.0;
	  rv1[k]=f;
	  w[k]=x;
	}  /* end for its */
    } /* end for k  */
  free_dvector(rv1,1,n);
}
Пример #24
0
int32_t svdcmp_c(int32_t m, double* a, double* w, double* v) {
    // C port of PLINK stats.cpp svdcmp().
    // now thread-safe.
    double* rv1 = &(w[(uint32_t)m]);
    int32_t n = m;
    int32_t flag;
    int32_t l = 0; // suppress compile warning
    int32_t i,its,j,jj,k,nm;
    double anorm,c,f,g,h,s,scale,x,y,z;
    double temp;

    g=scale=anorm=0.0;
    for (i=0; i<n; i++) {
        l=i+2;
        rv1[i]=scale*g;
        g=s=scale=0.0;
        if (i < m) {
            for (k=i; k<m; k++) scale += fabs(a[k * m + i]);
            if (scale != 0.0) {
                for (k=i; k<m; k++) {
                    a[k * m + i] /= scale;
                    s += a[k * m + i]*a[k * m + i];
                }
                f=a[i * m + i];
                g = -SIGN(sqrt(s),f);
                h=f*g-s;
                a[i * m + i]=f-g;
                for (j=l-1; j<n; j++) {
                    for (s=0.0,k=i; k<m; k++) s += a[k * m + i]*a[k * m + j];
                    f=s/h;
                    for (k=i; k<m; k++) a[k * m + j] += f*a[k * m + i];
                }
                for (k=i; k<m; k++) a[k * m + i] *= scale;
            }
        }
        w[i]=scale *g;
        g=s=scale=0.0;
        if (i+1 <= m && i+1 != n) {
            for (k=l-1; k<n; k++) scale += fabs(a[i * m + k]);
            if (scale != 0.0) {
                for (k=l-1; k<n; k++) {
                    a[i * m + k] /= scale;
                    s += a[i * m + k]*a[i * m + k];
                }
                f=a[i * m + l-1];
                g = -SIGN(sqrt(s),f);
                h=f*g-s;
                a[i * m + l-1]=f-g;
                for (k=l-1; k<n; k++) rv1[k]=a[i * m + k]/h;
                for (j=l-1; j<m; j++) {
                    for (s=0.0,k=l-1; k<n; k++) s += a[j * m + k]*a[i * m + k];
                    for (k=l-1; k<n; k++) a[j * m + k] += s*rv1[k];
                }
                for (k=l-1; k<n; k++) a[i * m + k] *= scale;
            }
        }
        anorm=MAXV(anorm,(fabs(w[i])+fabs(rv1[i])));
    }
    for (i=n-1; i>=0; i--) {
        if (i < n-1) {
            if (g != 0.0) {
                for (j=l; j<n; j++)
                    v[j * m + i]=(a[i * m + j]/a[i * m + l])/g;
                for (j=l; j<n; j++) {
                    for (s=0.0,k=l; k<n; k++) s += a[i * m + k]*v[k * m + j];
                    for (k=l; k<n; k++) v[k * m + j] += s*v[k * m + i];
                }
            }
            for (j=l; j<n; j++) v[i * m + j]=v[j * m + i]=0.0;
        }
        v[i * m + i]=1.0;
        g=rv1[i];
        l=i;
    }
    for (i=MINV(m,n)-1; i>=0; i--) {
        l=i+1;
        g=w[i];
        for (j=l; j<n; j++) a[i * m + j]=0.0;
        if (g != 0.0) {
            g=1.0/g;
            for (j=l; j<n; j++) {
                for (s=0.0,k=l; k<m; k++) s += a[k * m + i]*a[k * m + j];
                f=(s/a[i * m + i])*g;
                for (k=i; k<m; k++) a[k * m + j] += f*a[k * m + i];
            }
            for (j=i; j<m; j++) a[j * m + i] *= g;
        } else for (j=i; j<m; j++) a[j * m + i]=0.0;
        ++a[i * m + i];
    }
    for (k=n-1; k>=0; k--) {
        for (its=0; its<30; its++) {
            flag=1;
            for (l=k; l>=0; l--) {
                nm=l-1;
                temp=fabs(rv1[l])+anorm;
                if (temp == anorm) {
                    flag=0;
                    break;
                }
                temp=fabs(w[nm])+anorm;
                if (temp == anorm) break;
            }
            if (flag) {
                c=0.0;
                s=1.0;
                for (i=l; i<k+1; i++) {
                    f=s*rv1[i];
                    rv1[i]=c*rv1[i];
                    temp = fabs(f)+anorm;
                    if (temp == anorm) break;
                    g=w[i];
                    h=pythag(f,g);
                    w[i]=h;
                    h=1.0/h;
                    c=g*h;
                    s = -f*h;
                    for (j=0; j<m; j++) {
                        y=a[j * m + nm];
                        z=a[j * m + i];
                        a[j * m + nm]=y*c+z*s;
                        a[j * m + i]=z*c-y*s;
                    }
                }
            }
            z=w[k];
            if (l == k) {
                if (z < 0.0) {
                    w[k] = -z;
                    for (j=0; j<n; j++) v[j * m + k] = -v[j * m + k];
                }
                break;
            }
            if (its == 29)
                return 0; // cannot converge: multi-collinearity?
            x=w[l];
            nm=k-1;
            y=w[nm];
            g=rv1[nm];
            h=rv1[k];
            f=((y-z)*(y+z)+(g-h)*(g+h))/(2.0*h*y);
            g=pythag(f,1.0);
            f=((x-z)*(x+z)+h*((y/(f+SIGN(g,f)))-h))/x;
            c=s=1.0;
            for (j=l; j<=nm; j++) {
                i=j+1;
                g=rv1[i];
                y=w[i];
                h=s*g;
                g=c*g;
                z=pythag(f,h);
                rv1[j]=z;
                c=f/z;
                s=h/z;
                f=x*c+g*s;
                g=g*c-x*s;
                h=y*s;
                y *= c;
                for (jj=0; jj<n; jj++) {
                    x=v[jj * m + j];
                    z=v[jj * m + i];
                    v[jj * m + j]=x*c+z*s;
                    v[jj * m + i]=z*c-x*s;
                }
                z=pythag(f,h);
                w[j]=z;
                if (z) {
                    z=1.0/z;
                    c=f*z;
                    s=h*z;
                }
                f=c*g+s*y;
                x=c*y-s*g;
                for (jj=0; jj<m; jj++) {
                    y=a[jj * m + j];
                    z=a[jj * m + i];
                    a[jj * m + j]=y*c+z*s;
                    a[jj * m + i]=z*c-y*s;
                }
            }
            rv1[l]=0.0;
            rv1[k]=f;
            w[k]=x;
        }
    }
    return 1;
}
Пример #25
0
/** SVD decomposition
 *
 * --------------------------------------------------------------------- *
 * Reference:  "Numerical Recipes By W.H. Press, B. P. Flannery,         *
 *              S.A. Teukolsky and W.T. Vetterling, Cambridge            *
 *              University Press, 1986" [BIBLI 08].                      *
 * --------------------------------------------------------------------- *
 *
 * Given a matrix a(m,n), this routine computes its singular value decomposition,
 * A = U · W · Vt. The matrix U replaces a on output. The diagonal matrix of singular
 * values W is output as a vector w(n). The matrix V (not the transpose Vt) is output
 * as v(n,n).
 *
 * @param a input matrix [m x n] and output matrix U [m x n]
 * @param w output diagonal vector of matrix W [n]
 * @param v output square matrix V [n x n]
 * @param m number of rows of input the matrix
 * @param n number of columns of the input matrix
 * @return 0 (false) if convergence failed, 1 (true) if decomposition succed
 */
int pprz_svd_float(float **a, float *w, float **v, int m, int n)
{
  /* Householder reduction to bidiagonal form. */
  int flag, i, its, j, jj, k, l, NM;
  float C, F, H, S, X, Y, Z, tmp;
  float G = 0.0;
  float Scale = 0.0;
  float ANorm = 0.0;
  float rv1[n];

  for (i = 0; i < n; ++i) {
    l = i + 1;
    rv1[i] = Scale * G;
    G = 0.0;
    S = 0.0;
    Scale = 0.0;
    if (i < m) {
      for (k = i; k < m; ++k) {
        Scale = Scale + fabsf(a[k][i]);
      }
      if (Scale != 0.0) {
        for (k = i; k < m; ++k) {
          a[k][i] = a[k][i] / Scale;
          S = S + a[k][i] * a[k][i];
        }
        F = a[i][i];
        G = sqrtf(S);
        if (F > 0.0) {
          G = -G;
        }
        H = F * G - S;
        a[i][i] = F - G;
        if (i != (n - 1)) {
          for (j = l; j < n; ++j) {
            S = 0.0;
            for (k = i; k < m; ++k) {
              S = S + a[k][i] * a[k][j];
            }
            F = S / H;
            for (k = i; k < m; ++k) {
              a[k][j] = a[k][j] + F * a[k][i];
            }
          }
        }
        for (k = i; k < m; ++k) {
          a[k][i] = Scale * a[k][i];
        }
      }
    }

    w[i] = Scale * G;
    G = 0.0;
    S = 0.0;
    Scale = 0.0;
    if ((i < m) && (i != (n - 1))) {
      for (k = l; k < n; ++k) {
        Scale = Scale + fabsf(a[i][k]);
      }
      if (Scale != 0.0) {
        for (k = l; k < n; ++k) {
          a[i][k] = a[i][k] / Scale;
          S = S + a[i][k] * a[i][k];
        }
        F = a[i][l];
        G = sqrtf(S);
        if (F > 0.0) {
          G = -G;
        }
        H = F * G - S;
        a[i][l] = F - G;
        for (k = l; k < n; ++k) {
          rv1[k] = a[i][k] / H;
        }
        if (i != (m - 1)) {
          for (j = l; j < m; ++j) {
            S = 0.0;
            for (k = l; k < n; ++k) {
              S = S + a[j][k] * a[i][k];
            }
            for (k = l; k < n; ++k) {
              a[j][k] = a[j][k] + S * rv1[k];
            }
          }
        }
        for (k = l; k < n; ++k) {
          a[i][k] = Scale * a[i][k];
        }
      }
    }
    tmp = fabsf(w[i]) + fabsf(rv1[i]);
    if (tmp > ANorm) {
      ANorm = tmp;
    }
  }

  /* Accumulation of right-hand transformations. */
  for (i = n - 1; i >= 0; --i) {
    if (i < (n - 1)) {
      if (G != 0.0) {
        for (j = l; j < n; ++j) {
          v[j][i] = (a[i][j] / a[i][l]) / G;
        }
        for (j = l; j < n; ++j) {
          S = 0.0;
          for (k = l; k < n; ++k) {
            S = S + a[i][k] * v[k][j];
          }
          for (k = l; k < n; ++k) {
            v[k][j] = v[k][j] + S * v[k][i];
          }
        }
      }
      for (j = l; j < n; ++j) {
        v[i][j] = 0.0;
        v[j][i] = 0.0;
      }
    }
    v[i][i] = 1.0;
    G = rv1[i];
    l = i;
  }

  /* Accumulation of left-hand transformations. */
  for (i = n - 1; i >= 0; --i) {
    l = i + 1;
    G = w[i];
    if (i < (n - 1)) {
      for (j = l; j < n; ++j) {
        a[i][j] = 0.0;
      }
    }
    if (G != 0.0) {
      G = 1.0 / G;
      if (i != (n - 1)) {
        for (j = l; j < n; ++j) {
          S = 0.0;
          for (k = l; k < m; ++k) {
            S = S + a[k][i] * a[k][j];
          }
          F = (S / a[i][i]) * G;
          for (k = i; k < m; ++k) {
            a[k][j] = a[k][j] + F * a[k][i];
          }
        }
      }
      for (j = i; j < m; ++j) {
        a[j][i] = a[j][i] * G;
      }
    } else {
      for (j = i; j < m; ++j) {
        a[j][i] = 0.0;
      }
    }
    a[i][i] = a[i][i] + 1.0;
  }

  /* Diagonalization of the bidiagonal form.
     Loop over singular values. */
  for (k = (n - 1); k >= 0; --k) {
    /* Loop over allowed iterations. */
    for (its = 1; its <= 30; ++its) {
      /* Test for splitting.
         Note that rv1[0] is always zero. */
      flag = true;
      for (l = k; l >= 0; --l) {
        NM = l - 1;
        if ((fabsf(rv1[l]) + ANorm) == ANorm) {
          flag = false;
          break;
        } else if ((fabsf(w[NM]) + ANorm) == ANorm) {
          break;
        }
      }

      /* Cancellation of rv1[l], if l > 0; */
      if (flag) {
        C = 0.0;
        S = 1.0;
        for (i = l; i <= k; ++i) {
          F = S * rv1[i];
          if ((fabsf(F) + ANorm) != ANorm) {
            G = w[i];
            //H = sqrtf( F * F + G * G );
            H = pythag(F, G);
            w[i] = H;
            H = 1.0 / H;
            C = (G * H);
            S = -(F * H);
            for (j = 0; j < m; ++j) {
              Y = a[j][NM];
              Z = a[j][i];
              a[j][NM] = (Y * C) + (Z * S);
              a[j][i] = -(Y * S) + (Z * C);
            }
          }
        }
      }
      Z = w[k];
      /* Convergence. */
      if (l == k) {
        /* Singular value is made nonnegative. */
        if (Z < 0.0) {
          w[k] = -Z;
          for (j = 0; j < n; ++j) {
            v[j][k] = -v[j][k];
          }
        }
        break;
      }

      if (its >= 30) {
        // No convergence in 30 iterations
        return 0;
      }

      X = w[l];
      NM = k - 1;
      Y = w[NM];
      G = rv1[NM];
      H = rv1[k];
      F = ((Y - Z) * (Y + Z) + (G - H) * (G + H)) / (2.0 * H * Y);
      //G = sqrtf( F * F + 1.0 );
      G = pythag(F, 1.0);
      tmp = G;
      if (F < 0.0) {
        tmp = -tmp;
      }
      F = ((X - Z) * (X + Z) + H * ((Y / (F + tmp)) - H)) / X;

      /* Next QR transformation. */
      C = 1.0;
      S = 1.0;
      for (j = l; j <= NM; ++j) {
        i = j + 1;
        G = rv1[i];
        Y = w[i];
        H = S * G;
        G = C * G;
        //Z = sqrtf( F * F + H * H );
        Z = pythag(F, H);
        rv1[j] = Z;
        C = F / Z;
        S = H / Z;
        F = (X * C) + (G * S);
        G = -(X * S) + (G * C);
        H = Y * S;
        Y = Y * C;
        for (jj = 0; jj < n; ++jj) {
          X = v[jj][j];
          Z = v[jj][i];
          v[jj][j] = (X * C) + (Z * S);
          v[jj][i] = -(X * S) + (Z * C);
        }
        //Z = sqrtf( F * F + H * H );
        Z = pythag(F, H);
        w[j] = Z;

        /* Rotation can be arbitrary if Z = 0. */
        if (Z != 0.0) {
          Z = 1.0 / Z;
          C = F * Z;
          S = H * Z;
        }
        F = (C * G) + (S * Y);
        X = -(S * G) + (C * Y);
        for (jj = 0; jj < m; ++jj) {
          Y = a[jj][j];
          Z = a[jj][i];
          a[jj][j] = (Y * C) + (Z * S);
          a[jj][i] = -(Y * S) + (Z * C);
        }
      }
      rv1[l] = 0.0;
      rv1[k] = F;
      w[k] = X;
    }
  }

  return 1;
}
Пример #26
0
GLOBAL void
array_tqli(array *d, array *e, array *z) {
 int n=d->nr_of_elements,m,l,iter,i,k;
 DATATYPE s,r,p,g,f,dd,c,b,hold;

 for (i=1;i<n;i++) {
  e->current_element=i;
  hold=READ_ELEMENT(e);
  e->current_element=i-1;
  WRITE_ELEMENT(e, hold);
 }
 e->current_element=n-1;
 WRITE_ELEMENT(e, 0.0);
 for (l=0;l<n;l++) {
  iter=0;
  do {
   for (m=l;m<n-1;m++) {
    /*{{{}}}*/
    /*{{{  */
    d->current_element=e->current_element=m;
    hold=fabs(READ_ELEMENT(d));
    d->current_element=m+1;
    dd=hold+fabs(READ_ELEMENT(d));
    if ((DATATYPE)(fabs(READ_ELEMENT(e))+dd) == dd) break;
    /*}}}  */
   }
   if (m != l) {
    /*{{{  */
    if (iter++ == 30) nrerror("Too many iterations in tqli");
    d->current_element=l+1;
    hold=READ_ELEMENT(d);
    d->current_element=e->current_element=l;
    g=(hold-READ_ELEMENT(d))/(2.0*READ_ELEMENT(e));
    r=pythag(g,1.0);
    hold=READ_ELEMENT(d);
    d->current_element=m;
    g=READ_ELEMENT(d)-hold+READ_ELEMENT(e)/(g+SIGN(r,g));
    s=c=1.0;
    p=0.0;
    for (i=m-1;i>=l;i--) {
     e->current_element=i;
     hold=READ_ELEMENT(e);
     f=s*hold;
     b=c*hold;
     e->current_element=d->current_element=i+1;
     WRITE_ELEMENT(e, r=pythag(f,g));
     if (r == 0.0) {
      WRITE_ELEMENT(d, READ_ELEMENT(d)-p);
      e->current_element=m;
      WRITE_ELEMENT(e, 0.0);
      break;
     }
     s=f/r;
     c=g/r;
     g=READ_ELEMENT(d)-p;
     d->current_element=i;
     r=(READ_ELEMENT(d)-g)*s+2.0*c*b;
     d->current_element=i+1;
     WRITE_ELEMENT(d, g+(p=s*r));
     g=c*r-b;
     for (k=0;k<n;k++) {
      z->current_element=k;
      z->current_vector=i+1;
      f=READ_ELEMENT(z);
      z->current_vector=i;
      hold=READ_ELEMENT(z);
      z->current_vector=i+1;
      WRITE_ELEMENT(z, s*hold+c*f);
      z->current_vector=i;
      WRITE_ELEMENT(z, c*hold-s*f);
     }
    }
    if (r == 0.0 && i >= l) continue;
    d->current_element=e->current_element=l;
    WRITE_ELEMENT(d, READ_ELEMENT(d)-p);
    WRITE_ELEMENT(e, g);
    e->current_element=m;
    WRITE_ELEMENT(e, 0.0);
    /*}}}  */
   }
  } while (m != l);
 }
}
Пример #27
0
static void
icvSVD_32f( float* a, int lda, int m, int n,
            float* w,
            float* uT, int lduT, int nu,
            float* vT, int ldvT,
            float* buffer )
{
    float* e;
    float* temp;
    float *w1, *e1;
    float *hv;
    double ku0 = 0, kv0 = 0;
    double anorm = 0;
    float *a1, *u0 = uT, *v0 = vT;
    double scale, h;
    int i, j, k, l;
    int nm, m1, n1;
    int nv = n;
    int iters = 0;
    float* hv0 = (float*)cvStackAlloc( (m+2)*sizeof(hv0[0])) + 1;

    e = buffer;

    w1 = w;
    e1 = e + 1;
    nm = n;
    
    temp = buffer + nm;

    memset( w, 0, nm * sizeof( w[0] ));
    memset( e, 0, nm * sizeof( e[0] ));

    m1 = m;
    n1 = n;

    /* transform a to bi-diagonal form */
    for( ;; )
    {
        int update_u;
        int update_v;
        
        if( m1 == 0 )
            break;

        scale = h = 0;

        update_u = uT && m1 > m - nu;
        hv = update_u ? uT : hv0;

        for( j = 0, a1 = a; j < m1; j++, a1 += lda )
        {
            double t = a1[0];
            scale += fabs( hv[j] = (float)t );
        }

        if( scale != 0 )
        {
            double f = 1./scale, g, s = 0;

            for( j = 0; j < m1; j++ )
            {
                double t = (hv[j] = (float)(hv[j]*f));
                s += t * t;
            }

            g = sqrt( s );
            f = hv[0];
            if( f >= 0 )
                g = -g;
            hv[0] = (float)(f - g);
            h = 1. / (f * g - s);

            memset( temp, 0, n1 * sizeof( temp[0] ));

            /* calc temp[0:n-i] = a[i:m,i:n]'*hv[0:m-i] */
            icvMatrAXPY_32f( m1, n1 - 1, a + 1, lda, hv, temp + 1, 0 );

            for( k = 1; k < n1; k++ ) temp[k] = (float)(temp[k]*h);

            /* modify a: a[i:m,i:n] = a[i:m,i:n] + hv[0:m-i]*temp[0:n-i]' */
            icvMatrAXPY_32f( m1, n1 - 1, temp + 1, 0, hv, a + 1, lda );
            *w1 = (float)(g*scale);
        }
        w1++;
        
        /* store -2/(hv'*hv) */
        if( update_u )
        {
            if( m1 == m )
                ku0 = h;
            else
                hv[-1] = (float)h;
        }

        a++;
        n1--;
        if( vT )
            vT += ldvT + 1;

        if( n1 == 0 )
            break;

        scale = h = 0;
        update_v = vT && n1 > n - nv;
        hv = update_v ? vT : hv0;

        for( j = 0; j < n1; j++ )
        {
            double t = a[j];
            scale += fabs( hv[j] = (float)t );
        }

        if( scale != 0 )
        {
            double f = 1./scale, g, s = 0;

            for( j = 0; j < n1; j++ )
            {
                double t = (hv[j] = (float)(hv[j]*f));
                s += t * t;
            }

            g = sqrt( s );
            f = hv[0];
            if( f >= 0 )
                g = -g;
            hv[0] = (float)(f - g);
            h = 1. / (f * g - s);
            hv[-1] = 0.f;

            /* update a[i:m:i+1:n] = a[i:m,i+1:n] + (a[i:m,i+1:n]*hv[0:m-i])*... */
            icvMatrAXPY3_32f( m1, n1, hv, lda, a, h );

            *e1 = (float)(g*scale);
        }
        e1++;

        /* store -2/(hv'*hv) */
        if( update_v )
        {
            if( n1 == n )
                kv0 = h;
            else
                hv[-1] = (float)h;
        }

        a += lda;
        m1--;
        if( uT )
            uT += lduT + 1;
    }

    m1 -= m1 != 0;
    n1 -= n1 != 0;

    /* accumulate left transformations */
    if( uT )
    {
        m1 = m - m1;
        uT = u0 + m1 * lduT;
        for( i = m1; i < nu; i++, uT += lduT )
        {
            memset( uT + m1, 0, (m - m1) * sizeof( uT[0] ));
            uT[i] = 1.;
        }

        for( i = m1 - 1; i >= 0; i-- )
        {
            double s;
            int lh = nu - i;

            l = m - i;

            hv = u0 + (lduT + 1) * i;
            h = i == 0 ? ku0 : hv[-1];

            assert( h <= 0 );

            if( h != 0 )
            {
                uT = hv;
                icvMatrAXPY3_32f( lh, l-1, hv+1, lduT, uT+1, h );

                s = hv[0] * h;
                for( k = 0; k < l; k++ ) hv[k] = (float)(hv[k]*s);
                hv[0] += 1;
            }
            else
            {
                for( j = 1; j < l; j++ )
                    hv[j] = 0;
                for( j = 1; j < lh; j++ )
                    hv[j * lduT] = 0;
                hv[0] = 1;
            }
        }
        uT = u0;
    }

    /* accumulate right transformations */
    if( vT )
    {
        n1 = n - n1;
        vT = v0 + n1 * ldvT;
        for( i = n1; i < nv; i++, vT += ldvT )
        {
            memset( vT + n1, 0, (n - n1) * sizeof( vT[0] ));
            vT[i] = 1.;
        }

        for( i = n1 - 1; i >= 0; i-- )
        {
            double s;
            int lh = nv - i;

            l = n - i;
            hv = v0 + (ldvT + 1) * i;
            h = i == 0 ? kv0 : hv[-1];

            assert( h <= 0 );

            if( h != 0 )
            {
                vT = hv;
                icvMatrAXPY3_32f( lh, l-1, hv+1, ldvT, vT+1, h );

                s = hv[0] * h;
                for( k = 0; k < l; k++ ) hv[k] = (float)(hv[k]*s);
                hv[0] += 1;
            }
            else
            {
                for( j = 1; j < l; j++ )
                    hv[j] = 0;
                for( j = 1; j < lh; j++ )
                    hv[j * ldvT] = 0;
                hv[0] = 1;
            }
        }
        vT = v0;
    }

    for( i = 0; i < nm; i++ )
    {
        double tnorm = fabs( w[i] );
        tnorm += fabs( e[i] );

        if( anorm < tnorm )
            anorm = tnorm;
    }

    anorm *= FLT_EPSILON;

    /* diagonalization of the bidiagonal form */
    for( k = nm - 1; k >= 0; k-- )
    {
        double z = 0;
        iters = 0;

        for( ;; )               /* do iterations */
        {
            double c, s, f, g, x, y;
            int flag = 0;

            /* test for splitting */
            for( l = k; l >= 0; l-- )
            {
                if( fabs( e[l] ) <= anorm )
                {
                    flag = 1;
                    break;
                }
                assert( l > 0 );
                if( fabs( w[l - 1] ) <= anorm )
                    break;
            }

            if( !flag )
            {
                c = 0;
                s = 1;

                for( i = l; i <= k; i++ )
                {
                    f = s * e[i];
                    e[i] = (float)(e[i]*c);

                    if( anorm + fabs( f ) == anorm )
                        break;

                    g = w[i];
                    h = pythag( f, g );
                    w[i] = (float)h;
                    c = g / h;
                    s = -f / h;

                    if( uT )
                        icvGivens_32f( m, uT + lduT * (l - 1), uT + lduT * i, c, s );
                }
            }

            z = w[k];
            if( l == k || iters++ == MAX_ITERS )
                break;

            /* shift from bottom 2x2 minor */
            x = w[l];
            y = w[k - 1];
            g = e[k - 1];
            h = e[k];
            f = 0.5 * (((g + z) / h) * ((g - z) / y) + y / h - h / y);
            g = pythag( f, 1 );
            if( f < 0 )
                g = -g;
            f = x - (z / x) * z + (h / x) * (y / (f + g) - h);
            /* next QR transformation */
            c = s = 1;

            for( i = l + 1; i <= k; i++ )
            {
                g = e[i];
                y = w[i];
                h = s * g;
                g *= c;
                z = pythag( f, h );
                e[i - 1] = (float)z;
                c = f / z;
                s = h / z;
                f = x * c + g * s;
                g = -x * s + g * c;
                h = y * s;
                y *= c;

                if( vT )
                    icvGivens_32f( n, vT + ldvT * (i - 1), vT + ldvT * i, c, s );

                z = pythag( f, h );
                w[i - 1] = (float)z;

                /* rotation can be arbitrary if z == 0 */
                if( z != 0 )
                {
                    c = f / z;
                    s = h / z;
                }
                f = c * g + s * y;
                x = -s * g + c * y;

                if( uT )
                    icvGivens_32f( m, uT + lduT * (i - 1), uT + lduT * i, c, s );
            }

            e[l] = 0;
            e[k] = (float)f;
            w[k] = (float)x;
        }                       /* end of iteration loop */

        if( iters > MAX_ITERS )
            break;

        if( z < 0 )
        {
            w[k] = (float)(-z);
            if( vT )
            {
                for( j = 0; j < n; j++ )
                    vT[j + k * ldvT] = -vT[j + k * ldvT];
            }
        }
    }                           /* end of diagonalization loop */

    /* sort singular values and corresponding vectors */
    for( i = 0; i < nm; i++ )
    {
        k = i;
        for( j = i + 1; j < nm; j++ )
            if( w[k] < w[j] )
                k = j;

        if( k != i )
        {
            float t;
            CV_SWAP( w[i], w[k], t );

            if( vT )
                for( j = 0; j < n; j++ )
                    CV_SWAP( vT[j + ldvT*k], vT[j + ldvT*i], t );

            if( uT )
                for( j = 0; j < m; j++ )
                    CV_SWAP( uT[j + lduT*k], uT[j + lduT*i], t );
        }
    }
}
Пример #28
0
LOCAL VOID tql2 P6C(int, nm,
                    int, n,
                    double *, d,
                    double *, e,
                    double *, z,
                    int *, ierr)
{
    /* System generated locals */
    double d__1, d__2;

    /* Local variables */
    double c, f, g, h;
    int i, j, k, l, m;
    double p, r, s, c2, c3 = 0.0;
    int l1, l2;
    double s2 = 0.0;
    int ii;
    double dl1, el1;
    int mml;
    double tst1, tst2;

    /* this subroutine is a translation of the algol procedure tql2, */
    /* num. math. 11, 293-306(1968) by bowdler, martin, reinsch, and */
    /* wilkinson. */
    /* handbook for auto. comp., vol.ii-linear algebra, 227-240(1971). */

    /* this subroutine finds the eigenvalues and eigenvectors */
    /* of a symmetric tridiagonal matrix by the ql method. */
    /* the eigenvectors of a full symmetric matrix can also */
    /* be found if  tred2  has been used to reduce this */
    /* full matrix to tridiagonal form. */

    /* on input */

    /*    nm must be set to the row dimension of two-dimensional */
    /*      array parameters as declared in the calling program */
    /*      dimension statement. */

    /*    n is the order of the matrix. */

    /*    d contains the diagonal elements of the input matrix. */

    /*    e contains the subdiagonal elements of the input matrix */
    /*      in its last n-1 positions.  e(1) is arbitrary. */

    /*    z contains the transformation matrix produced in the */
    /*      reduction by  tred2, if performed.  if the eigenvectors */
    /*      of the tridiagonal matrix are desired, z must contain */
    /*      the identity matrix. */

    /*  on output */

    /*    d contains the eigenvalues in ascending order.  if an */
    /*      error exit is made, the eigenvalues are correct but */
    /*      unordered for indices 1,2,...,ierr-1. */

    /*    e has been destroyed. */

    /*    z contains orthonormal eigenvectors of the symmetric */
    /*      tridiagonal (or full) matrix.  if an error exit is made, */
    /*      z contains the eigenvectors associated with the stored */
    /*      eigenvalues. */

    /*    ierr is set to */
    /*      zero       for normal return, */
    /*      j          if the j-th eigenvalue has not been */
    /*                 determined after 30 iterations. */

    /* calls pythag for  dsqrt(a*a + b*b) . */

    /* questions and comments should be directed to burton s. garbow, */
    /* mathematics and computer science div, argonne national laboratory */

    /* this version dated august 1983. */

    /* ------------------------------------------------------------------ */

    /* Parameter adjustments */
    z -= nm + 1;
    --e;
    --d;

    /* Function Body */
    *ierr = 0;
    if (n == 1) {
        goto L1001;
    }

    for (i = 2; i <= n; ++i) {
        e[i - 1] = e[i];
    }

    f = 0.;
    tst1 = 0.;
    e[n] = 0.;

    for (l = 1; l <= n; ++l) {
        j = 0;
        h = (d__1 = d[l], abs(d__1)) + (d__2 = e[l], abs(d__2));
        if (tst1 < h) {
            tst1 = h;
        }
        /* .......... look for small sub-diagonal element .......... */
        for (m = l; m <= n; ++m) {
            tst2 = tst1 + (d__1 = e[m], abs(d__1));
            if (tst2 == tst1) {
                goto L120;
            }
            /* .......... e(n) is always zero, so there is no exit */
            /*            through the bottom of the loop .......... */
        }

L120:
        if (m == l) {
            goto L220;
        }
L130:
        if (j == 30) {
            goto L1000;
        }
        ++j;
        /* .......... form shift .......... */
        l1 = l + 1;
        l2 = l1 + 1;
        g = d[l];
        p = (d[l1] - g) / (e[l] * 2.);
        r = pythag(p, 1.0);
        d[l] = e[l] / (p + d_sign(&r, &p));
        d[l1] = e[l] * (p + d_sign(&r, &p));
        dl1 = d[l1];
        h = g - d[l];
        if (l2 > n) {
            goto L145;
        }

        for (i = l2; i <= n; ++i) {
            d[i] -= h;
        }

L145:
        f += h;
        /* .......... ql transformation .......... */
        p = d[m];
        c = 1.;
        c2 = c;
        el1 = e[l1];
        s = 0.;
        mml = m - l;
        /* .......... for i=m-1 step -1 until l do -- .......... */
        for (ii = 1; ii <= mml; ++ii) {
            c3 = c2;
            c2 = c;
            s2 = s;
            i = m - ii;
            g = c * e[i];
            h = c * p;
            r = pythag(p, e[i]);
            e[i + 1] = s * r;
            s = e[i] / r;
            c = p / r;
            p = c * d[i] - s * g;
            d[i + 1] = h + s * (c * g + s * d[i]);
            /* .......... form vector .......... */
            for (k = 1; k <= n; ++k) {
                h = z[k + (i + 1) * nm];
                z[k + (i + 1) * nm] = s * z[k + i * nm] + c * h;
                z[k + i * nm] = c * z[k + i * nm] - s * h;
            }

        }

        p = -s * s2 * c3 * el1 * e[l] / dl1;
        e[l] = s * p;
        d[l] = c * p;
        tst2 = tst1 + (d__1 = e[l], abs(d__1));
        if (tst2 > tst1) {
            goto L130;
        }
L220:
        d[l] += f;
    }
    /* .......... order eigenvalues and eigenvectors .......... */
    for (ii = 2; ii <= n; ++ii) {
        i = ii - 1;
        k = i;
        p = d[i];

        for (j = ii; j <= n; ++j) {
            if (d[j] >= p) {
                goto L260;
            }
            k = j;
            p = d[j];
L260:
            ;
        }

        if (k == i) {
            goto L300;
        }
        d[k] = d[i];
        d[i] = p;

        for (j = 1; j <= n; ++j) {
            p = z[j + i * nm];
            z[j + i * nm] = z[j + k * nm];
            z[j + k * nm] = p;
        }

L300:
        ;
    }

    goto L1001;
    /* .......... set error -- no convergence to an */
    /*            eigenvalue after 30 iterations .......... */
L1000:
    *ierr = l;
L1001:
    return;
}
Пример #29
0
int LinearAlgebra::qtli(vector<double>& d, vector<double>& e, vector<vector<double> >& z) {
	try {
		int myM, i, iter;
		double s, r, p, g, f, dd, c, b;
		
		int n = d.size();
		for(int i=1;i<=n;i++){
			e[i-1] = e[i];
		}
		e[n-1] = 0.0000;
		
		for(int l=0;l<n;l++){
			iter = 0;
			do {
				for(myM=l;myM<n-1;myM++){
					dd = fabs(d[myM]) + fabs(d[myM+1]);
					if(fabs(e[myM])+dd == dd) break;
				}
				if(myM != l){
					if(iter++ == 3000) cerr << "Too many iterations in tqli\n";
					g = (d[l+1]-d[l]) / (2.0 * e[l]);
					r = pythag(g, 1.0);
					g = d[myM] - d[l] + e[l] / (g + SIGN(r,g));
					s = c = 1.0;
					p = 0.0000;
					for(i=myM-1;i>=l;i--){
						f = s * e[i];
						b = c * e[i];
						e[i+1] = (r=pythag(f,g));
						if(r==0.0){
							d[i+1] -= p;
							e[myM] = 0.0000;
							break;
						}
						s = f / r;
						c = g / r;
						g = d[i+1] - p;
						r = (d[i] - g) * s + 2.0 * c * b;
						d[i+1] = g + ( p = s * r);
						g = c * r - b;
						for(int k=0;k<n;k++){
							f = z[k][i+1];
							z[k][i+1] = s * z[k][i] + c * f;
							z[k][i] = c * z[k][i] - s * f;
						}
					}
					if(r == 0.00 && i >= l) continue;
					d[l] -= p;
					e[l] = g;
					e[myM] = 0.0;
				}
			} while (myM != l);
		}
		
		int k;
		for(int i=0;i<n;i++){
			p=d[k=i];
			for(int j=i;j<n;j++){
				if(d[j] >= p){
					p=d[k=j];
				}
			}
			if(k!=i){
				d[k]=d[i];
				d[i]=p;
				for(int j=0;j<n;j++){
					p=z[j][i];
					z[j][i] = z[j][k];
					z[j][k] = p;
				}
			}
		}
		
		return 0;
	}
	catch(exception& e) {
		m->errorOut(e, "LinearAlgebra", "qtli");
		exit(1);
	}
}
Пример #30
0
/**
 * Golub-Reinsch SVD.
 */
void
svd_full (const float *a, size_t m, size_t n, float **ou, float **os, float **ov)
{
  float eps = 1.e-15;
  float tol = 1.e-64 / eps;

  int itmax = 50;
  int iteration;

  int h, i, j, k, l;

  float *p = NULL;
  float *q = NULL;
  float *u = NULL;
  float *v = NULL;

  float d, e, f, g, s, x, y, z;

  l = 0;
  g = 0.0;
  x = 0.0;

  if (m < n)
    goto error;
  p = mem_alloc (n, sizeof (float));
  q = mem_alloc (n, sizeof (float));
  u = mem_alloc (m * n, sizeof (float));
  v = mem_alloc (n * n, sizeof (float));
  if (p == NULL || q == NULL || u == NULL || v == NULL)
    goto error;
  memcpy (u, a, m * n * sizeof (float));

  for (i = 0; i < n; i++) {
    p[i] = g;
    s = 0.0;
    l = i + 1;
    for (j = i; j < m; j++)
      s += u[j * n + i] * u[j * n + i];
    if (s <= tol)
      g = 0.0;
    else {
      f = u[i * n + i];
      if (f < 0.0)
        g = sqrt (s);
      else
        g = -sqrt (s);
      d = f * g - s;
      u[i * n + i] = f - g;
      for (j = l; j < n; j++) {
        s = 0.0;
        for (k = i; k < m; k++)
          s += u[k * n + i] * u[k * n + j];
        f = s / d;
        for (k = i; k < m; k++) {
          u[k * n + j] += f * u[k * n + i];
        }
      }
    }
    q[i] = g;
    s = 0.0;
    for (j = l; j < n; j++)
      s += u[i * n + j] * u[i * n + j];
    if (s <= tol)
      g = 0.0;
    else {
      f = u[i * n + i + 1];
      if (f < 0.0)
        g = sqrt (s);
      else
        g = -sqrt (s);
      d = f * g - s;
      u[i * n + i + 1] = f - g;
      for (j = l; j < n; j++)
        p[j] = u[i * n + j] / d;
      for (j = l; j < m; j++) {
        s = 0.0;
        for (k = l; k < n; k++)
          s += u[j * n + k] * u[i * n + k];
        for (k = l; k < n; k++)
          u[j * n + k] += s * p[k];
      }
    }
    y = fabs (q[i]) + fabs (p[i]);
    if (y > x)
      x = y;
  }

  for (i = n - 1; i > -1; i--) {
    if (g != 0.0) {
      d = g * u[i * n + i + 1];
      for (j = l; j < n; j++)
        v[j * n + i] = u[i * n + j] / d;
      for (j = l; j < n; j++) {
        s = 0.0;
        for (k = l; k < n; k++)
          s += u[i * n + k] * v[k * n + j];
        for (k = l; k < n; k++)
          v[k * n + j] += s * v[k * n + i];
      }
    }
    for (j = l; j < n; j++) {
      v[i * n + j] = 0.0;
      v[j * n + i] = 0.0;
    }
    v[i * n + i] = 1.0;
    g = p[i];
    l = i;
  }

  for (i = n - 1; i > -1; i--) {
    l = i + 1;
    g = q[i];
    for (j = l; j < n; j++)
      u[i * n + j] = 0.0;
    if (g != 0.0) {
      d = u[i * n + i] * g;
      for (j = l; j < n; j++) {
        s = 0.0;
        for (k = l; k < m; k++)
          s += u[k * n + i] * u[k * n + j];
        f = s / d;
        for (k = i; k < m; k++)
          u[k * n + j] += f * u[k * n + i];
      }
      for (j = i; j < m; j++)
        u[j * n + i] /= g;
    }
    else
      for (j = i; j < m; j++)
        u[j * n + i] = 0.0;
    u[i * n + i] += 1.0;
  }

  eps *= x;
  for (k = n - 1; k > -1; k--) {
    for (iteration = 0; iteration < itmax; iteration++) {
      int conv;
      for (l = k; l > -1; l--) {
        conv = (fabs (p[l]) <= eps);
        if ((conv) || (fabs (q[l - 1]) <= eps))
          break;
      }
      if (!conv) {
        e = 0.0;
        s = 1.0;
        h = l - 1;
        for (i = l; i < k + 1; i++) {
          f = s * p[i];
          p[i] = e * p[i];
          if (fabs (f) <= eps)
            break;
          g = q[i];
          d = pythag (f, g);
          q[i] = d;
          e = g / d;
          s = -f / d;
          for (j = 0; j < m; j++) {
            y = u[j * n + h];
            z = u[j * n + i];
            u[j * n + h] = y * e + z * s;
            u[j * n + i] = -y * s + z * e;
          }
        }
      }
      z = q[k];
      if (l == k) {
        if (z < 0.0) {
          q[k] = -z;
          for (j = 0; j < n; j++)
            v[j * n + k] = -v[j * n + k];
        }
        break;
      }
      if (iteration >= itmax - 1)
        break;
      x = q[l];
      y = q[k - 1];
      g = p[k - 1];
      d = p[k];
      f = ((y - z) * (y + z) + (g - d) * (g + d)) / (2.0 * d * y);
      g = pythag (f, 1.0);
      if (f < 0)
        f = ((x - z) * (x + z) + d * (y / (f - g) - d)) / x;
      else
        f = ((x - z) * (x + z) + d * (y / (f + g) - d)) / x;
      e = 1.0;
      s = 1.0;
      for (i = l + 1; i < k + 1; i++) {
        g = p[i];
        y = q[i];
        d = s * g;
        g = e * g;
        z = pythag (f, d);
        p[i - 1] = z;
        e = f / z;
        s = d / z;
        f = x * e + g * s;
        g = -x * s + g * e;
        d = y * s;
        y = y * e;
        for (j = 0; j < n; j++) {
          x = v[j * n + i - 1];
          z = v[j * n + i];
          v[j * n + i - 1] = x * e + z * s;
          v[j * n + i] = -x * s + z * e;
        }
        z = pythag (f, d);
        q[i - 1] = z;
        e = f / z;
        s = d / z;
        f = e * g + s * y;
        x = -s * g + e * y;
        for (j = 0; j < m; j++) {
          y = u[j * n + i - 1];
          z = u[j * n + i];
          u[j * n + i - 1] = y * e + z * s;
          u[j * n + i] = -y * s + z * e;
        }
      }
      p[l] = 0.0;
      p[k] = f;
      q[k] = x;
    }
  }
  goto done;
error:
  mem_freenull (q);
  mem_freenull (u);
  mem_freenull (v);
done:
  mem_free (p);
  *ou = u;
  *os = q;
  *ov = v;
}