示例#1
0
static void
rescaleLayout(v_data * graph, int n, double *x_coords, double *y_coords,
	      int interval, double distortion)
{
    // Rectlinear distortion - auxiliary function
    int i;
    double *densities = NULL, *smoothed_densities = NULL;
    double *copy_coords = N_NEW(n, double);
    int *ordering = N_NEW(n, int);
    double factor;

    //compute_densities(graph, n, x_coords, y_coords, densities);

    for (i = 0; i < n; i++) {
	ordering[i] = i;
    }

    // just to make milder behavior:
    if (distortion >= 0) {
	factor = sqrt(distortion);
    } else {
	factor = -sqrt(-distortion);
    }

    quicksort_place(x_coords, ordering, 0, n - 1);
    densities = recompute_densities(graph, n, x_coords, densities);
    smoothed_densities = smooth_vec(densities, ordering, n, interval, smoothed_densities);
    cpvec(copy_coords, 0, n - 1, x_coords);
    for (i = 1; i < n; i++) {
	x_coords[ordering[i]] =
	    x_coords[ordering[i - 1]] + (copy_coords[ordering[i]] -
					 copy_coords[ordering[i - 1]]) /
	    pow(smoothed_densities[ordering[i]], factor);
    }

    quicksort_place(y_coords, ordering, 0, n - 1);
    densities = recompute_densities(graph, n, y_coords, densities);
    smoothed_densities = smooth_vec(densities, ordering, n, interval, smoothed_densities);
    cpvec(copy_coords, 0, n - 1, y_coords);
    for (i = 1; i < n; i++) {
	y_coords[ordering[i]] =
	    y_coords[ordering[i - 1]] + (copy_coords[ordering[i]] -
					 copy_coords[ordering[i - 1]]) /
	    pow(smoothed_densities[ordering[i]], factor);
    }

    free(densities);
    free(smoothed_densities);
    free(copy_coords);
    free(ordering);
}
示例#2
0
double 
checkeig_ext (
    double *err,
    double *work,			/* work vector of length n */
    struct vtx_data **A,
    double *y,
    int n,
    double extval,
    double *vwsqrt,
    double *gvec,
    double eigtol,
    int warnings		/* don't want to see warning messages in one of the
				   contexts this is called */
)
{
    extern FILE *Output_File;	/* output file or null */
    extern int DEBUG_EVECS;	/* print debugging output? */
    extern int WARNING_EVECS;	/* print warning messages? */
    double    resid;		/* the extended eigen residual */
    double    ch_norm();		/* vector norm */
    void      splarax();	/* sparse matrix vector mult */
    void      scadd();		/* scaled vector add */
    void      scale_diag();	/* scale vector by another's elements */
    void      cpvec();		/* vector copy */

    splarax(err, A, n, y, vwsqrt, work);
    scadd(err, 1, n, -extval, y);
    cpvec(work, 1, n, gvec);	/* only need if going to re-use gvec */
    scale_diag(work, 1, n, vwsqrt);
    scadd(err, 1, n, -1.0, work);
    resid = ch_norm(err, 1, n);

    if (DEBUG_EVECS > 0) {
	printf("  extended residual: %g\n", resid);
	if (Output_File != NULL) {
	    fprintf(Output_File, "  extended residual: %g\n", resid);
	}
    }
    if (warnings && WARNING_EVECS > 0 && resid > eigtol) {
	printf("WARNING: Extended residual (%g) greater than tolerance (%g).\n",
	       resid, eigtol);
	if (Output_File != NULL) {
	    fprintf(Output_File,
		  "WARNING: Extended residual (%g) greater than tolerance (%g).\n",
		    resid, eigtol);
	}
    }

    return (resid);
}
示例#3
0
/* Finds eigenvector s of T and returns residual norm. */
double 
Tevec (
    double *alpha,		/* vector of Lanczos scalars */
    double *beta,			/* vector of Lanczos scalars */
    int j,			/* number of Lanczos iterations taken */
    double ritz,			/* approximate eigenvalue  of T */
    double *s			/* approximate eigenvector of T */
)
{
    extern double SRESTOL;      /* limit on relative residual tol for evec of T */
    extern double DOUBLE_MAX;	/* maximum double precision value */
    int       i;		/* index */
    double    residual=0.0;	/* how well recurrence gives eigenvector */
    double    temp;		/* used to compute residual */
    double   *work;		/* temporary work vector allocated within if used */
    double    w[MAXDIMS + 1];	/* holds eigenvalue for tinvit */
    long      index[MAXDIMS +1];/* index vector for tinvit */
    long      ierr;		/* error flag for tinvit */
    long      nevals;		/* number of evals sought */
    long      long_j;		/* long copy of j for tinvit interface */
    double    hurdle;		/* hurdle for local maximum in recurrence */
    double    prev_resid;	/* stores residual from previous computation */

    int       tinvit_();	/* eispack's tinvit for evecs of symmetric T */
    double   *mkvec();		/* allocates double vectors */
    void      frvec();		/* frees double vectors */
    double    bidir();		/* bidirectional recurrence for evec of T */
    void      cpvec();		/* vector copy routine */

	s[1] = 1.0;

	if (j == 1) {
	    residual = fabs(alpha[1] - ritz);
	}

	if (j >= 2) { 
	    /*Bidirectional recurrence - corrected and modified from Parlett and Reid, 
              "Tracking the Progress of the Lanczos Algorithm ..., IMA JNA 1, 1981 */
	    hurdle = 1.0;
	    residual = bidir(alpha,beta,j,ritz,s,hurdle);
	}

	if (residual > SRESTOL) {
	    /* Try again with Eispack's Tinvit iteration */
	    SRES_SWITCHES++;
	    index[1] = 1;
	    work = mkvec(1, 7*j);	/* lump things to save mallocs */
	    w[1] = ritz;
	    work[1] = 0;
	    for (i = 2; i <= j; i++) {
	        work[i] = beta[i] * beta[i];
	    }
	    nevals = 1;
	    long_j = j;

	    /* save the previously computed evec in case it's better */ 
	    cpvec(&(work[6*j]),1,j,s);
	    prev_resid = residual;

	    tinvit_(&long_j, &long_j, &(alpha[1]), &(beta[1]), &(work[1]), &nevals,
		&(w[1]), &(index[1]), &(s[1]), &ierr, &(work[j+1]), &(work[(2*j)+1]), 
	    	&(work[(3*j)+1]), &(work[(4*j)+1]), &(work[(5*j)+1]));

	    /* fix up sign if needed */
	    if (s[j] < 0) {
	        for(i=1; i<=j; i++) {
		    s[i] = - s[i];
	        }
	    }

	    if (ierr != 0) {
	        residual = DOUBLE_MAX;
	        /* ... don't want to use evec since it is set to zero */
	    }

	    else {
	        temp = (alpha[1] - ritz) * s[1] + beta[2] * s[2];
	        residual = temp * temp;
	        for (i = 2; i < j; i++) {
		    temp = beta[i] * s[i - 1] + (alpha[i] - ritz) * s[i] 
                         + beta[i + 1] * s[i + 1];
		    residual += temp * temp;
	        }
	        temp = beta[j] * s[j - 1] + (alpha[j] - ritz) * s[j];
	        residual += temp * temp;
	        residual = sqrt(residual);
	        /* tinvit normalizes, so we don't need to. */
	    }

	    /* restore previous evec if it had a better residual */
	    if (prev_resid < residual) {
	        residual = prev_resid;
	        cpvec(s,1,j,&(work[6*j]));
	    	SRES_SWITCHES++; /* count since switching back as well */
	    }

	    frvec(work, 1);
	}

    return (residual);
}
示例#4
0
bool
power_iteration(double **square_mat, int n, int neigs, double **eigs,
		double *evals, bool initialize)
{
    /* compute the 'neigs' top eigenvectors of 'square_mat' using power iteration */

    int i, j;
    double *tmp_vec = N_GNEW(n, double);
    double *last_vec = N_GNEW(n, double);
    double *curr_vector;
    double len;
    double angle;
    double alpha;
    int iteration = 0;
    int largest_index;
    double largest_eval;
    int Max_iterations = 30 * n;

    double tol = 1 - p_iteration_threshold;

    if (neigs >= n) {
	neigs = n;
    }

    for (i = 0; i < neigs; i++) {
	curr_vector = eigs[i];
	/* guess the i-th eigen vector */
      choose:
	if (initialize)
	    for (j = 0; j < n; j++)
		curr_vector[j] = rand() % 100;
	/* orthogonalize against higher eigenvectors */
	for (j = 0; j < i; j++) {
	    alpha = -dot(eigs[j], 0, n - 1, curr_vector);
	    scadd(curr_vector, 0, n - 1, alpha, eigs[j]);
	}
	len = norm(curr_vector, 0, n - 1);
	if (len < 1e-10) {
	    /* We have chosen a vector colinear with prvious ones */
	    goto choose;
	}
	vecscale(curr_vector, 0, n - 1, 1.0 / len, curr_vector);
	iteration = 0;
	do {
	    iteration++;
	    cpvec(last_vec, 0, n - 1, curr_vector);

	    right_mult_with_vector_d(square_mat, n, n, curr_vector,
				     tmp_vec);
	    cpvec(curr_vector, 0, n - 1, tmp_vec);

	    /* orthogonalize against higher eigenvectors */
	    for (j = 0; j < i; j++) {
		alpha = -dot(eigs[j], 0, n - 1, curr_vector);
		scadd(curr_vector, 0, n - 1, alpha, eigs[j]);
	    }
	    len = norm(curr_vector, 0, n - 1);
	    if (len < 1e-10 || iteration > Max_iterations) {
		/* We have reached the null space (e.vec. associated with e.val. 0) */
		goto exit;
	    }

	    vecscale(curr_vector, 0, n - 1, 1.0 / len, curr_vector);
	    angle = dot(curr_vector, 0, n - 1, last_vec);
	} while (fabs(angle) < tol);
	evals[i] = angle * len;	/* this is the Rayleigh quotient (up to errors due to orthogonalization):
				   u*(A*u)/||A*u||)*||A*u||, where u=last_vec, and ||u||=1
				 */
    }
  exit:
    for (; i < neigs; i++) {
	/* compute the smallest eigenvector, which are  */
	/* probably associated with eigenvalue 0 and for */
	/* which power-iteration is dangerous */
	curr_vector = eigs[i];
	/* guess the i-th eigen vector */
	for (j = 0; j < n; j++)
	    curr_vector[j] = rand() % 100;
	/* orthogonalize against higher eigenvectors */
	for (j = 0; j < i; j++) {
	    alpha = -dot(eigs[j], 0, n - 1, curr_vector);
	    scadd(curr_vector, 0, n - 1, alpha, eigs[j]);
	}
	len = norm(curr_vector, 0, n - 1);
	vecscale(curr_vector, 0, n - 1, 1.0 / len, curr_vector);
	evals[i] = 0;

    }


    /* sort vectors by their evals, for overcoming possible mis-convergence: */
    for (i = 0; i < neigs - 1; i++) {
	largest_index = i;
	largest_eval = evals[largest_index];
	for (j = i + 1; j < neigs; j++) {
	    if (largest_eval < evals[j]) {
		largest_index = j;
		largest_eval = evals[largest_index];
	    }
	}
	if (largest_index != i) {	/* exchange eigenvectors: */
	    cpvec(tmp_vec, 0, n - 1, eigs[i]);
	    cpvec(eigs[i], 0, n - 1, eigs[largest_index]);
	    cpvec(eigs[largest_index], 0, n - 1, tmp_vec);

	    evals[largest_index] = evals[i];
	    evals[i] = largest_eval;
	}
    }

    free(tmp_vec);
    free(last_vec);

    return (iteration <= Max_iterations);
}
void 
get_extval (
    double *alpha,	/* j-vector of Lanczos scalars (using elements 1 to j) */
    double *beta,		/* (j+1)-vector of " " (has 0 element but using 1 to j-1) */
    int j,		/* number of Lanczos iterations taken */
    double ritzval,	/* Ritz value */
    double *s,		/* Ritz vector (length n, re-computed in this routine) */
    double eigtol,	/* tolerance on eigenpair */
    double wnorm_g,	/* W-norm of n-vector g, the rhs in the extended eig. problem */
    double sigma,	/* the norm constraint on the extended eigenvector */
    double *extval,	/* the extended eigenvalue this routine computes */
    double *v,		/* the j-vector solving the extended eig problem in T */
    double *work1,	/* j-vector of workspace */
    double *work2	/* j-vector of workspace */
)
{
    extern int DEBUG_EVECS;	/* debug flag for eigen computation */
    double    lambda_low;	/* lower bound on extended eval */
    double    lambda_high;	/* upper bound on extended eval */
    double    tol;		/* bisection tolerance */
    double    norm_v;		/* norm of the extended T eigenvector v */
    double    lambda;		/* the parameter that iterates to extval */
    int       cnt;		/* debug iteration counter */
    double    diff;		/* distance between lambda limits */
    double    ch_norm(), Tevec();
    void      tri_solve(), cpvec();

    /* Compute the Ritz vector */
    Tevec(alpha, beta - 1, j, ritzval, s);

    /* Shouldn't happen, but just in case ... */
    if (wnorm_g == 0.0) {
	*extval = ritzval;
	cpvec(v, 1, j, s);
	if (DEBUG_EVECS > 0) {
	    printf("Degenerate extended eigenvector problem (g = 0).\n");
	}
	return;
	/* ... not really an extended eigenproblem; just return Ritz pair */
    }

    /* Set up the bisection parameters */
    lambda_low = ritzval - wnorm_g / sigma;
    lambda_high = ritzval - (wnorm_g / sigma) * s[1];
    lambda = 0.5 * (lambda_low + lambda_high);
    tol = eigtol * eigtol * (1 + fabs(lambda_low) + fabs(lambda_high));

    if (DEBUG_EVECS > 2) {
	printf("Computing extended eigenpairs of T\n");
	printf("  target norm_v (= sigma) %g\n", sigma);
	printf("  bisection tolerance %g\n", tol);
    }
    if (DEBUG_EVECS > 3) {
	printf("  lambda iterates to the extended eigenvalue\n");
	printf("         lambda_low           lambda            lambda_high      norm_v\n");
    }

    /* Bisection loop - iterate until norm constraint is satisfied */
    cnt = 1;
    diff = 2*tol;
    while (diff > tol) {
	lambda = 0.5 * (lambda_low + lambda_high);
	tri_solve(alpha, beta, j, lambda, v, wnorm_g, work1, work2);
	norm_v = ch_norm(v, 1, j);
	if (DEBUG_EVECS > 3) {
	    printf("%2i   %18.16f  %18.16f  %18.16f  %g\n",
		   cnt++, lambda_low, lambda, lambda_high, norm_v);
	}
	if (norm_v <= sigma)
	    lambda_low = lambda;
	if (norm_v >= sigma)
	    lambda_high = lambda;
        diff = lambda_high - lambda_low;
    }

    /* Return the extended eigenvalue (eigvec is automatically returned) */
    *extval = lambda;
}
示例#6
0
/* Finds needed eigenvalues of tridiagonal T using either the QL algorithm
   or Sturm sequence bisection, whichever is predicted to be faster based
   on a simple complexity model. If one fails (which is rare), the other
   is tried. The return value is 0 if one of the routines succeeds. If they
   both fail, the return value is 1, and Lanczos should compute the best
   approximation it can based on previous iterations. */
int get_ritzvals(double *alpha,         /* vector of Lanczos scalars */
                 double *beta,          /* vector of Lanczos scalars */
                 int     j,             /* number of Lanczos iterations taken */
                 double  Anorm,         /* Gershgorin estimate */
                 double *workj,         /* work vector for Sturm sequence */
                 double *ritz,          /* array holding evals */
                 int     d,             /* problem dimension = num. eigenpairs needed */
                 int     left_goodlim,  /* number of ritz pairs checked on left end */
                 int     right_goodlim, /* number of ritz pairs checked on right end */
                 double  eigtol,        /* tolerance on eigenpair */
                 double  bis_safety     /* bisection tolerance function divisor */
                 )
{
  extern int DEBUG_EVECS;     /* debug flag for eigen computation */
  extern int WARNING_EVECS;   /* warning flag for eigen computation */
  int        nvals_left;      /* numb. evals to find on left end of spectrum */
  int        nvals_right;     /* numb. evals to find on right end of spectrum */
  double     bisection_tol;   /* width of interval bisection should converge to */
  int        pred_steps;      /* predicts # of required bisection steps per eval */
  int        tot_pred_steps;  /* predicts total # of required bisection steps */
  double *   ritz_sav = NULL; /* copy of ritzvals for debugging */
  int        bisect_flag;     /* return status of bisect() */
  int        ql_flag;         /* return status of ql() */
  int        local_debug;     /* whether to check bisection results with ql */
  int        bisect();        /* locates eigvals using bisection on Sturm seq. */
  int        ql();            /* computes eigenvalues of T using eispack algorithm */
  void       shell_sort();    /* sorts vector of eigenvalues */
  double *   mkvec();         /* to allocate a vector */
  void       frvec();         /* free vector */
  void       cpvec();         /* vector copy */
  void       bail();          /* our exit routine */
  void       strout();        /* string out to screen and output file */

  /* Determine number of ritzvals to find on left and right ends */
  nvals_left  = max(d, left_goodlim);
  nvals_right = min(j - nvals_left, right_goodlim);

  /* Estimate work for bisection vs. ql assuming bisection takes 5j flops per
     step, ql takes 30j^2 flops per call. (Ignore sorts, copies, addressing.) */

  bisection_tol  = eigtol * eigtol / bis_safety;
  pred_steps     = (log10(Anorm / bisection_tol) / log10(2.0)) + 1;
  tot_pred_steps = (nvals_left + nvals_right) * pred_steps;

  bisect_flag = ql_flag = 0;

  if (5 * tot_pred_steps < 30 * j) {
    if (DEBUG_EVECS > 2)
      printf("  tridiagonal solver: bisection\n");

    /* Set local_debug = TRUE for a table checking bisection against QL. */
    local_debug = FALSE;
    if (local_debug) {
      ritz_sav = mkvec(1, j);
      cpvec(ritz_sav, 1, j, alpha);
      cpvec(workj, 0, j, beta);
      ql_flag = ql(ritz_sav, workj, j);
      if (ql_flag != 0) {
        bail("Aborting debugging procedure in get_ritzvals().\n", 1);
      }
      shell_sort(j, &ritz_sav[1]);
    }

    bisect_flag = bisect(alpha, beta, j, Anorm, workj, ritz, nvals_left, nvals_right, bisection_tol,
                         ritz_sav, pred_steps + 10);

    if (local_debug)
      frvec(ritz_sav, 1);
  }

  else {
    if (DEBUG_EVECS > 2)
      printf("  tridiagonal solver: ql\n");
    cpvec(ritz, 1, j, alpha);
    cpvec(workj, 0, j, beta);
    ql_flag = ql(ritz, workj, j);
    shell_sort(j, &ritz[1]);
  }

  if (bisect_flag != 0 && ql_flag == 0) {
    if (DEBUG_EVECS > 0 || WARNING_EVECS > 0) {
      strout("WARNING: Sturm bisection of T failed; switching to QL.\n");
    }
    if (DEBUG_EVECS > 1 || WARNING_EVECS > 1) {
      if (bisect_flag == 1)
        strout("         - failure detected in sturmcnt().\n");
      if (bisect_flag == 2)
        strout("         - maximum number of bisection steps reached.\n");
    }
    cpvec(ritz, 1, j, alpha);
    cpvec(workj, 0, j, beta);
    ql_flag = ql(ritz, workj, j);
    shell_sort(j, &ritz[1]);
  }

  if (ql_flag != 0 && bisect_flag == 0) {
    if (DEBUG_EVECS > 0 || WARNING_EVECS > 0) {
      strout("WARNING: QL failed for T; switching to Sturm bisection.\n");
    }
    bisect_flag = bisect(alpha, beta, j, Anorm, workj, ritz, nvals_left, nvals_right, bisection_tol,
                         ritz_sav, pred_steps + 3);
  }

  if (bisect_flag != 0 && ql_flag != 0) {
    if (DEBUG_EVECS > 0 || WARNING_EVECS > 0) {
      return (1); /* can't recover; bail out with error code */
    }
  }

  return (0); /* ... things seem ok. */
}
int main(int argc, char **argv){
	srand(time(NULL));
	struct timeval start, finish;

	int32_t (* scorefuncs[numtested + numrandom])(const Board & board);
/*
//generate the scoring functions
//manually loop unroll since the c++ compilers don't do this early enough, and template magic is hard/unreadable
	for(int i = 0; i < numtested + numrandom; i++)
		scorefuncs[i] = &(getscore<i>);
*/
	scorefuncs[0] = &(getscore<0>);
	scorefuncs[1] = &(getscore<1>);
	scorefuncs[2] = &(getscore<2>);
	scorefuncs[3] = &(getscore<3>);
	scorefuncs[4] = &(getscore<4>);
	scorefuncs[5] = &(getscore<5>);
	scorefuncs[6] = &(getscore<6>);
	scorefuncs[7] = &(getscore<7>);
	scorefuncs[8] = &(getscore<8>);
	scorefuncs[9] = &(getscore<9>);
	scorefuncs[10] = &(getscore<10>);
	scorefuncs[11] = &(getscore<11>);
	scorefuncs[12] = &(getscore<12>);
	scorefuncs[13] = &(getscore<13>);
	scorefuncs[14] = &(getscore<14>);
	scorefuncs[15] = &(getscore<15>);
	scorefuncs[16] = &(getscore<16>);
	scorefuncs[17] = &(getscore<17>);
	scorefuncs[18] = &(getscore<18>);
	scorefuncs[19] = &(getscore<19>);
	scorefuncs[20] = &(getscore<20>);
	scorefuncs[21] = &(getscore<21>);
	scorefuncs[22] = &(getscore<22>);
	scorefuncs[23] = &(getscore<23>);
	scorefuncs[24] = &(getscore<24>);
	scorefuncs[25] = &(getscore<25>);
	scorefuncs[26] = &(getscore<26>);
	scorefuncs[27] = &(getscore<27>);

	int32_t init_map[numtested][7] = {
		{0, 3, 8, 23, 61, 100000000, 100000000},
		{0, 3, 6, 12, 24, 100000000, 100000000},
		{0, 3, 9, 27, 81, 100000000, 100000000},
		{0, 3, 10, 31, 95, 100000000, 100000000},
		{0, 3, 11, 37, 129, 100000000, 100000000},
		{0, 3, 12, 48, 192, 100000000, 100000000},
		{0, 3, 13, 59, 265, 100000000, 100000000},
		{0, 3, 15, 75, 375, 100000000, 100000000},
	};

//copy over the initial set	
	for(int i = 0; i < numtested; i++){
		cpvec(players[i].map, init_map[i]);
		players[i].result = 1; //initial weighting
		players[i].generation = 0;
	}

	for(int i = numtested; i < numtested + numrandom; i++)
		cpvec(players[i].map, init_map[0]);

//main loop
	for(int a = 0; a < numgenerations; a++){

	//generate random players based on the previous best tested player
		for(int i = numtested; i < numtested + numrandom; i++){
			cpvec(players[i].map, players[0].map);
			for(int j = 2; j < 5; j++){
				do{
					players[i].map[j] += rand()%(2*j + 1) - j;
				}while(players[i].map[j] <= players[i].map[j-1]);
			}
			players[i].generation = a+1;
		}


	//initialize the players
		for(int i = 0; i < numtested + numrandom; i++){
			players[i].player = new PlayerNegamax3(2, scorefuncs[i]);
			players[i].result = 0;
			players[i].games = 0;
		}

		int num_games = numtested*numrandom*2*numrounds;

		printf("Generation %i of %i:\n", a+1, numgenerations);
		printf("Playing a tournament of %i rounds (%i games) between:\n", numrounds, num_games);
		for(int i = 0; i < numtested + numrandom; i++){
			printf("%2i:", i+1);
			for(int j = 1; j < 5; j++)
				printf("%4i", players[i].map[j]);
			printf(" (%2i)\n", players[i].generation);
		}

		gettimeofday(&start, NULL);

		int result;
		int b = 0;
		for(int a = 0; a < numrounds; a++){
			for(int i = 0; i < numtested; i++){
				for(int j = numtested; j < numrandom+numtested; j++){
					printf("Playing game %i: round %i, player %i vs player %i   \r", ++b, a+1, i+1, j+1); fflush(0);
					result = run_game(players[i].player, players[j].player);

					switch(result){
						case 1: players[i].result++; players[j].result--; break;
						case 2: players[i].result--; players[j].result++; break;
					}

					printf("Playing game %i: round %i, player %i vs player %i   \r", ++b, a+1, j+1, i+1); fflush(0);
					result = run_game(players[j].player, players[i].player);

					switch(result){
						case 1: players[j].result--; players[i].result++; break;
						case 2: players[j].result++; players[i].result--; break;
					}
					players[i].games += 2;
					players[j].games += 2;
				}
			}
		}

		gettimeofday(&finish, NULL);
		int runtime = ((finish.tv_sec*1000+finish.tv_usec/1000)-(start.tv_sec*1000+start.tv_usec/1000));

	//sort the players according to their results
		qsort(players, numtested, sizeof(GenPlayer), cmp_players);             //sort the tested ones
		qsort(players + numtested, numrandom, sizeof(GenPlayer), cmp_players); //sort the random ones

	//output the results
		printf("Results:                                                                       \n");
		for(int i = 0; i < numtested + numrandom; i++){
			printf("%2i:", i+1);
			for(int j = 1; j < 5; j++)
				printf("%4i", players[i].map[j]);
			printf(" (%2i) -> %4i /%4i  : ", players[i].generation, players[i].result, players[i].games);
			players[i].player->print_total_stats();
		}
		printf("Played %i games, Total Time: %i s, Average Time: %.2f s\n", num_games, runtime/1000, 1.0*runtime/(1000*num_games));
		printf("-------------------------------------------\n");

	//replace the worst tested with the best random
		for(int i = 0; i < numpromote; i++)
			players[numtested - 1 - i] = players[numtested + i];


	//cleanup
//segfaults for some reason, leak a bit of memory instead of segfaulting
//		for(int i = 0; i < numtested + numrandom; i++)
//			delete players[i].player;
	}

	return 0;
}
示例#8
0
文件: cgs.c 项目: tsukud-y/estiva
int estiva_cgssolver(void *Apointer, double *x, double *b)
{
    static double *dd, *p, *phat, *q, *qhat, *r, *rtld, *tmp, *u, *uhat, *vhat;
    MX *A;
    double alpha, beta, bnrm2, rho, rho1=1.0;
    long   itr, n;

    A = Apointer;
    n = A->n;
    ILUdecomp(A);

    setveclength(n+1);
    if ( defop("-adjust") ) {
        setveclength(n);
        b=&b[1];
        x=&x[1];
    }
    ary1(r    ,n+1);
    ary1(rtld ,n+1);
    ary1(p    ,n+1);
    ary1(phat ,n+1);
    ary1(q    ,n+1);
    ary1(qhat ,n+1);
    ary1(u    ,n+1);
    ary1(uhat ,n+1);
    ary1(vhat ,n+1);
    ary1(tmp  ,n+1);
    ary1(dd,   n+1);

    cpvec(b,x);
    cpvec(b, r);
    if ( L2(x) != 0.0 ) {
        matvecvec(A,-1.0, x, 1.0, r);
        if (L2(r) <= 1.0e-7) return 0;
    }
    bnrm2 = L2(b);
    if (bnrm2 == 0.0) bnrm2 = 1.0;
    cpvec(r, rtld);

    for (itr = 1; itr < n;  itr++) {
        rho = dotvec(rtld,r);
        if (fabs(rho) < 1.2e-31) break;
        if ( itr == 1 ) {
            cpvec(r,u);
            cpvec(u,p);
        } else {
            beta = rho / rho1;
            addformula( u, '=', r, '+', beta, q);
            addformula( p, '=', u, '+', beta, addformula( tmp, '=',q,'+',beta,p));
        }
        cpvec(p,phat);
        psolvevec(A,phat);
        matvecvec(A,1.0, phat, 0.0, vhat );

        alpha = rho / dotvec(rtld, vhat);
        addformula( q, '=', u, '-', alpha, vhat);
        cpvec(addformula(phat, '=', u, '+', 1.0, q),uhat);
        psolvevec(A,uhat);

        addformula(x, '=', x, '+', alpha, uhat);

        matvecvec(A,1.0, uhat, 0.0, qhat );
        addformula(r, '=', r, '-',alpha,qhat);

        if ( L2(r) / bnrm2 <= epsilon() && stopcondition(A,x,b) )
            return success(itr);
        rho1 = rho;
    }
    return 1;
}
示例#9
0
void
rescale_layout_polar(double *x_coords, double *y_coords,
		     double *x_foci, double *y_foci, int num_foci,
		     int n, int interval, double width,
		     double height, double margin, double distortion)
{
    // Polar distortion - main function
    int i;
    double minX, maxX, minY, maxY;
    double aspect_ratio;
    v_data *graph;
    double scaleX;
    double scale_ratio;

    width -= 2 * margin;
    height -= 2 * margin;

    // compute original aspect ratio
    minX = maxX = x_coords[0];
    minY = maxY = y_coords[0];
    for (i = 1; i < n; i++) 
	{
		if (x_coords[i] < minX)
		    minX = x_coords[i];
		if (y_coords[i] < minY)
			minY = y_coords[i];
		if (x_coords[i] > maxX)
			maxX = x_coords[i];
		if (y_coords[i] > maxY)
			maxY = y_coords[i];
    }
    aspect_ratio = (maxX - minX) / (maxY - minY);

    // construct mutual neighborhood graph
    graph = UG_graph(x_coords, y_coords, n, 0);

    if (num_foci == 1) 
	{	// accelerate execution of most common case
		rescale_layout_polarFocus(graph, n, x_coords, y_coords, x_foci[0],
				  y_foci[0], interval, distortion);
    } else
	{
	// average-based rescale
	double *final_x_coords = N_NEW(n, double);
	double *final_y_coords = N_NEW(n, double);
	double *cp_x_coords = N_NEW(n, double);
	double *cp_y_coords = N_NEW(n, double);
	for (i = 0; i < n; i++) {
	    final_x_coords[i] = final_y_coords[i] = 0;
	}
	for (i = 0; i < num_foci; i++) {
	    cpvec(cp_x_coords, 0, n - 1, x_coords);
	    cpvec(cp_y_coords, 0, n - 1, y_coords);
	    rescale_layout_polarFocus(graph, n, cp_x_coords, cp_y_coords,
				      x_foci[i], y_foci[i], interval, distortion);
	    scadd(final_x_coords, 0, n - 1, 1.0 / num_foci, cp_x_coords);
	    scadd(final_y_coords, 0, n - 1, 1.0 / num_foci, cp_y_coords);
	}
	cpvec(x_coords, 0, n - 1, final_x_coords);
	cpvec(y_coords, 0, n - 1, final_y_coords);
	free(final_x_coords);
	free(final_y_coords);
	free(cp_x_coords);
	free(cp_y_coords);
    }
    free(graph[0].edges);
    free(graph);

    minX = maxX = x_coords[0];
    minY = maxY = y_coords[0];
    for (i = 1; i < n; i++) {
	if (x_coords[i] < minX)
	    minX = x_coords[i];
	if (y_coords[i] < minY)
	    minY = y_coords[i];
	if (x_coords[i] > maxX)
	    maxX = x_coords[i];
	if (y_coords[i] > maxY)
	    maxY = y_coords[i];
    }

    // shift points:
    for (i = 0; i < n; i++) {
	x_coords[i] -= minX;
	y_coords[i] -= minY;
    }

    // rescale x_coords to maintain aspect ratio:
    scaleX = aspect_ratio * (maxY - minY) / (maxX - minX);
    for (i = 0; i < n; i++) {
	x_coords[i] *= scaleX;
    }


    // scale the layout to fit full drawing area:
    scale_ratio =
	MIN((width) / (aspect_ratio * (maxY - minY)),
	    (height) / (maxY - minY));
    for (i = 0; i < n; i++) {
	x_coords[i] *= scale_ratio;
	y_coords[i] *= scale_ratio;
    }

    for (i = 0; i < n; i++) {
	x_coords[i] += margin;
	y_coords[i] += margin;
    }
}
示例#10
0
static void
rescale_layout_polarFocus(v_data * graph, int n,
	  double *x_coords, double *y_coords,
	  double x_focus, double y_focus, int interval, double distortion)
{
    // Polar distortion - auxiliary function
    int i;
    double *densities = NULL, *smoothed_densities = NULL;
    double *distances = N_NEW(n, double);
    double *orig_distances = N_NEW(n, double);
    int *ordering;
    double ratio;

    for (i = 0; i < n; i++) 
	{
		distances[i] = DIST(x_coords[i], y_coords[i], x_focus, y_focus);
    }
    cpvec(orig_distances, 0, n - 1, distances);

    ordering = N_NEW(n, int);
    for (i = 0; i < n; i++) 
	{
		ordering[i] = i;
    }
    quicksort_place(distances, ordering, 0, n - 1);

    densities = compute_densities(graph, n, x_coords, y_coords);
    smoothed_densities = smooth_vec(densities, ordering, n, interval, smoothed_densities);

    // rescale distances
    if (distortion < 1.01 && distortion > 0.99) 
	{
		for (i = 1; i < n; i++) 
		{
			distances[ordering[i]] =	distances[ordering[i - 1]] + (orig_distances[ordering[i]] -
					      orig_distances[ordering
							     [i -
							      1]]) / smoothed_densities[ordering[i]];
		}
    } else 
	{
		double factor;
		// just to make milder behavior:
		if (distortion >= 0) 
		{
			factor = sqrt(distortion);
		} 
		else 
		{
			factor = -sqrt(-distortion);
		}
		for (i = 1; i < n; i++) 
		{
			distances[ordering[i]] =
				distances[ordering[i - 1]] + (orig_distances[ordering[i]] -
					      orig_distances[ordering
							     [i -
							      1]]) /
			pow(smoothed_densities[ordering[i]], factor);
		}
    }

    // compute new coordinate:
    for (i = 0; i < n; i++) 
	{
		if (orig_distances[i] == 0) 
		{
			ratio = 0;
		} 
		else 
		{
			ratio = distances[i] / orig_distances[i];
		}
		x_coords[i] = x_focus + (x_coords[i] - x_focus) * ratio;
		y_coords[i] = y_focus + (y_coords[i] - y_focus) * ratio;
    }

    free(densities);
    free(smoothed_densities);
    free(distances);
    free(orig_distances);
    free(ordering);
}
示例#11
0
int lanczos_ext(struct vtx_data **A,       /* sparse matrix in row linked list format */
                int               n,       /* problem size */
                int               d,       /* problem dimension = number of eigvecs to find */
                double **         y,       /* columns of y are eigenvectors of A  */
                double            eigtol,  /* tolerance on eigenvectors */
                double *          vwsqrt,  /* square roots of vertex weights */
                double            maxdeg,  /* maximum degree of graph */
                int               version, /* flags which version of sel. orth. to use */
                double *          gvec,    /* the rhs n-vector in the extended eigen problem */
                double            sigma    /* specifies the norm constraint on extended
                                              eigenvector */
                )
{
  extern FILE *     Output_File;         /* output file or null */
  extern int        LANCZOS_SO_INTERVAL; /* interval between orthogonalizations */
  extern int        LANCZOS_MAXITNS;     /* maximum Lanczos iterations allowed */
  extern int        DEBUG_EVECS;         /* print debugging output? */
  extern int        DEBUG_TRACE;         /* trace main execution path */
  extern int        WARNING_EVECS;       /* print warning messages? */
  extern double     BISECTION_SAFETY;    /* safety for T bisection algorithm */
  extern double     SRESTOL;             /* resid tol for T evec comp */
  extern double     DOUBLE_EPSILON;      /* machine precision */
  extern double     DOUBLE_MAX;          /* largest double value */
  extern double     splarax_time;        /* time matvec */
  extern double     orthog_time;         /* time orthogonalization work */
  extern double     evec_time;           /* time to generate eigenvectors */
  extern double     ql_time;             /* time tridiagonal eigenvalue work */
  extern double     blas_time;           /* time for blas. linear algebra */
  extern double     init_time;           /* time to allocate, intialize variables */
  extern double     scan_time;           /* time for scanning eval and bound lists */
  extern double     debug_time;          /* time for (some of) debug computations */
  extern double     ritz_time;           /* time to generate ritz vectors */
  extern double     pause_time;          /* time to compute whether to pause */
  int               i, j, k;             /* indicies */
  int               maxj;                /* maximum number of Lanczos iterations */
  double *          u, *r;               /* Lanczos vectors */
  double *          alpha, *beta;        /* the Lanczos scalars from each step */
  double *          ritz;                /* copy of alpha for ql */
  double *          workj;               /* work vector, e.g. copy of beta for ql */
  double *          workn;               /* work vector, e.g. product Av for checkeig */
  double *          s;                   /* eigenvector of T */
  double **         q;                   /* columns of q are Lanczos basis vectors */
  double *          bj;                  /* beta(j)*(last el. of corr. eigvec s of T) */
  double            Sres;                /* how well Tevec calculated eigvec s */
  double            Sres_max;            /* Max value of Sres */
  int               inc_bis_safety;      /* has Sres increased? */
  double *          Ares;                /* how well Lanczos calc. eigpair lambda,y */
  int *             index;               /* the Ritz index of an eigenpair */
  struct orthlink **solist;              /* vec. of structs with vecs. to orthog. against */
  struct scanlink * scanlist;            /* linked list of fields to do with min ritz vals */
  struct scanlink * curlnk;              /* for traversing the scanlist */
  double            bis_safety;          /* real safety for T bisection algorithm */
  int               converged;           /* has the iteration converged? */
  double            goodtol;             /* error tolerance for a good Ritz vector */
  int               ngood;               /* total number of good Ritz pairs at current step */
  int               maxngood;            /* biggest val of ngood through current step */
  int               left_ngood;          /* number of good Ritz pairs on left end */
  int               lastpause;           /* Most recent step with good ritz vecs */
  int               nopauses;            /* Have there been any pauses? */
  int               interval;            /* number of steps between pauses */
  double            time;                /* Current clock time */
  int               left_goodlim;        /* number of ritz pairs checked on left end */
  double            Anorm;               /* Norm estimate of the Laplacian matrix */
  int               pausemode;           /* which Lanczos pausing criterion to use */
  int               pause;               /* whether to pause */
  int               temp;                /* used to prevent redundant index computations */
  double *          extvec;              /* n-vector solving the extended A eigenproblem */
  double *          v;                   /* j-vector solving the extended T eigenproblem */
  double            extval = 0.0;        /* computed extended eigenvalue (of both A and T) */
  double *          work1, *work2;       /* work vectors */
  double            check;               /* to check an orthogonality condition */
  double            numerical_zero;      /* used for zero in presense of round-off  */
  int               ritzval_flag;        /* status flag for get_ritzvals() */
  int               memory_ok;           /* TRUE until memory runs out */

  double *         mkvec();        /* allocates space for a vector */
  double *         mkvec_ret();    /* mkvec() which returns error code */
  double           dot();          /* standard dot product routine */
  struct orthlink *makeorthlnk();  /* makes space for new entry in orthog. set */
  double           ch_norm();      /* vector norm */
  double           Tevec();        /* calc eigenvector of T by linear recurrence */
  struct scanlink *mkscanlist();   /* init scan list for min ritz vecs */
  double           lanc_seconds(); /* switcheable timer */
                                   /* free allocated memory safely */
  int    lanpause();               /* figure when to pause Lanczos iteration */
  int    get_ritzvals();           /* compute eigenvalues of T */
  void   setvec();                 /* initialize a vector */
  void   vecscale();               /* scale a vector */
  void   splarax();                /* matrix vector multiply */
  void   update();                 /* add scalar multiple of a vector to another */
  void   sorthog();                /* orthogonalize vector against list of others */
  void   bail();                   /* our exit routine */
  void   scanmin();                /* store small values of vector in linked list */
  void   frvec();                  /* free vector */
  void   scadd();                  /* add scalar multiple of vector to another */
  void   cpvec();                  /* copy a vector */
  void   orthog1();                /* efficiently orthog. against vector of ones */
  void   solistout();              /* print out orthogonalization list */
  void   doubleout();              /* print a double precision number */
  void   orthogvec();              /* orthogonalize one vector against another */
  void   get_extval();             /* find extended Ritz values */
  void   scale_diag();             /* scale vector by diagonal matrix */
  void   strout();                 /* print string to screen and file */
  double checkeig_ext();           /* check extended eigenpair residual directly */

  if (DEBUG_TRACE > 0) {
    printf("<Entering lanczos_ext>\n");
  }

  if (DEBUG_EVECS > 0) {
    printf("Selective orthogonalization Lanczos for extended eigenproblem, matrix size = %d.\n", n);
  }

  /* Initialize time. */
  time = lanc_seconds();

  if (d != 1) {
    bail("ERROR: Extended Lanczos only available for bisection.", 1);
    /* ... something must be wrong upstream. */
  }

  if (n < d + 1) {
    bail("ERROR: System too small for number of eigenvalues requested.", 1);
    /* ... d+1 since don't use zero eigenvalue pair */
  }

  /* Allocate space. */
  maxj     = LANCZOS_MAXITNS;
  u        = mkvec(1, n);
  r        = mkvec(1, n);
  workn    = mkvec(1, n);
  Ares     = mkvec(0, d);
  index    = smalloc((d + 1) * sizeof(int));
  alpha    = mkvec(1, maxj);
  beta     = mkvec(0, maxj);
  ritz     = mkvec(1, maxj);
  s        = mkvec(1, maxj);
  bj       = mkvec(1, maxj);
  workj    = mkvec(0, maxj);
  q        = smalloc((maxj + 1) * sizeof(double *));
  solist   = smalloc((maxj + 1) * sizeof(struct orthlink *));
  scanlist = mkscanlist(d);
  extvec   = mkvec(1, n);
  v        = mkvec(1, maxj);
  work1    = mkvec(1, maxj);
  work2    = mkvec(1, maxj);

  /* Set some constants governing orthogonalization */
  ngood          = 0;
  maxngood       = 0;
  Anorm          = 2 * maxdeg;                   /* Gershgorin estimate for ||A|| */
  goodtol        = Anorm * sqrt(DOUBLE_EPSILON); /* Parlett & Scott's bound, p.224 */
  interval       = 2 + (int)min(LANCZOS_SO_INTERVAL - 2, n / (2 * LANCZOS_SO_INTERVAL));
  bis_safety     = BISECTION_SAFETY;
  numerical_zero = 1.0e-13;

  if (DEBUG_EVECS > 0) {
    printf("  maxdeg %g\n", maxdeg);
    printf("  goodtol %g\n", goodtol);
    printf("  interval %d\n", interval);
    printf("  maxj %d\n", maxj);
  }

  /* Initialize space. */
  cpvec(r, 1, n, gvec);
  if (vwsqrt != NULL) {
    scale_diag(r, 1, n, vwsqrt);
  }
  check = ch_norm(r, 1, n);
  if (vwsqrt == NULL) {
    orthog1(r, 1, n);
  }
  else {
    orthogvec(r, 1, n, vwsqrt);
  }
  check = fabs(check - ch_norm(r, 1, n));
  if (check > 10 * numerical_zero && WARNING_EVECS > 0) {
    strout("WARNING: In terminal propagation, rhs should have no component in the");
    printf("         nullspace of the Laplacian, so check val %g should be negligible.\n", check);
    if (Output_File != NULL) {
      fprintf(Output_File,
              "         nullspace of the Laplacian, so check val %g should be negligible.\n",
              check);
    }
  }
  beta[0] = ch_norm(r, 1, n);
  q[0]    = mkvec(1, n);
  setvec(q[0], 1, n, 0.0);
  setvec(bj, 1, maxj, DOUBLE_MAX);

  if (beta[0] < numerical_zero) {
    /* The rhs vector, Dg, of the transformed problem is numerically zero or is
       in the null space of the Laplacian, so this is not a well posed extended
       eigenproblem. Set maxj to zero to force a quick exit but still clean-up
       memory and return(1) to indicate to eigensolve that it should call the
       default eigensolver routine for the standard eigenproblem. */
    maxj = 0;
  }

  /* Main Lanczos loop. */
  j              = 1;
  lastpause      = 0;
  pausemode      = 1;
  left_ngood     = 0;
  left_goodlim   = 0;
  converged      = FALSE;
  Sres_max       = 0.0;
  inc_bis_safety = FALSE;
  nopauses       = TRUE;
  memory_ok      = TRUE;
  init_time += lanc_seconds() - time;
  while ((j <= maxj) && (!converged) && memory_ok) {
    time = lanc_seconds();

    /* Allocate next Lanczos vector. If fail, back up to last pause. */
    q[j] = mkvec_ret(1, n);
    if (q[j] == NULL) {
      memory_ok = FALSE;
      if (DEBUG_EVECS > 0 || WARNING_EVECS > 0) {
        strout("WARNING: Lanczos_ext out of memory; computing best approximation available.\n");
      }
      if (nopauses) {
        bail("ERROR: Sorry, can't salvage Lanczos_ext.", 1);
        /* ... save yourselves, men.  */
      }
      for (i = lastpause + 1; i <= j - 1; i++) {
        frvec(q[i], 1);
      }
      j = lastpause;
    }

    /* Basic Lanczos iteration */
    vecscale(q[j], 1, n, 1.0 / beta[j - 1], r);
    blas_time += lanc_seconds() - time;
    time = lanc_seconds();
    splarax(u, A, n, q[j], vwsqrt, workn);
    splarax_time += lanc_seconds() - time;
    time = lanc_seconds();
    update(r, 1, n, u, -beta[j - 1], q[j - 1]);
    alpha[j] = dot(r, 1, n, q[j]);
    update(r, 1, n, r, -alpha[j], q[j]);
    blas_time += lanc_seconds() - time;

    /* Selective orthogonalization */
    time = lanc_seconds();
    if (vwsqrt == NULL) {
      orthog1(r, 1, n);
    }
    else {
      orthogvec(r, 1, n, vwsqrt);
    }
    if ((j == (lastpause + 1)) || (j == (lastpause + 2))) {
      sorthog(r, n, solist, ngood);
    }
    orthog_time += lanc_seconds() - time;
    beta[j] = ch_norm(r, 1, n);
    time    = lanc_seconds();
    pause   = lanpause(j, lastpause, interval, q, n, &pausemode, version, beta[j]);
    pause_time += lanc_seconds() - time;
    if (pause) {
      nopauses  = FALSE;
      lastpause = j;

      /* Compute limits for checking Ritz pair convergence. */
      if (version == 2) {
        if (left_ngood + 2 > left_goodlim) {
          left_goodlim = left_ngood + 2;
        }
      }

      /* Special case: need at least d Ritz vals on left. */
      left_goodlim = max(left_goodlim, d);

      /* Special case: can't find more than j total Ritz vals. */
      if (left_goodlim > j) {
        left_goodlim = min(left_goodlim, j);
      }

      /* Find Ritz vals using faster of Sturm bisection or ql. */
      time = lanc_seconds();
      if (inc_bis_safety) {
        bis_safety *= 10;
        inc_bis_safety = FALSE;
      }
      ritzval_flag =
          get_ritzvals(alpha, beta, j, Anorm, workj, ritz, d, left_goodlim, 0, eigtol, bis_safety);
      ql_time += lanc_seconds() - time;

      if (ritzval_flag != 0) {
        bail("ERROR: Lanczos_ext failed in computing eigenvalues of T.", 1);
        /* ... we recover from this in lanczos_SO, but don't worry here. */
      }

      /* Scan for minimum evals of tridiagonal. */
      time = lanc_seconds();
      scanmin(ritz, 1, j, &scanlist);
      scan_time += lanc_seconds() - time;

      /* Compute Ritz pair bounds at left end. */
      time = lanc_seconds();
      setvec(bj, 1, j, 0.0);
      for (i = 1; i <= left_goodlim; i++) {
        Sres = Tevec(alpha, beta - 1, j, ritz[i], s);
        if (Sres > Sres_max) {
          Sres_max = Sres;
        }
        if (Sres > SRESTOL) {
          inc_bis_safety = TRUE;
        }
        bj[i] = s[j] * beta[j];
      }
      ritz_time += lanc_seconds() - time;

      /* Show portion of spectrum checked for Ritz convergence. */
      if (DEBUG_EVECS > 2) {
        time = lanc_seconds();
        printf("\nindex         Ritz vals            bji bounds\n");
        for (i = 1; i <= left_goodlim; i++) {
          printf("  %3d", i);
          doubleout(ritz[i], 1);
          doubleout(bj[i], 1);
          printf("\n");
        }
        printf("\n");
        curlnk = scanlist;
        while (curlnk != NULL) {
          temp = curlnk->indx;
          if ((temp > left_goodlim) && (temp < j)) {
            printf("  %3d", temp);
            doubleout(ritz[temp], 1);
            doubleout(bj[temp], 1);
            printf("\n");
          }
          curlnk = curlnk->pntr;
        }
        printf("                            -------------------\n");
        printf("                goodtol:    %19.16f\n\n", goodtol);
        debug_time += lanc_seconds() - time;
      }

      get_extval(alpha, beta, j, ritz[1], s, eigtol, beta[0], sigma, &extval, v, work1, work2);

      /* Check convergence of iteration. */
      if (fabs(beta[j] * v[j]) < eigtol) {
        converged = TRUE;
      }
      else {
        converged = FALSE;
      }

      if (!converged) {
        ngood      = 0;
        left_ngood = 0; /* for setting left_goodlim on next loop */

        /* Compute converged Ritz pairs on left end */
        time = lanc_seconds();
        for (i = 1; i <= left_goodlim; i++) {
          if (bj[i] <= goodtol) {
            ngood += 1;
            left_ngood += 1;
            if (ngood > maxngood) {
              maxngood             = ngood;
              solist[ngood]        = makeorthlnk();
              (solist[ngood])->vec = mkvec(1, n);
            }
            (solist[ngood])->index = i;
            Sres                   = Tevec(alpha, beta - 1, j, ritz[i], s);
            if (Sres > Sres_max) {
              Sres_max = Sres;
            }
            if (Sres > SRESTOL) {
              inc_bis_safety = TRUE;
            }
            setvec((solist[ngood])->vec, 1, n, 0.0);
            for (k = 1; k <= j; k++) {
              scadd((solist[ngood])->vec, 1, n, s[k], q[k]);
            }
          }
        }
        ritz_time += lanc_seconds() - time;

        if (DEBUG_EVECS > 2) {
          time = lanc_seconds();

          /* Show some info on the orthogonalization. */
          printf("  j %3d; goodlim lft %2d, rgt %2d; list ", j, left_goodlim, 0);
          solistout(solist, ngood, j);

          /* Assemble current approx. eigenvector, check residual directly. */
          setvec(y[1], 1, n, 0.0);
          for (k = 1; k <= j; k++) {
            scadd(y[1], 1, n, v[k], q[k]);
          }
          printf("  extended eigenvalue %g\n", extval);
          printf("  est. extended residual %g\n", fabs(v[j] * beta[j]));
          checkeig_ext(workn, u, A, y[1], n, extval, vwsqrt, gvec, eigtol, FALSE);

          printf("---------------------end of iteration---------------------\n\n");
          debug_time += lanc_seconds() - time;
        }
      }
    }
    j++;
  }
  j--;

  if (DEBUG_EVECS > 0) {
    time = lanc_seconds();
    if (maxj == 0) {
      printf("Not extended eigenproblem -- calling ordinary eigensolver.\n");
    }
    else {
      printf("  Lanczos_ext itns: %d\n", j);
      printf("  extended eigenvalue: %g\n", extval);
      if (j == maxj) {
        strout("WARNING: Maximum number of Lanczos iterations reached.\n");
      }
    }
    debug_time += lanc_seconds() - time;
  }

  if (maxj != 0) {
    /* Compute (scaled) extended eigenvector. */
    time = lanc_seconds();
    setvec(y[1], 1, n, 0.0);
    for (k = 1; k <= j; k++) {
      scadd(y[1], 1, n, v[k], q[k]);
    }
    evec_time += lanc_seconds() - time;
    /* Note: assign() will scale this y vector back to x (since y = Dx) */

    /* Compute and check residual directly. */
    if (DEBUG_EVECS > 0 || WARNING_EVECS > 0) {
      time = lanc_seconds();
      checkeig_ext(workn, u, A, y[1], n, extval, vwsqrt, gvec, eigtol, TRUE);
      debug_time += lanc_seconds() - time;
    }
  }

  /* free up memory */
  time = lanc_seconds();
  frvec(u, 1);
  frvec(r, 1);
  frvec(workn, 1);
  frvec(Ares, 0);
  sfree(index);
  frvec(alpha, 1);
  frvec(beta, 0);
  frvec(ritz, 1);
  frvec(s, 1);
  frvec(bj, 1);
  frvec(workj, 0);
  for (i = 0; i <= j; i++) {
    frvec(q[i], 1);
  }

  sfree(q);
  while (scanlist != NULL) {
    curlnk = scanlist->pntr;
    sfree(scanlist);
    scanlist = curlnk;
  }

  for (i = 1; i <= maxngood; i++) {
    frvec((solist[i])->vec, 1);
    sfree(solist[i]);
  }

  sfree(solist);
  frvec(extvec, 1);
  frvec(v, 1);
  frvec(work1, 1);
  frvec(work2, 1);
  init_time += lanc_seconds() - time;

  if (maxj == 0)
    return (1); /* see note on beta[0] and maxj above */
  else
    return (0);
}