/* * pushmatrix * * Push the top matrix of the stack down, placing a copy * of it on the top of the stack. * */ void pushmatrix(void) { Mstack *tmpmat; Token *p; if (vdevice.inobject) { p = newtokens(1); p->i = PUSHMATRIX; return; } if (msfree != (Mstack *)NULL) { tmpmat = vdevice.transmat; vdevice.transmat = msfree; msfree = msfree->back; vdevice.transmat->back = tmpmat; copymatrix(vdevice.transmat->m, tmpmat->m); } else { tmpmat = (Mstack *)vallocate(sizeof(Mstack)); tmpmat->back = vdevice.transmat; copymatrix(tmpmat->m, vdevice.transmat->m); vdevice.transmat = tmpmat; } }
/* * curvebasis * * sets the basis type of curves. * */ void curvebasis(short int id) { if(!vdevice.initialised) verror("curvebasis: vogl not initialised"); copymatrix(vdevice.tbasis, vdevice.bases[id]); }
matrix* Closure(matrix* m, boolean close, group* lie_type) { matrix* result; lie_Index i,j; group* tp=(s=Ssrank(grp), lie_type==NULL ? mkgroup(s) : lie_type); tp->toraldim=Lierank(grp); tp->ncomp=0; /* start with maximal torus */ m=copymatrix(m); if (close) if (type_of(grp)==SIMPGRP) close = two_lengths(grp->s.lietype); else { for (i=0; i<grp->g.ncomp; i++) if (two_lengths(Liecomp(grp,i)->lietype)) break; close= i<grp->g.ncomp; } { entry* t; for (i=0; i<m->nrows; i++) if (!isroot(t=m->elm[i])) error("Set of root vectors contains a non-root\n"); else if (!isposroot(t=m->elm[i])) for (j=0; j<m->ncols; j++) t[j]= -t[j]; /* make positive root */ Unique(m,cmpfn); } { lie_Index next; for (i=0; i<m->nrows; i=next) { lie_Index d,n=0; simpgrp* c; next=isolcomp(m,i); fundam(m,i,&next); if (close) long_close(m,i,next),fundam(m,i,&next); c=simp_type(&m->elm[i],d=next-i); { j=tp->ncomp++; while(--j>=0 && grp_less(tp->liecomp[j],c)) n += (tp->liecomp[j+1]=tp->liecomp[j])->lierank; tp->liecomp[++j]=c; tp->toraldim -= d; /* insert component and remove rank from torus */ cycle_block(m,i-n,next,n); /* move the |d| rows down across |n| previous rows */ } } } if (lie_type==NULL) return result=copymatrix(m),freemem(m),freemem(tp),result; else return freemem(m),(matrix*)NULL; /* |Cartan_type| doesn't need |m| */ }
void internalschurdecomposition(ap::real_2d_array& h, int n, int tneeded, int zneeded, ap::real_1d_array& wr, ap::real_1d_array& wi, ap::real_2d_array& z, int& info) { ap::real_1d_array work; int i; int i1; int i2; int ierr; int ii; int itemp; int itn; int its; int j; int k; int l; int maxb; int nr; int ns; int nv; double absw; double ovfl; double smlnum; double tau; double temp; double tst1; double ulp; double unfl; ap::real_2d_array s; ap::real_1d_array v; ap::real_1d_array vv; ap::real_1d_array workc1; ap::real_1d_array works1; ap::real_1d_array workv3; ap::real_1d_array tmpwr; ap::real_1d_array tmpwi; bool initz; bool wantt; bool wantz; double cnst; bool failflag; int p1; int p2; int p3; int p4; double vt; // // Set the order of the multi-shift QR algorithm to be used. // If you want to tune algorithm, change this values // ns = 12; maxb = 50; // // Now 2 < NS <= MAXB < NH. // maxb = ap::maxint(3, maxb); ns = ap::minint(maxb, ns); // // Initialize // cnst = 1.5; work.setbounds(1, ap::maxint(n, 1)); s.setbounds(1, ns, 1, ns); v.setbounds(1, ns+1); vv.setbounds(1, ns+1); wr.setbounds(1, ap::maxint(n, 1)); wi.setbounds(1, ap::maxint(n, 1)); workc1.setbounds(1, 1); works1.setbounds(1, 1); workv3.setbounds(1, 3); tmpwr.setbounds(1, ap::maxint(n, 1)); tmpwi.setbounds(1, ap::maxint(n, 1)); ap::ap_error::make_assertion(n>=0, "InternalSchurDecomposition: incorrect N!"); ap::ap_error::make_assertion(tneeded==0||tneeded==1, "InternalSchurDecomposition: incorrect TNeeded!"); ap::ap_error::make_assertion(zneeded==0||zneeded==1||zneeded==2, "InternalSchurDecomposition: incorrect ZNeeded!"); wantt = tneeded==1; initz = zneeded==2; wantz = zneeded!=0; info = 0; // // Initialize Z, if necessary // if( initz ) { z.setbounds(1, n, 1, n); for(i = 1; i <= n; i++) { for(j = 1; j <= n; j++) { if( i==j ) { z(i,j) = 1; } else { z(i,j) = 0; } } } } // // Quick return if possible // if( n==0 ) { return; } if( n==1 ) { wr(1) = h(1,1); wi(1) = 0; return; } // // Set rows and columns 1 to N to zero below the first // subdiagonal. // for(j = 1; j <= n-2; j++) { for(i = j+2; i <= n; i++) { h(i,j) = 0; } } // // Test if N is sufficiently small // if( ns<=2||ns>n||maxb>=n ) { // // Use the standard double-shift algorithm // internalauxschur(wantt, wantz, n, 1, n, h, wr, wi, 1, n, z, work, workv3, workc1, works1, info); // // fill entries under diagonal blocks of T with zeros // if( wantt ) { j = 1; while(j<=n) { if( wi(j)==0 ) { for(i = j+1; i <= n; i++) { h(i,j) = 0; } j = j+1; } else { for(i = j+2; i <= n; i++) { h(i,j) = 0; h(i,j+1) = 0; } j = j+2; } } } return; } unfl = ap::minrealnumber; ovfl = 1/unfl; ulp = 2*ap::machineepsilon; smlnum = unfl*(n/ulp); // // I1 and I2 are the indices of the first row and last column of H // to which transformations must be applied. If eigenvalues only are // being computed, I1 and I2 are set inside the main loop. // if( wantt ) { i1 = 1; i2 = n; } // // ITN is the total number of multiple-shift QR iterations allowed. // itn = 30*n; // // The main loop begins here. I is the loop index and decreases from // IHI to ILO in steps of at most MAXB. Each iteration of the loop // works with the active submatrix in rows and columns L to I. // Eigenvalues I+1 to IHI have already converged. Either L = ILO or // H(L,L-1) is negligible so that the matrix splits. // i = n; while(true) { l = 1; if( i<1 ) { // // fill entries under diagonal blocks of T with zeros // if( wantt ) { j = 1; while(j<=n) { if( wi(j)==0 ) { for(i = j+1; i <= n; i++) { h(i,j) = 0; } j = j+1; } else { for(i = j+2; i <= n; i++) { h(i,j) = 0; h(i,j+1) = 0; } j = j+2; } } } // // Exit // return; } // // Perform multiple-shift QR iterations on rows and columns ILO to I // until a submatrix of order at most MAXB splits off at the bottom // because a subdiagonal element has become negligible. // failflag = true; for(its = 0; its <= itn; its++) { // // Look for a single small subdiagonal element. // for(k = i; k >= l+1; k--) { tst1 = fabs(h(k-1,k-1))+fabs(h(k,k)); if( tst1==0 ) { tst1 = upperhessenberg1norm(h, l, i, l, i, work); } if( fabs(h(k,k-1))<=ap::maxreal(ulp*tst1, smlnum) ) { break; } } l = k; if( l>1 ) { // // H(L,L-1) is negligible. // h(l,l-1) = 0; } // // Exit from loop if a submatrix of order <= MAXB has split off. // if( l>=i-maxb+1 ) { failflag = false; break; } // // Now the active submatrix is in rows and columns L to I. If // eigenvalues only are being computed, only the active submatrix // need be transformed. // if( !wantt ) { i1 = l; i2 = i; } if( its==20||its==30 ) { // // Exceptional shifts. // for(ii = i-ns+1; ii <= i; ii++) { wr(ii) = cnst*(fabs(h(ii,ii-1))+fabs(h(ii,ii))); wi(ii) = 0; } } else { // // Use eigenvalues of trailing submatrix of order NS as shifts. // copymatrix(h, i-ns+1, i, i-ns+1, i, s, 1, ns, 1, ns); internalauxschur(false, false, ns, 1, ns, s, tmpwr, tmpwi, 1, ns, z, work, workv3, workc1, works1, ierr); for(p1 = 1; p1 <= ns; p1++) { wr(i-ns+p1) = tmpwr(p1); wi(i-ns+p1) = tmpwi(p1); } if( ierr>0 ) { // // If DLAHQR failed to compute all NS eigenvalues, use the // unconverged diagonal elements as the remaining shifts. // for(ii = 1; ii <= ierr; ii++) { wr(i-ns+ii) = s(ii,ii); wi(i-ns+ii) = 0; } } } // // Form the first column of (G-w(1)) (G-w(2)) . . . (G-w(ns)) // where G is the Hessenberg submatrix H(L:I,L:I) and w is // the vector of shifts (stored in WR and WI). The result is // stored in the local array V. // v(1) = 1; for(ii = 2; ii <= ns+1; ii++) { v(ii) = 0; } nv = 1; for(j = i-ns+1; j <= i; j++) { if( wi(j)>=0 ) { if( wi(j)==0 ) { // // real shift // p1 = nv+1; ap::vmove(&vv(1), &v(1), ap::vlen(1,p1)); matrixvectormultiply(h, l, l+nv, l, l+nv-1, false, vv, 1, nv, 1.0, v, 1, nv+1, -wr(j)); nv = nv+1; } else { if( wi(j)>0 ) { // // complex conjugate pair of shifts // p1 = nv+1; ap::vmove(&vv(1), &v(1), ap::vlen(1,p1)); matrixvectormultiply(h, l, l+nv, l, l+nv-1, false, v, 1, nv, 1.0, vv, 1, nv+1, -2*wr(j)); itemp = vectoridxabsmax(vv, 1, nv+1); temp = 1/ap::maxreal(fabs(vv(itemp)), smlnum); p1 = nv+1; ap::vmul(&vv(1), ap::vlen(1,p1), temp); absw = pythag2(wr(j), wi(j)); temp = temp*absw*absw; matrixvectormultiply(h, l, l+nv+1, l, l+nv, false, vv, 1, nv+1, 1.0, v, 1, nv+2, temp); nv = nv+2; } } // // Scale V(1:NV) so that max(abs(V(i))) = 1. If V is zero, // reset it to the unit vector. // itemp = vectoridxabsmax(v, 1, nv); temp = fabs(v(itemp)); if( temp==0 ) { v(1) = 1; for(ii = 2; ii <= nv; ii++) { v(ii) = 0; } } else { temp = ap::maxreal(temp, smlnum); vt = 1/temp; ap::vmul(&v(1), ap::vlen(1,nv), vt); } } } // // Multiple-shift QR step // for(k = l; k <= i-1; k++) { // // The first iteration of this loop determines a reflection G // from the vector V and applies it from left and right to H, // thus creating a nonzero bulge below the subdiagonal. // // Each subsequent iteration determines a reflection G to // restore the Hessenberg form in the (K-1)th column, and thus // chases the bulge one step toward the bottom of the active // submatrix. NR is the order of G. // nr = ap::minint(ns+1, i-k+1); if( k>l ) { p1 = k-1; p2 = k+nr-1; ap::vmove(v.getvector(1, nr), h.getcolumn(p1, k, p2)); } generatereflection(v, nr, tau); if( k>l ) { h(k,k-1) = v(1); for(ii = k+1; ii <= i; ii++) { h(ii,k-1) = 0; } } v(1) = 1; // // Apply G from the left to transform the rows of the matrix in // columns K to I2. // applyreflectionfromtheleft(h, tau, v, k, k+nr-1, k, i2, work); // // Apply G from the right to transform the columns of the // matrix in rows I1 to min(K+NR,I). // applyreflectionfromtheright(h, tau, v, i1, ap::minint(k+nr, i), k, k+nr-1, work); if( wantz ) { // // Accumulate transformations in the matrix Z // applyreflectionfromtheright(z, tau, v, 1, n, k, k+nr-1, work); } } } // // Failure to converge in remaining number of iterations // if( failflag ) { info = i; return; } // // A submatrix of order <= MAXB in rows and columns L to I has split // off. Use the double-shift QR algorithm to handle it. // internalauxschur(wantt, wantz, n, l, i, h, wr, wi, 1, n, z, work, workv3, workc1, works1, info); if( info>0 ) { return; } // // Decrement number of remaining iterations, and return to start of // the main loop with a new value of I. // itn = itn-its; i = l-1; } }
//todo put convergence into one function structmatrix conjugategradient(structmatrix *A,structmatrix *b){ const unsigned int MAXITER=100; const MATDOUBLE TOL=1e-6; MATDOUBLE *xp=calloc(A->nrows,sizeof(MATDOUBLE));//init guess 0s MATDOUBLE *x= malloc(A->nrows*sizeof(MATDOUBLE));// structmatrix XP=creatematrix(xp ,A->nrows,1//solns in col vector ,endt(MATDOUBLE),rowmjr); structmatrix X=creatematrix(x ,A->nrows,1//solns in col vector ,endt(MATDOUBLE),rowmjr); structmatrix rP=copymatrix(b); //previous error structmatrix pP=copymatrix(b); //CG vec structmatrix r=creatematrix(malloc(sizeof(MATDOUBLE)*rP.nrows) ,rP.nrows,1 ,endt(MATDOUBLE),rowmjr); structmatrix p=creatematrix(malloc(sizeof(MATDOUBLE)*pP.nrows) ,pP.nrows,1 ,endt(MATDOUBLE),rowmjr); fpidx idxA= getidxingfunc( A); fpidx idxb= getidxingfunc( b); fpidx idxX= getidxingfunc(&X); fpidx idxXP=getidxingfunc(&XP); fpidx idxrP=getidxingfunc(&rP); fpidx idxpP=getidxingfunc(&pP); fpidx idxr =getidxingfunc(&r ); fpidx idxp =getidxingfunc(&p ); #define Xv(ri,ci) *(double*) idxX( &ri,&ci,&X) #define XPv(ri,ci) *(double*) idxXP(&ri,&ci,&XP) #define Av(ri,ci) *(double*) idxA( &ri,&ci, A) #define bv(ri,ci) *(double*) idxb( &ri,&ci, b) #define rPv(ri,ci) *(double*) idxrP( &ri,&ci, &rP) #define pPv(ri,ci) *(double*) idxb( &ri,&ci, &pP) #define rv(ri,ci) *(double*) idxA( &ri,&ci, &r) #define pv(ri,ci) *(double*) idxb( &ri,&ci, &p) //result definition #define ApPv(ri,ci) *(double*) idxApP(&ri,&ci,&ApP) unsigned int zero=0; unsigned int k=0; while(k<MAXITER){ double alpha, beta;//scalars to compute in each interatin structmatrix rPT=(vecT(&rP)),pPT=vecT(&pP); structmatrix rPTrP=matrixmatrixmuldbl(&rPT,&rP);//1x1 structmatrix ApP=matrixmatrixmuldbl(A,&pP);// vec nrows fpidx idxApP =getidxingfunc(&ApP); double alphan=*(double*) rPTrP.data; double alphad=*(double*) (matrixmatrixmuldbl(&pPT,&ApP)).data; alpha=alphan/alphad;//alpha new unsigned int ri; for(ri=0;ri<XP.nrows;ri++){ Xv(ri,zero)=XPv(ri,zero)+alpha*pPv(ri,zero); //new x approx soln rv(ri,zero)=rPv(ri,zero)-alpha*ApPv(ri,zero);//new r error } structmatrix rT=vecT(&r); structmatrix rTr=matrixmatrixmuldbl(&rT,&r); beta=(*(double*) rTr.data)/(*(double*) rPTrP.data); //scalar/scalar for(ri=0;ri<p.nrows;ri++){ pv(ri,zero)=rv(ri,zero)+beta*pPv(ri,zero); } double normofr=0; for(ri=0;ri<X.nrows;ri++){normofr+=pow(rv(ri,zero),2);} normofr=pow(normofr,.5); if(normofr<TOL){printf("converged\n in %d iterations\n",k+1);return X;} //previous=current for(ri=0;ri<X.nrows;ri++){ XPv(ri,zero)=Xv(ri,zero); pPv(ri,zero)=pv(ri,zero); rPv(ri,zero)=rv(ri,zero); } /* todo does not work if i add these free statements does the memory get freed with each loop? i thought it would not!*/ /* free(rPT.data); free(rPTrP.data); free(ApP.data); free(rT.data); free(rTr.data); */ k++;} free(XP.data); free(rP.data); free(pP.data); free(r.data); free(p.data); return X; #undef Xv #undef XPv #undef Av #undef bv #undef rPv #undef pPv #undef rv #undef pv #undef ApPv }
/* * Retreive the top matrix on the stack and place it in m */ void getmatrix(float (*m)[4]) { copymatrix(m, vdevice.transmat->m); }
/************************************************************************* k-means++ clusterization INPUT PARAMETERS: XY - dataset, array [0..NPoints-1,0..NVars-1]. NPoints - dataset size, NPoints>=K NVars - number of variables, NVars>=1 K - desired number of clusters, K>=1 Restarts - number of restarts, Restarts>=1 OUTPUT PARAMETERS: Info - return code: * -3, if taskis degenerate (number of distinct points is less than K) * -1, if incorrect NPoints/NFeatures/K/Restarts was passed * 1, if subroutine finished successfully C - array[0..NVars-1,0..K-1].matrix whose columns store cluster's centers XYC - array which contains number of clusters dataset points belong to. -- ALGLIB -- Copyright 21.03.2009 by Bochkanov Sergey *************************************************************************/ void kmeansgenerate(const ap::real_2d_array& xy, int npoints, int nvars, int k, int restarts, int& info, ap::real_2d_array& c, ap::integer_1d_array& xyc) { int i; int j; ap::real_2d_array ct; ap::real_2d_array ctbest; double e; double ebest; ap::real_1d_array x; ap::real_1d_array tmp; int cc; ap::real_1d_array d2; ap::real_1d_array p; ap::integer_1d_array csizes; ap::boolean_1d_array cbusy; double v; double s; int cclosest; double dclosest; ap::real_1d_array work; bool waschanges; bool zerosizeclusters; int pass; // // Test parameters // if( npoints<k||nvars<1||k<1||restarts<1 ) { info = -1; return; } // // TODO: special case K=1 // TODO: special case K=NPoints // info = 1; // // Multiple passes of k-means++ algorithm // ct.setbounds(0, k-1, 0, nvars-1); ctbest.setbounds(0, k-1, 0, nvars-1); xyc.setbounds(0, npoints-1); d2.setbounds(0, npoints-1); p.setbounds(0, npoints-1); tmp.setbounds(0, nvars-1); csizes.setbounds(0, k-1); cbusy.setbounds(0, k-1); ebest = ap::maxrealnumber; for(pass = 1; pass <= restarts; pass++) { // // Select initial centers using k-means++ algorithm // 1. Choose first center at random // 2. Choose next centers using their distance from centers already chosen // // Note that for performance reasons centers are stored in ROWS of CT, not // in columns. We'll transpose CT in the end and store it in the C. // i = ap::randominteger(npoints); ap::vmove(&ct(0, 0), &xy(i, 0), ap::vlen(0,nvars-1)); cbusy(0) = true; for(i = 1; i <= k-1; i++) { cbusy(i) = false; } if( !selectcenterpp(xy, npoints, nvars, ct, cbusy, k, d2, p, tmp) ) { info = -3; return; } // // Update centers: // 2. update center positions // while(true) { // // fill XYC with center numbers // waschanges = false; for(i = 0; i <= npoints-1; i++) { cclosest = -1; dclosest = ap::maxrealnumber; for(j = 0; j <= k-1; j++) { ap::vmove(&tmp(0), &xy(i, 0), ap::vlen(0,nvars-1)); ap::vsub(&tmp(0), &ct(j, 0), ap::vlen(0,nvars-1)); v = ap::vdotproduct(&tmp(0), &tmp(0), ap::vlen(0,nvars-1)); if( v<dclosest ) { cclosest = j; dclosest = v; } } if( xyc(i)!=cclosest ) { waschanges = true; } xyc(i) = cclosest; } // // Update centers // for(j = 0; j <= k-1; j++) { csizes(j) = 0; } for(i = 0; i <= k-1; i++) { for(j = 0; j <= nvars-1; j++) { ct(i,j) = 0; } } for(i = 0; i <= npoints-1; i++) { csizes(xyc(i)) = csizes(xyc(i))+1; ap::vadd(&ct(xyc(i), 0), &xy(i, 0), ap::vlen(0,nvars-1)); } zerosizeclusters = false; for(i = 0; i <= k-1; i++) { cbusy(i) = csizes(i)!=0; zerosizeclusters = zerosizeclusters||csizes(i)==0; } if( zerosizeclusters ) { // // Some clusters have zero size - rare, but possible. // We'll choose new centers for such clusters using k-means++ rule // and restart algorithm // if( !selectcenterpp(xy, npoints, nvars, ct, cbusy, k, d2, p, tmp) ) { info = -3; return; } continue; } for(j = 0; j <= k-1; j++) { v = double(1)/double(csizes(j)); ap::vmul(&ct(j, 0), ap::vlen(0,nvars-1), v); } // // if nothing has changed during iteration // if( !waschanges ) { break; } } // // 3. Calculate E, compare with best centers found so far // e = 0; for(i = 0; i <= npoints-1; i++) { ap::vmove(&tmp(0), &xy(i, 0), ap::vlen(0,nvars-1)); ap::vsub(&tmp(0), &ct(xyc(i), 0), ap::vlen(0,nvars-1)); v = ap::vdotproduct(&tmp(0), &tmp(0), ap::vlen(0,nvars-1)); e = e+v; } if( e<ebest ) { // // store partition // copymatrix(ct, 0, k-1, 0, nvars-1, ctbest, 0, k-1, 0, nvars-1); } } // // Copy and transpose // c.setbounds(0, nvars-1, 0, k-1); copyandtranspose(ctbest, 0, k-1, 0, nvars-1, c, 0, nvars-1, 0, k-1); }
bool testblas(bool silent) { bool result; int pass; int passcount; int n; int i; int i1; int i2; int j; int j1; int j2; int l; int k; int r; int i3; int j3; int col1; int col2; int row1; int row2; ap::real_1d_array x1; ap::real_1d_array x2; ap::real_2d_array a; ap::real_2d_array b; ap::real_2d_array c1; ap::real_2d_array c2; double err; double e1; double e2; double e3; double v; double scl1; double scl2; double scl3; bool was1; bool was2; bool trans1; bool trans2; double threshold; bool n2errors; bool hsnerrors; bool amaxerrors; bool mverrors; bool iterrors; bool cterrors; bool mmerrors; bool waserrors; n2errors = false; amaxerrors = false; hsnerrors = false; mverrors = false; iterrors = false; cterrors = false; mmerrors = false; waserrors = false; threshold = 10000*ap::machineepsilon; // // Test Norm2 // passcount = 1000; e1 = 0; e2 = 0; e3 = 0; scl2 = 0.5*ap::maxrealnumber; scl3 = 2*ap::minrealnumber; for(pass = 1; pass <= passcount; pass++) { n = 1+ap::randominteger(1000); i1 = ap::randominteger(10); i2 = n+i1-1; x1.setbounds(i1, i2); x2.setbounds(i1, i2); for(i = i1; i <= i2; i++) { x1(i) = 2*ap::randomreal()-1; } v = 0; for(i = i1; i <= i2; i++) { v = v+ap::sqr(x1(i)); } v = sqrt(v); e1 = ap::maxreal(e1, fabs(v-vectornorm2(x1, i1, i2))); for(i = i1; i <= i2; i++) { x2(i) = scl2*x1(i); } e2 = ap::maxreal(e2, fabs(v*scl2-vectornorm2(x2, i1, i2))); for(i = i1; i <= i2; i++) { x2(i) = scl3*x1(i); } e3 = ap::maxreal(e3, fabs(v*scl3-vectornorm2(x2, i1, i2))); } e2 = e2/scl2; e3 = e3/scl3; n2errors = ap::fp_greater_eq(e1,threshold)||ap::fp_greater_eq(e2,threshold)||ap::fp_greater_eq(e3,threshold); // // Testing VectorAbsMax, Column/Row AbsMax // x1.setbounds(1, 5); x1(1) = 2.0; x1(2) = 0.2; x1(3) = -1.3; x1(4) = 0.7; x1(5) = -3.0; amaxerrors = vectoridxabsmax(x1, 1, 5)!=5||vectoridxabsmax(x1, 1, 4)!=1||vectoridxabsmax(x1, 2, 4)!=3; n = 30; x1.setbounds(1, n); a.setbounds(1, n, 1, n); for(i = 1; i <= n; i++) { for(j = 1; j <= n; j++) { a(i,j) = 2*ap::randomreal()-1; } } was1 = false; was2 = false; for(pass = 1; pass <= 1000; pass++) { j = 1+ap::randominteger(n); i1 = 1+ap::randominteger(n); i2 = i1+ap::randominteger(n+1-i1); ap::vmove(x1.getvector(i1, i2), a.getcolumn(j, i1, i2)); if( vectoridxabsmax(x1, i1, i2)!=columnidxabsmax(a, i1, i2, j) ) { was1 = true; } i = 1+ap::randominteger(n); j1 = 1+ap::randominteger(n); j2 = j1+ap::randominteger(n+1-j1); ap::vmove(&x1(j1), &a(i, j1), ap::vlen(j1,j2)); if( vectoridxabsmax(x1, j1, j2)!=rowidxabsmax(a, j1, j2, i) ) { was2 = true; } } amaxerrors = amaxerrors||was1||was2; // // Testing upper Hessenberg 1-norm // a.setbounds(1, 3, 1, 3); x1.setbounds(1, 3); a(1,1) = 2; a(1,2) = 3; a(1,3) = 1; a(2,1) = 4; a(2,2) = -5; a(2,3) = 8; a(3,1) = 99; a(3,2) = 3; a(3,3) = 1; hsnerrors = ap::fp_greater(fabs(upperhessenberg1norm(a, 1, 3, 1, 3, x1)-11),threshold); // // Testing MatrixVectorMultiply // a.setbounds(2, 3, 3, 5); x1.setbounds(1, 3); x2.setbounds(1, 2); a(2,3) = 2; a(2,4) = -1; a(2,5) = -1; a(3,3) = 1; a(3,4) = -2; a(3,5) = 2; x1(1) = 1; x1(2) = 2; x1(3) = 1; x2(1) = -1; x2(2) = -1; matrixvectormultiply(a, 2, 3, 3, 5, false, x1, 1, 3, 1.0, x2, 1, 2, 1.0); matrixvectormultiply(a, 2, 3, 3, 5, true, x2, 1, 2, 1.0, x1, 1, 3, 1.0); e1 = fabs(x1(1)+5)+fabs(x1(2)-8)+fabs(x1(3)+1)+fabs(x2(1)+2)+fabs(x2(2)+2); x1(1) = 1; x1(2) = 2; x1(3) = 1; x2(1) = -1; x2(2) = -1; matrixvectormultiply(a, 2, 3, 3, 5, false, x1, 1, 3, 1.0, x2, 1, 2, 0.0); matrixvectormultiply(a, 2, 3, 3, 5, true, x2, 1, 2, 1.0, x1, 1, 3, 0.0); e2 = fabs(x1(1)+3)+fabs(x1(2)-3)+fabs(x1(3)+1)+fabs(x2(1)+1)+fabs(x2(2)+1); mverrors = ap::fp_greater_eq(e1+e2,threshold); // // testing inplace transpose // n = 10; a.setbounds(1, n, 1, n); b.setbounds(1, n, 1, n); x1.setbounds(1, n-1); for(i = 1; i <= n; i++) { for(j = 1; j <= n; j++) { a(i,j) = ap::randomreal(); } } passcount = 10000; was1 = false; for(pass = 1; pass <= passcount; pass++) { i1 = 1+ap::randominteger(n); i2 = i1+ap::randominteger(n-i1+1); j1 = 1+ap::randominteger(n-(i2-i1)); j2 = j1+(i2-i1); copymatrix(a, i1, i2, j1, j2, b, i1, i2, j1, j2); inplacetranspose(b, i1, i2, j1, j2, x1); for(i = i1; i <= i2; i++) { for(j = j1; j <= j2; j++) { if( ap::fp_neq(a(i,j),b(i1+(j-j1),j1+(i-i1))) ) { was1 = true; } } } } iterrors = was1; // // testing copy and transpose // n = 10; a.setbounds(1, n, 1, n); b.setbounds(1, n, 1, n); for(i = 1; i <= n; i++) { for(j = 1; j <= n; j++) { a(i,j) = ap::randomreal(); } } passcount = 10000; was1 = false; for(pass = 1; pass <= passcount; pass++) { i1 = 1+ap::randominteger(n); i2 = i1+ap::randominteger(n-i1+1); j1 = 1+ap::randominteger(n); j2 = j1+ap::randominteger(n-j1+1); copyandtranspose(a, i1, i2, j1, j2, b, j1, j2, i1, i2); for(i = i1; i <= i2; i++) { for(j = j1; j <= j2; j++) { if( ap::fp_neq(a(i,j),b(j,i)) ) { was1 = true; } } } } cterrors = was1; // // Testing MatrixMatrixMultiply // n = 10; a.setbounds(1, 2*n, 1, 2*n); b.setbounds(1, 2*n, 1, 2*n); c1.setbounds(1, 2*n, 1, 2*n); c2.setbounds(1, 2*n, 1, 2*n); x1.setbounds(1, n); x2.setbounds(1, n); for(i = 1; i <= 2*n; i++) { for(j = 1; j <= 2*n; j++) { a(i,j) = ap::randomreal(); b(i,j) = ap::randomreal(); } } passcount = 1000; was1 = false; for(pass = 1; pass <= passcount; pass++) { for(i = 1; i <= 2*n; i++) { for(j = 1; j <= 2*n; j++) { c1(i,j) = 2.1*i+3.1*j; c2(i,j) = c1(i,j); } } l = 1+ap::randominteger(n); k = 1+ap::randominteger(n); r = 1+ap::randominteger(n); i1 = 1+ap::randominteger(n); j1 = 1+ap::randominteger(n); i2 = 1+ap::randominteger(n); j2 = 1+ap::randominteger(n); i3 = 1+ap::randominteger(n); j3 = 1+ap::randominteger(n); trans1 = ap::fp_greater(ap::randomreal(),0.5); trans2 = ap::fp_greater(ap::randomreal(),0.5); if( trans1 ) { col1 = l; row1 = k; } else { col1 = k; row1 = l; } if( trans2 ) { col2 = k; row2 = r; } else { col2 = r; row2 = k; } scl1 = ap::randomreal(); scl2 = ap::randomreal(); matrixmatrixmultiply(a, i1, i1+row1-1, j1, j1+col1-1, trans1, b, i2, i2+row2-1, j2, j2+col2-1, trans2, scl1, c1, i3, i3+l-1, j3, j3+r-1, scl2, x1); naivematrixmatrixmultiply(a, i1, i1+row1-1, j1, j1+col1-1, trans1, b, i2, i2+row2-1, j2, j2+col2-1, trans2, scl1, c2, i3, i3+l-1, j3, j3+r-1, scl2); err = 0; for(i = 1; i <= l; i++) { for(j = 1; j <= r; j++) { err = ap::maxreal(err, fabs(c1(i3+i-1,j3+j-1)-c2(i3+i-1,j3+j-1))); } } if( ap::fp_greater(err,threshold) ) { was1 = true; break; } } mmerrors = was1; // // report // waserrors = n2errors||amaxerrors||hsnerrors||mverrors||iterrors||cterrors||mmerrors; if( !silent ) { printf("TESTING BLAS\n"); printf("VectorNorm2: "); if( n2errors ) { printf("FAILED\n"); } else { printf("OK\n"); } printf("AbsMax (vector/row/column): "); if( amaxerrors ) { printf("FAILED\n"); } else { printf("OK\n"); } printf("UpperHessenberg1Norm: "); if( hsnerrors ) { printf("FAILED\n"); } else { printf("OK\n"); } printf("MatrixVectorMultiply: "); if( mverrors ) { printf("FAILED\n"); } else { printf("OK\n"); } printf("InplaceTranspose: "); if( iterrors ) { printf("FAILED\n"); } else { printf("OK\n"); } printf("CopyAndTranspose: "); if( cterrors ) { printf("FAILED\n"); } else { printf("OK\n"); } printf("MatrixMatrixMultiply: "); if( mmerrors ) { printf("FAILED\n"); } else { printf("OK\n"); } if( waserrors ) { printf("TEST FAILED\n"); } else { printf("TEST PASSED\n"); } printf("\n\n"); } result = !waserrors; return result; }
/************************************************************************* Singular value decomposition of a rectangular matrix. The algorithm calculates the singular value decomposition of a matrix of size MxN: A = U * S * V^T The algorithm finds the singular values and, optionally, matrices U and V^T. The algorithm can find both first min(M,N) columns of matrix U and rows of matrix V^T (singular vectors), and matrices U and V^T wholly (of sizes MxM and NxN respectively). Take into account that the subroutine does not return matrix V but V^T. Input parameters: A - matrix to be decomposed. Array whose indexes range within [0..M-1, 0..N-1]. M - number of rows in matrix A. N - number of columns in matrix A. UNeeded - 0, 1 or 2. See the description of the parameter U. VTNeeded - 0, 1 or 2. See the description of the parameter VT. AdditionalMemory - If the parameter: * equals 0, the algorithm doesn’t use additional memory (lower requirements, lower performance). * equals 1, the algorithm uses additional memory of size min(M,N)*min(M,N) of real numbers. It often speeds up the algorithm. * equals 2, the algorithm uses additional memory of size M*min(M,N) of real numbers. It allows to get a maximum performance. The recommended value of the parameter is 2. Output parameters: W - contains singular values in descending order. U - if UNeeded=0, U isn't changed, the left singular vectors are not calculated. if Uneeded=1, U contains left singular vectors (first min(M,N) columns of matrix U). Array whose indexes range within [0..M-1, 0..Min(M,N)-1]. if UNeeded=2, U contains matrix U wholly. Array whose indexes range within [0..M-1, 0..M-1]. VT - if VTNeeded=0, VT isn’t changed, the right singular vectors are not calculated. if VTNeeded=1, VT contains right singular vectors (first min(M,N) rows of matrix V^T). Array whose indexes range within [0..min(M,N)-1, 0..N-1]. if VTNeeded=2, VT contains matrix V^T wholly. Array whose indexes range within [0..N-1, 0..N-1]. -- ALGLIB -- Copyright 2005 by Bochkanov Sergey *************************************************************************/ bool rmatrixsvd(ap::real_2d_array a, int m, int n, int uneeded, int vtneeded, int additionalmemory, ap::real_1d_array& w, ap::real_2d_array& u, ap::real_2d_array& vt) { bool result; ap::real_1d_array tauq; ap::real_1d_array taup; ap::real_1d_array tau; ap::real_1d_array e; ap::real_1d_array work; ap::real_2d_array t2; bool isupper; int minmn; int ncu; int nrvt; int nru; int ncvt; int i; int j; result = true; if( m==0||n==0 ) { return result; } ap::ap_error::make_assertion(uneeded>=0&&uneeded<=2, "SVDDecomposition: wrong parameters!"); ap::ap_error::make_assertion(vtneeded>=0&&vtneeded<=2, "SVDDecomposition: wrong parameters!"); ap::ap_error::make_assertion(additionalmemory>=0&&additionalmemory<=2, "SVDDecomposition: wrong parameters!"); // // initialize // minmn = ap::minint(m, n); w.setbounds(1, minmn); ncu = 0; nru = 0; if( uneeded==1 ) { nru = m; ncu = minmn; u.setbounds(0, nru-1, 0, ncu-1); } if( uneeded==2 ) { nru = m; ncu = m; u.setbounds(0, nru-1, 0, ncu-1); } nrvt = 0; ncvt = 0; if( vtneeded==1 ) { nrvt = minmn; ncvt = n; vt.setbounds(0, nrvt-1, 0, ncvt-1); } if( vtneeded==2 ) { nrvt = n; ncvt = n; vt.setbounds(0, nrvt-1, 0, ncvt-1); } // // M much larger than N // Use bidiagonal reduction with QR-decomposition // if( ap::fp_greater(m,1.6*n) ) { if( uneeded==0 ) { // // No left singular vectors to be computed // rmatrixqr(a, m, n, tau); for(i = 0; i <= n-1; i++) { for(j = 0; j <= i-1; j++) { a(i,j) = 0; } } rmatrixbd(a, n, n, tauq, taup); rmatrixbdunpackpt(a, n, n, taup, nrvt, vt); rmatrixbdunpackdiagonals(a, n, n, isupper, w, e); result = rmatrixbdsvd(w, e, n, isupper, false, u, 0, a, 0, vt, ncvt); return result; } else { // // Left singular vectors (may be full matrix U) to be computed // rmatrixqr(a, m, n, tau); rmatrixqrunpackq(a, m, n, tau, ncu, u); for(i = 0; i <= n-1; i++) { for(j = 0; j <= i-1; j++) { a(i,j) = 0; } } rmatrixbd(a, n, n, tauq, taup); rmatrixbdunpackpt(a, n, n, taup, nrvt, vt); rmatrixbdunpackdiagonals(a, n, n, isupper, w, e); if( additionalmemory<1 ) { // // No additional memory can be used // rmatrixbdmultiplybyq(a, n, n, tauq, u, m, n, true, false); result = rmatrixbdsvd(w, e, n, isupper, false, u, m, a, 0, vt, ncvt); } else { // // Large U. Transforming intermediate matrix T2 // work.setbounds(1, ap::maxint(m, n)); rmatrixbdunpackq(a, n, n, tauq, n, t2); copymatrix(u, 0, m-1, 0, n-1, a, 0, m-1, 0, n-1); inplacetranspose(t2, 0, n-1, 0, n-1, work); result = rmatrixbdsvd(w, e, n, isupper, false, u, 0, t2, n, vt, ncvt); matrixmatrixmultiply(a, 0, m-1, 0, n-1, false, t2, 0, n-1, 0, n-1, true, 1.0, u, 0, m-1, 0, n-1, 0.0, work); } return result; } } // // N much larger than M // Use bidiagonal reduction with LQ-decomposition // if( ap::fp_greater(n,1.6*m) ) { if( vtneeded==0 ) { // // No right singular vectors to be computed // rmatrixlq(a, m, n, tau); for(i = 0; i <= m-1; i++) { for(j = i+1; j <= m-1; j++) { a(i,j) = 0; } } rmatrixbd(a, m, m, tauq, taup); rmatrixbdunpackq(a, m, m, tauq, ncu, u); rmatrixbdunpackdiagonals(a, m, m, isupper, w, e); work.setbounds(1, m); inplacetranspose(u, 0, nru-1, 0, ncu-1, work); result = rmatrixbdsvd(w, e, m, isupper, false, a, 0, u, nru, vt, 0); inplacetranspose(u, 0, nru-1, 0, ncu-1, work); return result; } else { // // Right singular vectors (may be full matrix VT) to be computed // rmatrixlq(a, m, n, tau); rmatrixlqunpackq(a, m, n, tau, nrvt, vt); for(i = 0; i <= m-1; i++) { for(j = i+1; j <= m-1; j++) { a(i,j) = 0; } } rmatrixbd(a, m, m, tauq, taup); rmatrixbdunpackq(a, m, m, tauq, ncu, u); rmatrixbdunpackdiagonals(a, m, m, isupper, w, e); work.setbounds(1, ap::maxint(m, n)); inplacetranspose(u, 0, nru-1, 0, ncu-1, work); if( additionalmemory<1 ) { // // No additional memory available // rmatrixbdmultiplybyp(a, m, m, taup, vt, m, n, false, true); result = rmatrixbdsvd(w, e, m, isupper, false, a, 0, u, nru, vt, n); } else { // // Large VT. Transforming intermediate matrix T2 // rmatrixbdunpackpt(a, m, m, taup, m, t2); result = rmatrixbdsvd(w, e, m, isupper, false, a, 0, u, nru, t2, m); copymatrix(vt, 0, m-1, 0, n-1, a, 0, m-1, 0, n-1); matrixmatrixmultiply(t2, 0, m-1, 0, m-1, false, a, 0, m-1, 0, n-1, false, 1.0, vt, 0, m-1, 0, n-1, 0.0, work); } inplacetranspose(u, 0, nru-1, 0, ncu-1, work); return result; } } // // M<=N // We can use inplace transposition of U to get rid of columnwise operations // if( m<=n ) { rmatrixbd(a, m, n, tauq, taup); rmatrixbdunpackq(a, m, n, tauq, ncu, u); rmatrixbdunpackpt(a, m, n, taup, nrvt, vt); rmatrixbdunpackdiagonals(a, m, n, isupper, w, e); work.setbounds(1, m); inplacetranspose(u, 0, nru-1, 0, ncu-1, work); result = rmatrixbdsvd(w, e, minmn, isupper, false, a, 0, u, nru, vt, ncvt); inplacetranspose(u, 0, nru-1, 0, ncu-1, work); return result; } // // Simple bidiagonal reduction // rmatrixbd(a, m, n, tauq, taup); rmatrixbdunpackq(a, m, n, tauq, ncu, u); rmatrixbdunpackpt(a, m, n, taup, nrvt, vt); rmatrixbdunpackdiagonals(a, m, n, isupper, w, e); if( additionalmemory<2||uneeded==0 ) { // // We cant use additional memory or there is no need in such operations // result = rmatrixbdsvd(w, e, minmn, isupper, false, u, nru, a, 0, vt, ncvt); } else { // // We can use additional memory // t2.setbounds(0, minmn-1, 0, m-1); copyandtranspose(u, 0, m-1, 0, minmn-1, t2, 0, minmn-1, 0, m-1); result = rmatrixbdsvd(w, e, minmn, isupper, false, u, 0, t2, m, vt, ncvt); copyandtranspose(t2, 0, minmn-1, 0, m-1, u, 0, m-1, 0, minmn-1); } return result; }
float* lup_solve(float** a, float* b, int size){ //решение через lup-разложение float** a1, *x, *y; int* p; int i, j; a1=array_initialize(size); copymatrix(a, a1, size); p=lup_decomposition(a1, size); y=forward_sub(a1, b, p, size); x=back_sub(a1, y, size); for (i = 0; i < size; i++){ for (j = 0; j < size; j++) { printf("%f ", a1[i][j]); } printf("\n"); } printf("\n\n"); printf("P \n"); for (i=0; i<size;i++){ printf("%d ", p[i]); } printf("\n"); printf("\n\nL\n\n"); for (i = 0; i < size; i++){ for (j = 0; j < size; j++) { if (i==j){ printf("1 "); } else if (i > j){ printf("%f ", a1[i][j]); } else { printf("0 "); } } printf("\n"); } printf("\n\n"); printf("\n\nU\n\n"); for (i = 0; i < size; i++){ for (j = 0; j < size; j++) { if (i <= j){ printf("%f ", a1[i][j]); } else { printf("0 "); } } printf("\n"); } printf("\n\n"); return x; }