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);
}
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);
}
/* 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);
}
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;
}
/* 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;
}
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;
}
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;
}
}
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);
}
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);
}
