static void upsize(Dataptr matrix, Treestack *sp)
/* increase allocation for tree stack *sp */
{
long i; /* loop counter */
sp->size++;
/* allocate for stack itself */
if (sp->stack == NULL) /* 1st call, stack does not exist */
{
sp->stack = alloc(sp->size * sizeof(Treestack_element), "initial best tree stack");
sp->next = 0;
lvb_assert(sp->size == 1); /* was incremented above */
}
else {
sp->stack = realloc(sp->stack, sp->size * sizeof(Treestack_element));
if (sp->stack == NULL)
crash("out of memory: cannot increase allocation for\n"
"best tree stack to %ld elements", sp->size);
}
/* MIGUEL */
/* allocate space within stack */
for (i = sp->next; i < sp->size; i++){
/* sp->stack[i].tree = treealloc(matrix->n); */
sp->stack[i].tree = treealloc(matrix);
sp->stack[i].root = -1;
}
} /* end upsize() */
/*
str_tree - build a tree denoting a string
*/
tree * str_tree(char *s) {
tree *t;
t = treealloc();
t->op = STR;
t->l.s = s;
return t;
}
/* inthonest_tree - build a tree denoting an integer, which is
actually an integer, honestly, not a double like 'integer' [Ash] */
tree * inthonest_tree(int i) {
tree *t;
t = treealloc();
t->op = NUMBER;
t->l.i = (double)i;
return t;
}
/*
sym_tree - build a tree denoting a variable
*/
tree * sym_tree(symbol * sym, int type) {
tree *t;
t = treealloc();
t->op = type;
t->l.v = sym;
return t;
}
/*
win_tree - build a tree denoting a string
*/
tree * win_tree(WinStruct w) {
tree *t;
t = treealloc();
t->op = FORMWIN;
t->l.w = w;
return t;
}
/*
tree3 - build a tree with all 3 fields defined
*/
tree * tree3(tree * t1, int opcode, tree * t2) {
tree *t;
t = treealloc();
t->op = opcode;
t->l.t = t1;
t->r.t = t2;
return t;
}
/*
tree2 - build a tree with only the left subtree and
the opcode fields defined
*/
tree * tree2(tree * t1, int opcode) {
tree *t;
t = treealloc();
t->op = opcode;
t->l.t = t1;
t->r.t = 0;
return t;
}
/*
def_tree - build a parse tree of a definition
*/
tree * def_tree(symbol * v, tree * def) {
tree *t;
t = treealloc();
t->op = '=';
t->l.v = v;
t->r.t = def;
return t;
}
long treestack_transfer(Dataptr matrix, Treestack *destp, Treestack *sourcep)
{
Branch *barray; /* current tree, in transit */
long root; /* number of root branch */
long pushed = 0; /* number of trees transferred */
/* "local" dynamic heap memory */
barray = treealloc(matrix);
while (treestack_pop(matrix, barray, &root, sourcep) == 1) {
pushed += treestack_push(matrix, destp, barray, root);
}
/* free "local" dynamic heap memory */
free(barray);
return pushed;
}
Tree * addLeaf(Tree * t, pid_t pid, int proc)
{
if (NULL == t) {
t = treealloc();
t->pid = pid;
t->proc = proc;
t->left = NULL;
t->right = NULL;
} else if (proc < t->proc) {
t->left = addLeaf(t->left, pid, proc);
} else if (proc > t->proc) {
t->right = addLeaf(t->right, pid, proc);
}
return t;
}
/*
int_tree - build a tree denoting an integer
*/
tree * int_tree(double i) {
tree *t;
/* [Ash] According to the Scout documentation, Scout uses only
integers, and provides only integer arithmetic. Previously
Scout stored integers as a double type and passed them to Eden
as floating point numbers. I've changed this, but I'm leaving
this assertion here to check my assumption that only integers
are dealt with in Scout. */
/* Commented out after discovering that Scout actually has a real
datatype, which is treated internally as "integer" (hurrumph) */
/*
assert(i == (int)i);
*/
t = treealloc();
t->op = NUMBER;
t->l.i = i;
return t;
}
long treestack_dump(Dataptr matrix, Treestack *sp, FILE *const outfp)
/* pop all trees on stack *sp and dump them to file outfp;
* first branch (number 0); return number of trees dumped */
{
long cnt = 0; /* tree count */
long root; /* number of root branch */
Branch *barray; /* current unpacked tree */
/* "local" dynamic heap memory */
barray = treealloc(matrix);
while ((treestack_pop(matrix, barray, &root, sp)) != 0){
treedump(matrix, outfp, barray);
cnt++;
}
if (fflush(outfp) != 0) crash("file write error when dumping best trees");
/* free "local" dynamic heap memory */
free(barray);
return cnt;
} /* end bstdump() */
long treestack_print(Dataptr matrix, Treestack *sp, FILE *const outfp, Lvb_bool onerandom)
{
const long d_obj1 = 0L; /* 1st obj. for output trees */
long root; /* root of current tree */
long i; /* loop counter */
long lower; /* lowest index of trees to print */
long upper; /* 1 + upper index of trees to print */
Branch *barray; /* current unpacked tree */
/* "local" dynamic heap memory */
barray = treealloc(matrix);
if (onerandom == LVB_TRUE) /* choose one random tree to print */
{
lower = randpint(sp->next - 1);
upper = lower + 1;
} else {
lower = 0;
upper = sp->next;
}
for (i = lower; i < upper; i++) {
treecopy(matrix, barray, sp->stack[i].tree);
if (sp->stack[i].root != d_obj1) lvb_reroot(barray, sp->stack[i].root, d_obj1);
root = d_obj1;
lvb_treeprint(matrix, outfp, barray, root);
}
if (fflush(outfp) != 0)
crash("file write error when writing best trees");
/* deallocate "local" dynamic heap memory */
free(barray);
return upper - lower; /* number of trees printed */
} /* end treestack_print() */
long anneal(Treestack *bstackp, const Branch *const inittree, long root,
const double t0, const double t1, const long maxaccept, const long maxpropose,
const long maxfail, FILE *const lenfp, unsigned char **bmat, long m, long n,
const long *weights, long *current_iter, Lvb_bool log_progress)
/* seek parsimonious tree from initial tree in inittree (of root root)
* with initial temperature t0, and subsequent temperatures obtained by
* multiplying the current temperature by (t1 / t0) ** n * t0 where n is
* the ordinal number of this temperature, after at least maxaccept changes
* have been accepted or maxpropose changes have been proposed, whichever is
* sooner;
* return the length of the best tree(s) found after maxfail consecutive
* temperatures have led to no new accepted solution;
* lenfp is for output of current tree length and associated details;
* *current_iter should give the iteration number at the start of this call and
* will be used in any statistics sent to lenfp, and will be updated on
* return */
{
long accepted = 0; /* changes accespted */
Lvb_bool dect; /* should decrease temperature */
double deltah; /* change in energy (1 - C.I.) */
long deltalen; /* change in length with new tree */
long failedcnt = 0; /* "failed count" for temperatures */
long iter = 0; /* iteration of mutate/evaluate loop */
long len; /* length of current tree */
long prev_len = UNSET; /* length of previous tree */
long lenbest; /* bet length found so far */
long lendash; /* length of proposed new tree */
long lenmin; /* minimum length for any tree */
double ln_t; /* ln(current temperature) */
long t_n = 0; /* ordinal number of current temperature */
Lvb_bool newtree; /* accepted a new configuration */
double pacc; /* prob. of accepting new config. */
Lvb_bool probaccd; /* have accepted based on Pacc */
long proposed = 0; /* trees proposed */
double r_lenmin; /* minimum length for any tree */
long rootdash; /* root of new configuration */
double t = t0; /* current temperature */
double t1_to_t0; /* T1:T0 ratio */
Branch *x; /* current configuration */
Branch *xdash; /* proposed new configuration */
extern Dataptr matrix; /* data matrix */
/* "local" dynamic heap memory */
x = treealloc(brcnt(matrix->n), matrix->m);
xdash = treealloc(brcnt(matrix->n), matrix->m);
treecopy(x, inittree); /* current configuration */
len = getplen(x, root, m, n, weights);
dect = LVB_FALSE; /* made LVB_TRUE as necessary at end of loop */
/* if t1_to_t0 is going to be very small, set it to zero without
* calculating it, to avoid underflow. Use this relation:
* if T1 / T0 < eps,
* ln (T1/T0) < ln eps
* i.e.,
* ln T1 - ln T0 < ln eps */
lvb_assert ((t0 >= LVB_EPS) && (t1 >= LVB_EPS) && (t1 <= t0)
&& (t0 <= 1.0));
if (log_wrapper(t1) - log_wrapper(t0) < log_wrapper(LVB_EPS))
t1_to_t0 = 0.0;
else
t1_to_t0 = t1 / t0;
lenbest = len;
treestack_push(bstackp, inittree, root); /* init. tree initially best */
if ((log_progress == LVB_TRUE) && (*current_iter == 0))
{
fprintf(lenfp, "\nRearrangement: Length:\n");
}
lenmin = getminlen(matrix);
r_lenmin = (double) lenmin;
while (1)
{
if ((log_progress == LVB_TRUE) && ((len != prev_len)
|| ((*current_iter % STAT_LOG_INTERVAL) == 0)))
{
lenlog(lenfp, *current_iter, len);
}
prev_len = len;
*current_iter += 1;
/* occasionally re-root, to prevent influence from root position */
if ((*current_iter % REROOT_INTERVAL) == 0)
root = arbreroot(x, root);
lvb_assert(t > DBL_EPSILON);
newtree = LVB_FALSE;
probaccd = LVB_FALSE;
/* mutation: alternate between the two mutation functions */
if (iter % 2)
{
rootdash = root;
mutate_spr(xdash, x, root); /* global change */
}
else
{
rootdash = root;
mutate_nni(xdash, x, root); /* local change */
}
lendash = getplen(xdash, rootdash, m, n, weights);
lvb_assert (lendash >= 1L);
deltalen = lendash - len;
deltah = (r_lenmin / (double) len) - (r_lenmin / (double) lendash);
if (deltah > 1.0) /* getminlen() problem with ambiguous sites */
deltah = 1.0;
if (deltalen <= 0) /* accept the change */
{
if (lendash <= lenbest) /* store tree if new */
{
if (lendash < lenbest) /* very best so far */
treestack_clear(bstackp); /* discard old bests */
if (treestack_push(bstackp, xdash, rootdash) == 1)
newtree = LVB_TRUE; /* new */
}
/* update current tree and its stats */
prev_len = len;
len = lendash;
treeswap(&x, &root, &xdash, &rootdash);
if (lendash < lenbest) /* very best so far */
lenbest = lendash;
}
else /* poss. accept change for the worse */
{
/* Mathematically,
* Pacc = e ** (-1/T * deltaH)
* therefore ln Pacc = -1/T * deltaH
*
* Computationally, if Pacc is going to be small, we
* can assume Pacc is 0 without actually working it
* out.
* i.e.,
* if ln Pacc < ln eps, let Pacc = 0
* substituting,
* if -deltaH / T < ln eps, let Pacc = 0
* rearranging,
* if -deltaH < T * ln eps, let Pacc = 0
* This lets us work out whether Pacc will be very
* close to zero without dividing anything by T. This
* should prevent overflow. Since T is no less
* than eps and ln eps is going to have greater
* magnitude than eps, underflow when calculating
* T * ln eps is not possible. */
if (-deltah < t * log_wrapper(LVB_EPS))
{
pacc = 0.0;
/* Call uni() even though its not required. It
* would have been called in LVB 1.0A, so this
* helps make results identical to results with
* that version. */
(void) uni();
}
else /* possibly accept the change */
{
pacc = exp_wrapper(-deltah/t);
if (uni() < pacc) /* do accept the change */
{
probaccd = LVB_TRUE;
treeswap(&x, &root, &xdash, &rootdash);
}
}
if (probaccd == LVB_TRUE)
{
prev_len = len;
len = lendash;
}
}
proposed++;
if (newtree == LVB_TRUE)
accepted++;
/* decide whether to reduce temperature */
if (accepted >= maxaccept) /* enough new trees */
{
failedcnt = 0; /* this temperature a 'success' */
dect = LVB_TRUE;
}
else if (proposed >= maxpropose) /* enough proposals */
{
failedcnt++;
if (failedcnt >= maxfail) /* system frozen */
break; /* end of cooling */
else /* decrease temp. */
dect = LVB_TRUE;
}
if (dect == LVB_TRUE)
{
t_n++; /* originally n is 0 */
/* near the start of the function we ensure t1_to_t0 is
* either zero or no less than LVB_EPS */
if (t1_to_t0 < LVB_EPS)
t = LVB_EPS;
else
{
ln_t = ((double) t_n) * log_wrapper(t1_to_t0) + log_wrapper(t0);
if (ln_t < log_wrapper(LVB_EPS))
t = LVB_EPS;
else
t = pow_wrapper(t1_to_t0, (double) t_n) * t0;
}
proposed = 0;
accepted = 0;
dect = LVB_FALSE;
}
iter++;
}
/* free "local" dynamic heap memory */
free(x);
free(xdash);
return lenbest;
} /* end anneal() */
