int gen_plot_kmeans(data *raw, int n, data *plot, int attempts){ int *which; int i,j,k; double *work; extern double RunKMeansPlusPlus(int n, int k, int d, double *points, int attempts, double *centers, int *assignments); plot->n = n; plot->xy = (double*)malloc(sizeof(double)*4*n); plot->f = plot->xy + 2*n; which = (int*)malloc(sizeof(int)*raw->n); work = (double*)malloc(sizeof(double)*2*n); for(i = 0; i < 2*n; ++i){ work[i] = 0; plot->f[i] = 0; } RunKMeansPlusPlus(raw->n, n, 2, raw->xy, attempts, plot->xy, which); for(i = 0; i < raw->n; ++i){ int c = which[i]; double d = pythag2(plot->xy[2*c+0] - raw->xy[2*i+0], plot->xy[2*c+1] - raw->xy[2*i+1]); if(d > work[c]){ work[c] = d; } } for(i = 0; i < raw->n; ++i){ int c = which[i]; double d = pythag2(plot->xy[2*c+0] - raw->xy[2*i+0], plot->xy[2*c+1] - raw->xy[2*i+1]); if(0 == work[c]){ d = 1.0; }else{ d = 1.0 - d/work[c]; } plot->f[2*c+0] += d*raw->f[2*i+0]; plot->f[2*c+1] += d*raw->f[2*i+1]; work[n+c] += d; } plot->max_len = 0; for(i = 0; i < n; ++i){ if(work[n+i] > 0){ plot->f[2*i+0] /= work[n+i]; plot->f[2*i+1] /= work[n+i]; double d = pythag2(plot->f[2*i+0], plot->f[2*i+1]); if(d > plot->max_len){ plot->max_len = d; } if(plot->xy[2*i+0] < plot->bbox[0]){ plot->bbox[0] = plot->xy[2*i+0]; } if(plot->xy[2*i+0] > plot->bbox[1]){ plot->bbox[1] = plot->xy[2*i+0]; } if(plot->xy[2*i+1] < plot->bbox[2]){ plot->bbox[2] = plot->xy[2*i+1]; } if(plot->xy[2*i+1] > plot->bbox[3]){ plot->bbox[3] = plot->xy[2*i+1]; } } //fprintf(stderr, "%f %f %f %f\n", plot->xy[2*i+0], plot->xy[2*i+1], plot->f[2*i+0], plot->f[2*i+1]); } free(work); free(which); return 0; }
int data_cull_zeros(data *d, int n_arrows){ int i, c = 0; int ret = 0; int *flag = (int*)malloc(sizeof(int)*d->n); for(i = 0; i < d->n; ++i){ flag[i] = 0; if(pythag2(d->f[2*i+0], d->f[2*i+1]) < DBL_EPSILON*d->max_len){ flag[i] = 1; ++c; } } if(d->n - c <= n_arrows){ // Remove all the zeros c = 0; for(i = 0; i < d->n; ++i){ if(!flag[i] && c != i){ d->xy[2*c+0] = d->xy[2*i+0]; d->xy[2*c+1] = d->xy[2*i+1]; d->f[2*c+0] = d->f[2*i+0]; d->f[2*c+1] = d->f[2*i+1]; ++c; } } d->n = c; ret = 1; } free(flag); return ret; }
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; } }
static void aux2x2schur(double& a, double& b, double& c, double& d, double& rt1r, double& rt1i, double& rt2r, double& rt2i, double& cs, double& sn) { double multpl; double aa; double bb; double bcmax; double bcmis; double cc; double cs1; double dd; double eps; double p; double sab; double sac; double scl; double sigma; double sn1; double tau; double temp; double z; multpl = 4.0; eps = ap::machineepsilon; if( c==0 ) { cs = 1; sn = 0; } else { if( b==0 ) { // // Swap rows and columns // cs = 0; sn = 1; temp = d; d = a; a = temp; b = -c; c = 0; } else { if( a-d==0&&extschursigntoone(b)!=extschursigntoone(c) ) { cs = 1; sn = 0; } else { temp = a-d; p = 0.5*temp; bcmax = ap::maxreal(fabs(b), fabs(c)); bcmis = ap::minreal(fabs(b), fabs(c))*extschursigntoone(b)*extschursigntoone(c); scl = ap::maxreal(fabs(p), bcmax); z = p/scl*p+bcmax/scl*bcmis; // // If Z is of the order of the machine accuracy, postpone the // decision on the nature of eigenvalues // if( z>=multpl*eps ) { // // Real eigenvalues. Compute A and D. // z = p+extschursign(sqrt(scl)*sqrt(z), p); a = d+z; d = d-bcmax/z*bcmis; // // Compute B and the rotation matrix // tau = pythag2(c, z); cs = z/tau; sn = c/tau; b = b-c; c = 0; } else { // // Complex eigenvalues, or real (almost) equal eigenvalues. // Make diagonal elements equal. // sigma = b+c; tau = pythag2(sigma, temp); cs = sqrt(0.5*(1+fabs(sigma)/tau)); sn = -p/(tau*cs)*extschursign(double(1), sigma); // // Compute [ AA BB ] = [ A B ] [ CS -SN ] // [ CC DD ] [ C D ] [ SN CS ] // aa = a*cs+b*sn; bb = -a*sn+b*cs; cc = c*cs+d*sn; dd = -c*sn+d*cs; // // Compute [ A B ] = [ CS SN ] [ AA BB ] // [ C D ] [-SN CS ] [ CC DD ] // a = aa*cs+cc*sn; b = bb*cs+dd*sn; c = -aa*sn+cc*cs; d = -bb*sn+dd*cs; temp = 0.5*(a+d); a = temp; d = temp; if( c!=0 ) { if( b!=0 ) { if( extschursigntoone(b)==extschursigntoone(c) ) { // // Real eigenvalues: reduce to upper triangular form // sab = sqrt(fabs(b)); sac = sqrt(fabs(c)); p = extschursign(sab*sac, c); tau = 1/sqrt(fabs(b+c)); a = temp+p; d = temp-p; b = b-c; c = 0; cs1 = sab*tau; sn1 = sac*tau; temp = cs*cs1-sn*sn1; sn = cs*sn1+sn*cs1; cs = temp; } } else { b = -c; c = 0; temp = cs; cs = -sn; sn = temp; } } } } } } // // Store eigenvalues in (RT1R,RT1I) and (RT2R,RT2I). // rt1r = a; rt2r = d; if( c==0 ) { rt1i = 0; rt2i = 0; } else { rt1i = sqrt(fabs(b))*sqrt(fabs(c)); rt2i = -rt1i; } }
int data_read(data *d, const char *filename){ FILE *fp; int i; char line[1024]; int ncap = 256; int line_count = 0, count; double x, y, fx, fy, fa; double *temp; if(NULL == d){ return -1; } if(NULL == filename){ return -2; } d->n = 0; if(NULL != d->xy){ free(d->xy); } temp = (double*)malloc(sizeof(double)*4*ncap); fp = fopen(filename, "rt"); if(NULL == fp){ return -3; } while(fgets(line, sizeof(line), fp) != NULL){ ++line_count; if('#' == line[0]){ continue; } count = sscanf(line, "%lf %lf %lf %lf", &x, &y, &fx, &fy); if(0 < count && count < 4){ fprintf(stderr, "Expected 4 values on line %d but only got %d\n", line_count, count); goto error; } if(count < 1){ continue; } if(d->n >= ncap){ ncap *= 2; temp = (double*)realloc(temp, sizeof(double)*4*ncap); } temp[4*(d->n)+0] = x; temp[4*(d->n)+1] = y; temp[4*(d->n)+2] = fx; temp[4*(d->n)+3] = fy; d->n++; if(x < d->bbox[0]){ d->bbox[0] = x; } if(x > d->bbox[1]){ d->bbox[1] = x; } if(y < d->bbox[2]){ d->bbox[2] = y; } if(y > d->bbox[3]){ d->bbox[3] = y; } fa = pythag2(fx, fy); if(fa > d->max_len){ d->max_len = fa; } } // Enlarge bounding box slightly d->bbox[0] -= DBL_EPSILON*d->bbox[0]; d->bbox[1] += DBL_EPSILON*d->bbox[1]; d->bbox[2] -= DBL_EPSILON*d->bbox[2]; d->bbox[3] += DBL_EPSILON*d->bbox[3]; // Copy data into final arrays d->xy = (double*)malloc(sizeof(double)*4*d->n); d->f = d->xy + 2*d->n; for(i = 0; i < d->n; ++i){ d->xy[2*i+0] = temp[4*i+0]; d->xy[2*i+1] = temp[4*i+1]; d->f[2*i+0] = temp[4*i+2]; d->f[2*i+1] = temp[4*i+3]; } free(temp); error: fclose(fp); }
/* void get_ticks(double a, double b, double *tick, int nticks){ int m,b,p; if(a <= 0 && b >= 0){ // includes zero double m = (-a > b) ? -a : b; double t = round_to_nice(0.33*m, &m,&b,&p); }else{ double d = b-a; double avg = 0.5*(b+a); if(d < 0.01*avg){ }else{ double t = round_to_nice(0.25*m, &m,&b,&p); if(a >= 0){ // positive d = b-a; }else{ // negative } } } } */ int output_plot(data *plot){ FILE *f = stdout; int i, j; double norm; double p[2], q[2]; const double bbox[4] = { -3,3, // x range -3,3 // y range }; double scale[2] = {72, 72}; fprintf(f, "%f %f scale\n", scale[0], scale[1]); fprintf(f, "%f setlinewidth\n", 2./scale[0]); fprintf(f, "%f %f translate\n", 8.5*0.5*72/scale[0], 11*0.5*72/scale[1]); fprintf(f, "/arrow{\n" "gsave\n" "5 3 roll translate\n" "3 1 roll exch atan rotate\n" "dup scale\n" "\n" "newpath\n" "1.00 0.00 moveto\n" "0.62 0.19 lineto\n" "0.62 0.07 lineto\n" "0.00 0.07 lineto\n" "0.00 -0.07 lineto\n" "0.62 -0.07 lineto\n" "0.62 -0.19 lineto\n" "closepath stroke\n" "\n" "grestore\n" "} bind def\n"); // find closest pair of points double min_spacing = DBL_MAX; for(i = 0; i < plot->n; ++i){ for(j = i+1; j < plot->n; ++j){ double d = pythag2(plot->xy[2*i+0]-plot->xy[2*j+0], plot->xy[2*i+1]-plot->xy[2*j+1]); if(d < min_spacing){ min_spacing = d; } } } norm = min_spacing / plot->max_len; for(i = 0; i < plot->n; ++i){ double vec[2] = { plot->f[2*i+0] * norm, plot->f[2*i+1] * norm }; double base[2] = { plot->xy[2*i+0] - 0.5*vec[0], plot->xy[2*i+1] - 0.5*vec[1] }; map_bb_aff(plot->bbox, bbox, base); map_bb_lin(plot->bbox, bbox, vec); double len = pythag2(vec[0], vec[1]); if(len < 100*DBL_EPSILON){ continue; } fprintf(f, "%f %f %f %f %f arrow\n", base[0], base[1], vec[0], vec[1], len); } // Draw frame and axes p[0] = plot->bbox[0]; p[1] = plot->bbox[2]; q[0] = plot->bbox[1]; q[1] = plot->bbox[3]; map_bb_aff(plot->bbox, bbox, p); map_bb_aff(plot->bbox, bbox, q); fprintf(f, "newpath %f %f moveto %f %f lineto %f %f lineto %f %f lineto closepath stroke\n", p[0], p[1], q[0], p[1], q[0], q[1], p[0], q[1] ); /* // Draw ticks for(i = 0; i < 2; ++i){ // which dimension double ticks[8]; get_ticks(plot->bbox[2*i+0], plot->bbox[2*i+1], ticks, 8); } */ fprintf(f, "showpage\n"); return 0; }