/* Update L-BFGS approximation of the Hessian. */
static void
update(opk_vmlmn_t* opt,
const opk_vector_t* x,
const opk_vector_t* g)
{
double sty, yty;
opk_index_t k;
k = slot(opt, 0);
AXPBY(S(k), 1, x, -1, opt->x0);
AXPBY(Y(k), 1, g, -1, opt->g0);
if (opt->method != OPK_VMLMN) {
/* Compute initial inverse Hessian approximation. */
sty = DOT(Y(k), S(k));
if (sty <= 0) {
RHO(k) = 0;
} else {
RHO(k) = 1/sty;
yty = DOT(Y(k), Y(k));
if (yty > 0) {
opt->gamma = sty/yty;
}
}
}
++opt->updates;
if (opt->mp < opt->m) {
++opt->mp;
}
}
/* Update L-BFGS approximation of the Hessian. */
static void
update(opk_vmlmb_t* opt,
const opk_vector_t* x,
const opk_vector_t* g)
{
double sty, yty;
opk_index_t k;
k = SLOT(0);
AXPBY(S(k), 1, x, -1, opt->x0);
AXPBY(Y(k), 1, g, -1, opt->g0);
if (opt->method != OPK_VMLMB) {
/* Compute initial inverse Hessian approximation. */
sty = DOT(S(k), Y(k));
if (sty <= 0) {
/* This pair will be skipped. This may however indicate a problem, see
Nocedal & Wright "Numerical Optimization", section 8.1, p. 201 (1999).
FIXME: restart? */
RHO(k) = 0;
} else {
/* Compute RHO(k) and GAMMA. */
RHO(k) = 1/sty;
yty = DOT(Y(k), Y(k));
if (yty > 0) {
opt->gamma = sty/yty;
}
}
}
++opt->updates;
if (opt->mp < opt->m) {
++opt->mp;
}
}
//to get the gernike moments of order p and repetition q
double* zernike::CalculateZernike(int p, int q )
{
double * V = (double*) malloc (2* sizeof(double ));
V[0]=0.0;V[1]=0.0;
double** ro = RHO() ;
double** theta = THETA();
int s = (p-abs(q))/2;
for(int i =0; i<M;i++)
{
for(int j=0;j<N;j++)
{
double temp = 0.0;
if(ro[i][j]<=1.0)
{
for(int k = 0 ; k<=s;k++)
{
temp += B(p,q,k)*pow(ro[i][j],p-2*k);
}
V[0] +=temp*cos(theta[i][j]*q)*f[i][j];
V[1] -=temp*sin(theta[i][j]*q)*f[i][j];
}
else
{
V[0] += 0.0;
V[0] += 0.0;
}
}
}
double b = G00();
V[0] = V[0]*(p+1)/(3.14259265*b);
V[1] = V[1]*(p+1)/(3.14259265*b);
free(ro);
free(theta);
return V;
}
int test_ratios_dp(double sigma, size_t tau, dgs_disc_gauss_alg_t algorithm) {
printf("σ: %6.2f, c: 0.0. τ: %2ld, precision: double, algorithm: %d\n",sigma, tau, algorithm);
dgs_disc_gauss_dp_t *self = dgs_disc_gauss_dp_init(sigma, 0, tau, algorithm);
double ctr[2*BOUND+1];
for(size_t i=0; i<NTRIALS; i++) {
long r = self->call(self);
if (abs(r) <= BOUND)
ctr[r+BOUND] += 1;
}
for(long i=-BOUND; i<=BOUND; i++) {
double left = ctr[BOUND+1]/ctr[BOUND+i];
double right = RHO(0)/RHO(i);
if (fabs(log(left/right)) >= 0.4)
dgs_die("exp(-((-c)²)/(2σ²))/exp(-((%d-c)²)/(2σ²)) = %7.5f != %7.5f (%7.5f)", i, right, left, fabs(log(left/right)));
}
return 0;
}
void whirlpoolProcessBlock(WhirlpoolContext *context)
{
uint_t i;
uint64_t *x = context->x;
uint64_t *k = context->k;
uint64_t *l = context->l;
uint64_t *state = context->state;
//Convert from big-endian byte order to host byte order
for(i = 0; i < 8; i++)
x[i] = betoh64(x[i]);
k[0] = context->h[0];
k[1] = context->h[1];
k[2] = context->h[2];
k[3] = context->h[3];
k[4] = context->h[4];
k[5] = context->h[5];
k[6] = context->h[6];
k[7] = context->h[7];
state[0] = x[0] ^ k[0];
state[1] = x[1] ^ k[1];
state[2] = x[2] ^ k[2];
state[3] = x[3] ^ k[3];
state[4] = x[4] ^ k[4];
state[5] = x[5] ^ k[5];
state[6] = x[6] ^ k[6];
state[7] = x[7] ^ k[7];
//Iterate over all rounds
for(i = 0; i < 10; i++)
{
//Key schedule
RHO(l[0], k, 0, rc[i]);
RHO(l[1], k, 1, 0);
RHO(l[2], k, 2, 0);
RHO(l[3], k, 3, 0);
RHO(l[4], k, 4, 0);
RHO(l[5], k, 5, 0);
RHO(l[6], k, 6, 0);
RHO(l[7], k, 7, 0);
k[0] = l[0];
k[1] = l[1];
k[2] = l[2];
k[3] = l[3];
k[4] = l[4];
k[5] = l[5];
k[6] = l[6];
k[7] = l[7];
//Apply the round function
RHO(l[0], state, 0, k[0]);
RHO(l[1], state, 1, k[1]);
RHO(l[2], state, 2, k[2]);
RHO(l[3], state, 3, k[3]);
RHO(l[4], state, 4, k[4]);
RHO(l[5], state, 5, k[5]);
RHO(l[6], state, 6, k[6]);
RHO(l[7], state, 7, k[7]);
state[0] = l[0];
state[1] = l[1];
state[2] = l[2];
state[3] = l[3];
state[4] = l[4];
state[5] = l[5];
state[6] = l[6];
state[7] = l[7];
}
//Update the hash value
context->h[0] ^= state[0] ^ x[0];
context->h[1] ^= state[1] ^ x[1];
context->h[2] ^= state[2] ^ x[2];
context->h[3] ^= state[3] ^ x[3];
context->h[4] ^= state[4] ^ x[4];
context->h[5] ^= state[5] ^ x[5];
context->h[6] ^= state[6] ^ x[6];
context->h[7] ^= state[7] ^ x[7];
}
/* Apply the L-BFGS Strang's two-loop recursion to compute a search direction.
Returned value indicates whether the operation was successful otherwise the
direction is just the gradient (steepest ascent). */
static opk_status_t
apply(opk_vmlmb_t* opt, const opk_vector_t* g)
{
double sty, yty;
opk_index_t j, k;
opk_status_t result;
COPY(opt->d, g);
result = OPK_NOT_POSITIVE_DEFINITE;
if (opt->method != OPK_VMLMB) {
/* Apply the original L-BFGS Strang's two-loop recursion. */
for (j = 1; j <= opt->mp; ++j) {
k = SLOT(j);
if (RHO(k) > 0) {
ALPHA(k) = RHO(k)*DOT(opt->d, S(k));
UPDATE(opt->d, -ALPHA(k), Y(k));
result = OPK_SUCCESS;
}
}
if (result == OPK_SUCCESS) {
if (opt->gamma != 1) {
/* Apply initial inverse Hessian approximation. */
SCALE(opt->d, opt->gamma);
}
for (j = opt->mp; j >= 1; --j) {
k = SLOT(j);
if (RHO(k) > 0) {
double beta = RHO(k)*DOT(opt->d, Y(k));
UPDATE(opt->d, ALPHA(k) - beta, S(k));
}
}
}
} else {
/* Apply L-BFGS Strang's two-loop recursion restricted to the subspace of
free variables. */
opt->gamma = 0;
for (j = 1; j <= opt->mp; ++j) {
k = SLOT(j);
sty = WDOT(Y(k), S(k));
if (sty <= 0) {
RHO(k) = 0;
} else {
RHO(k) = 1/sty;
ALPHA(k) = RHO(k)*WDOT(opt->d, S(k));
UPDATE(opt->d, -ALPHA(k), Y(k));
result = OPK_SUCCESS;
if (opt->gamma == 0) {
yty = WDOT(Y(k), Y(k));
opt->gamma = sty/yty;
}
}
}
if (result == OPK_SUCCESS) {
if (opt->gamma != 1) {
SCALE(opt->d, opt->gamma);
}
for (j = opt->mp; j >= 1; --j) {
k = SLOT(j);
if (RHO(k) > 0) {
double beta = RHO(k)*WDOT(opt->d, Y(k));
UPDATE(opt->d, ALPHA(k) - beta, S(k));
}
}
/* Enforce search direction to belong to the subset of the free
variables. */
opk_vproduct(opt->d, opt->w, opt->d);
}
}
return result;
}
RootNodeT *
buildTree(int N, MatrixT Dorig, char **taxon)
{
/*
\section{Initialize}
Initialize main variables
*/
int i;
RootNodeT *root;
int Nleft, Nnext; /* number of Nodes left to be joined
and the next index to be used */
MatrixT b=matrix(N); /* the $b_{i;j}$ matrix (eq 0.7) */
/* $q(i)$ array: value which minimizes $R(i,q(i),j)\,\forall j\ne i,q(i)$ */
int *q;
int *q2; /* Second best value */
VectorT R=vector(N); /* $R(i,q(i))$ (eq 0.10) */
VectorT LLR=vector(N); /* $R(i,q(i),q2(i))$ */
VectorT Zscore=vector(N); /* $z(i,q(i))$ */
/*
This auxilary matrices are globally defined in \|weighbor.h| we do
this to make it simplier so we do not always have to pass these
around. Note that the need to be visible here as we will be
calling \|calcR| later in this function and \|calcR| needs these
values
*/
s = matrix(N); /* $s_{ij}$ eq 0.9 */
deltaB = matrix(N); /* $\Delta b_{ij}$ eq 0.8 */
delta2B = matrix(N); /* $\Delta^2 b_{ij}$ */
if(recalcB)
oldDeltaB = matrix(N);
/*
This will hold this orignal $N$ distances plus any distances from
the $N-3$ internal nodes. Note we do not care about the root node
so $N-3$ and not $N-2$
*/
mD=matrix(2*N-3);
/*
This is the renormalization vector $c_i$ (eq 0.39) and matrix
$c_{i;j}$ (eq 0.43 ver0.2.5); again it must
be large enough to hold both the original and the new joined taxa
N.B. \|vector| sets all elements to zero.
*/
vC=vector(2*N-3);
/*
This matrices hold the previous iterations values of $s_{ij}$,
$\Delta b_{ij}$, etc. They are used to speed up the next
iterations calcultions of these quantities.
*/
mS = matrix(2*N-3);
mDelB = matrix(2*N-3);
mDel2B = matrix(2*N-3);
/*
Init \|mS| to -1 to keep track of which entries have not yet been
computed. */
for(i=0;i<2*N-3;++i) {
int j;
for(j=0;j<2*N-3;++j)
mS[i][j] = -1.0;
}
/*
Make a copy of the original distance matrix; embed it in the
larger matrix which will hold the new distance from the added
internal nodes of the tree.
*/
setMM(N, Dorig, mD);
/*
Allocate and initialize the \|q|, \|q2| and \|nodes| array. $2N-3$
nodes to hold both the original and the added nodes.
*/
q = (int *)malloc(N*sizeof(int));
if(!q) printError("build::buildTree:out of memory-q\n");
q2 = (int *)malloc(N*sizeof(int));
if(!q2) printError("build::buildTree:out of memory-q2\n");
nodes = (NodeT **)malloc( (2*N-3)*sizeof(NodeT *));
if(!nodes) printError("build::buildTree:out of memory-nodes");
for(i=0;i<N;++i) {
nodes[i] = createNode();
nodes[i]->name = taxon[i];
nodes[i]->ind = i;
}
Nleft = N;
Nnext = N;
/*
\section{Loop until 3 taxa left}
While we have more than 3 nodes left do the neighbor joining algorithm.
Each pass of the algorithm will join 2 nodes replacing them with one.
*/
while(Nleft>3) {
int j, k, ip, ip2;
double minR=0.0, min2R=0.0;
NodeT *newNode, *tmpNode;
double sigma_inf_i, sigma_inf_ip, sigma_inf_rat;
double sig_r, sig_l;
int jj, jjmin;
double LLRp=0, tR, tmp;
/* \subsection{Calculate Residual} */
calc_q(Nleft, q, R, b, q2, LLR, Zscore);
if(printLevel>2)
for(k=0;k<Nleft;++k)
fprintf(outfile, "q[%d]=%d R(%d,%d)=%g\n",
k, q[k], k, q[k], R[k]);
/*
Find $i$ than minimizes $R(i,q(i))$. With the constraint that
$q(q(i))=i$ first if no pair found then find the best $i$
without this constraint.
Note: the \|checkQQI| flag determines if we will use the
$q(q(i))=i$ constraint.
Note: j will hold the next best pair
*/
i = -1;
j = -1;
if(checkQQI) {
for(k=0;k<Nleft;++k)
if(q[q[k]]==k) {
if(R[k]<minR || i==-1) {
if(printLevel>3)
fprintf(outfile,
"ij=%d,%d k=%d q[k]=%d minR = %.16g R[k] = %.16g\n",
i,j,k, q[k], minR, R[k]);
j = i;
min2R = minR;
i = k;
minR = R[k];
}
else if(R[k]>minR && (R[k]<min2R || j==-1) ) {
j = k;
min2R = R[k];
}
}
}
if(i==-1) { /* No pair had $q(q(i))=i$ */
if(R[0]<R[1]) {
i = 0;
minR = R[0];
j = 1;
min2R = R[1];
} else {
i = 1;
minR = R[1];
j = 0;
min2R = R[0];
}
for(k=1;k<Nleft;++k)
if(R[k]<minR) {
j = i;
min2R = minR;
i = k;
minR = R[k];
}
else if(R[k] < min2R && R[k] > minR) {
j = k;
min2R = R[k];
}
if(checkQQI && printLevel>1)
fprintf(outfile, "No pair with q[q[i]]==i ");
else
if(q[q[i]]!=i && printLevel>1)
fprintf(outfile,
"The pair does not satisfy q[q[i]]==i (checking is off)"
);
}
ip = q[i];
ip2 = j;
/*
If the extended tournament option is set (-e) then run two
more tournaments for (i,q[i]) to see who really wins.
*/
if(extendedTourn) {
double minR1=0, minR2=0, tmpR, oldR=R[i];
int jmin=-1, jpmin=-1;
/*
First fine the j the minimizes R(i,j)
*/
for(j=0;j<Nleft;++j)
if(j!=i && j!=q[i]) {
if(j!=q2[i])
tmpR = calcR2(Nleft, i, j, q2[i], b);
else
tmpR = calcR2(Nleft, i, j, q[i], b);
if(tmpR<minR1 || jmin==-1)
{
minR1=tmpR;
jmin = j;
}
}
/*
and now the $j'$ that minimizes $R(j',q[i])$
*/
for(j=0;j<Nleft;++j)
if(j!=i && j!=q[i]) {
if(j!=q2[i])
tmpR = calcR2(Nleft, j, q[i], q2[i], b);
else
tmpR = calcR2(Nleft, j, q[i], i, b);
if(tmpR<minR2 || jpmin==-1) {
minR2=tmpR;
jpmin = j;
}
}
/*
Now fnd which of the three is the smallest
*/
if(minR1<minR2 && minR1<R[i]) {
ip = jmin;
if(printLevel>1)
fprintf(outfile,
"Extended Tournament New Winner(A): (%d, %d) R=%g\n",
i, ip, minR1);
}
else if(minR2<minR1 && minR2<R[i]) {
i = jpmin;
if(printLevel>1)
fprintf(outfile,
"Extended Tournament New Winner(B): (%d, %d) R=%g\n",
i, ip, minR2);
}
if(printLevel>3)
fprintf(outfile, "R=%g, R1=%g, R2=%g\n", oldR, minR1, minR2);
}
/*
Find the $jj$ that minimizes $R(q(i),i,jj)$ and then print out
the LLR and LLR' values.
*/
jjmin=-1;
for(jj=0;jj<Nleft;++jj)
if(jj!=i && jj!=ip
&& (((tR=calcR(Nleft, ip, jj, i))<LLRp) || jjmin==-1)) {
jjmin = jj;
LLRp = tR;
}
LLRp *= 0.5;
if( (LLR[i]<1e-6) && (LLRp<1e-6) ) {
if(!warnFlag) {
fprintf(stderr,
"warning: tie scores encountered; topology may depend on sequence order!\n");
warnFlag = True;
}
if(printLevel>1) {
fprintf(outfile,
"warning: tie scores encountered; topology may depend on sequence order!\n");
fprintf(outfile, "taxon %s and taxon %s\n\n",
nodes[i]->name, nodes[ip]->name);
}
}
if(printLevel>0) {
fprintf(outfile,
"\nJoin taxon %s to taxon %s (%s next best choice)\n",
nodes[i]->name, nodes[ip]->name, nodes[q2[i]]->name);
fprintf(outfile, " p-value = %g\n",
DMAX(1.0/(exp(LLR[i])+1.0), 1.0/(exp(LLRp)+1.0)));
if(printLevel>1) {
fprintf(outfile,"\nJoin taxon %s to taxon %s; R=%g\n",
nodes[i]->name, nodes[ip]->name, minR);
if(ip2!=-1 && ip2!=i && ip2!=ip)
fprintf(outfile, "Second best pair (%s, %s); R=%g\n",
nodes[ip2]->name, nodes[q[ip2]]->name, min2R);
else
fprintf(outfile, "No second best pair\n");
}
}
/*
Note due to the way we shuffle around nodes after joining:
i->Nnext, New->i, ip<->Nleft-1, if ip is less than i and
i=Nleft-1 then the new node will be in position ip not i!!
But tc (the global that is suppose to point to the position
of the new node for calcb) is set to i so this will screw us
up. The simpliest solution is to make sure i<ip; swap if they
are not.
*/
if(ip<i) {
int tt;
tt=i;
i=ip;
ip=tt;
}
/*
Need to calculate the new branch lengths $\bar b_{i;i'}$ and
$\bar b_{i';i}$, eq. 0.19.
Note if the z-score is negative then we calculate $\phi$ eq
(0.26) and use it to renormalize $d_{i,i'}$ and recompute
$b_{i;i'}$ and $b_{i';i}$.
*/
if(Zscore[i]<0.0) {
double phi_iip, dBar_iip;
phi_iip = calcPhi(Nleft, i, ip);
if(printLevel>2)
fprintf(outfile, "Renormalizing z[%d,%d] = %g\n", i, ip, Zscore[i]);
if(phi_iip>0) {
dBar_iip = D(i,ip)-phi_iip;
if(printLevel>2)
fprintf(outfile, "phi=%g dBar_iip=%g\n", phi_iip, dBar_iip);
/* renormalize the b's */
if( dBar_iip >= fabs(deltaB[i][ip]) )
b[i][ip] = (deltaB[i][ip] + dBar_iip)/2.0;
else if( dBar_iip < -deltaB[i][ip] )
b[i][ip] = 0.0;
else
b[i][ip] = dBar_iip;
if( dBar_iip >= fabs(deltaB[ip][i]) )
b[ip][i] = (deltaB[ip][i] + dBar_iip)/2.0;
else if( dBar_iip < -deltaB[ip][i] )
b[ip][i] = 0.0;
else
b[ip][i] = dBar_iip;
}
}
nodes[i ]->rho = b[i][ip];
nodes[ip]->rho = b[ip][i];
if(nodes[i ]->rho < 0.0) {
if(printLevel>0)
fprintf(outfile,
"WARNING: Negative branch length %g set to zero\n",
nodes[i ]->rho);
nodes[i ]->rho = 0.0;
nodes[ip]->rho = D(i,ip);
}
else if(nodes[ip]->rho < 0.0) {
if(printLevel>0)
fprintf(outfile,
"WARNING: Negative branch length %g set to zero\n",
nodes[ip]->rho);
nodes[ip]->rho = 0.0;
nodes[i ]->rho = D(i,ip);
}
if(printLevel>3) {
fprintf(outfile, "\\bar b_[%d%d] = %g b_[%d%d]=%g\n",
i, ip, nodes[i]->rho, i, ip, b[i][ip]);
fprintf(outfile, "\\bar b_[%d%d] = %g b_[%d%d]=%g\n\n",
ip, i, nodes[ip]->rho, ip, i, b[ip][i]);
}
newNode = createNode();
newNode->ind = Nnext;
newNode->child_r = nodes[i];
newNode->child_l = nodes[ip];
newNode->name = nodes[i]->name;
nodes[Nnext] = newNode;
/*
Calculate $\sigma^2_\infty(i\bar\imath)$ (eq. 0.27) for each
of the joined taxa.
*/
sigma_inf_i = 0.0;
sigma_inf_ip = 0.0;
for(j=0;j<Nleft;++j) {
if(j!=i && j!=ip) {
sigma_inf_i
+= sigma_na(DMAX(b[i][ip],MINB)+C(i),
DMAX(D(i,j)-b[i][ip],MINB)+C(j) );
sigma_inf_ip
+= sigma_na(DMAX(b[ip][i],MINB)+C(ip),
DMAX(D(ip,j)-b[ip][i],MINB)+C(j) );
}
}
/*
Add \|EPSILON| here to make the following formulae a bit simplier
*/
sigma_inf_i += EPSILON;
sigma_inf_ip += EPSILON;
/*
Calculate the new distances from eq. 0.24
$$
d_{\bar\imath k} = {{(d_{ik}-b_{i;i'}+\phi_i)/\sigma^2_\infty(i\bar\imath)+
(d_{i'j}-b_{i';i}+\phi_{i'})/\sigma^2_\infty(i'\bar\imath)}
\over{
{1\over\sigma^2_\infty(i'\bar\imath)} +
{1\over\sigma^2_\infty(i'\bar\imath)}}}
$$
where\hfill\break
$i=$ \|newNode->child_r->ind|,\hfill\break
$i'=$ \|newNode->child_l->ind|,\hfill\break
$b_{i;i'}=$ \|newNode->child_r->rho|,\hfill\break
$b_{i';i}=$ \|newNode->child_l->rho|
Also calcuate the renormalization terms $c_{i;j}$ (eq 0.43 ver0.2.5)
and $c_i$
*/
for(j=0;j<Nleft;++j) {
if(j!=i && j!=ip) {
/* $1/\sigma^2_\infty(i\bar\imath)+1/\sigma^2_\infty(i'\bar\imath)$ */
double norm =
1.0/( 1.0/sigma_inf_i + 1.0/sigma_inf_ip);
/*
First calcuate the new distances
*/
D(Nnext,j) = D(j,Nnext) =
norm *
(
(D(i,j)-RHO(newNode->child_r))/(sigma_inf_i)
+
(D(ip,j)-RHO(newNode->child_l))/(sigma_inf_ip)
);
if(D(Nnext,j)<0.0)
D(Nnext,j) = D(j,Nnext) = 0.0;
}
}
D(Nnext,Nnext) = 0.0;
/*
And now the new renormalization quantity $c_{\bar\imath}$
N.B. eq 0.30 has been rewritten from
$$
{1\over{{1\over X}+{1\over Y}}}
$$
to
$$
{XY\over X+Y}
$$
which is better behaved numerically when $X$ or $Y$ is
small (and cheeper since it only has one division).
*/
sig_r = sigma2t(C(i)+DMAX(RHO(newNode->child_r), MINB));
sig_l = sigma2t(C(ip)+DMAX(RHO(newNode->child_l), MINB));
if(sigma_inf_i+sigma_inf_ip>0.0) {
if(sigma_inf_i+sigma_inf_ip < .9*sqrt(DBL_MAX) && /* no overflow */
sigma_inf_i+sigma_inf_ip > .9*sqrt(DBL_MIN)) /* no underflow */
{
tmp=
(sig_r*SQR(sigma_inf_ip)+ sig_l*SQR(sigma_inf_i))
/
SQR(sigma_inf_i+sigma_inf_ip);
}
else if(sigma_inf_ip > sigma_inf_i) /* to avoid over/underflow */
{
sigma_inf_rat = sigma_inf_i / sigma_inf_ip;
tmp =
sig_r*1.0+sig_l*SQR(sigma_inf_rat)
/
SQR(1.0+sigma_inf_rat);
}
else
{
sigma_inf_rat = sigma_inf_ip / sigma_inf_i;
tmp =
sig_r*SQR(sigma_inf_rat)+sig_l*1.0
/
SQR(1.0+sigma_inf_rat);
}
C(Nnext) = sigma2tinv( tmp );
}
else
C(Nnext) = sigma2tinv(0.0);
/* if(!
(C(Nnext)<=DMAX(DMAX(RHO(newNode->child_r),MINB)+C(i)+1e-14,
DMAX(RHO(newNode->child_l),MINB)+C(ip)+1e-14)))
{
printf("C(Nnext=%d)=%g\n"
"RHO_R=%g C(i=%d)=%g sig_r=%g\nRHO_L=%g C(ip=%d)=%g sig_l=%g -- %g\n",
Nnext, C(Nnext),
RHO(newNode->child_r), i, C(i), sig_r,
RHO(newNode->child_l), ip, C(ip), sig_l,
sig_r*sig_l/(sig_r+sig_l));
fflush(stdout);
}
assert((C(Nnext)<=DMAX(DMAX(RHO(newNode->child_r),MINB)+C(i)+1e-14,
DMAX(RHO(newNode->child_l),MINB)+C(ip)+1e-14)));
*/
/*
Swap $i$ node to the empty node at the end of the list and
place the new node in position $i$ */
nodes[Nnext] = nodes[i];
nodes[i] = newNode;
/*
Swap the $ip$ node and the last node on the list this moves
$ip$ to the end. When we decrease \|Nleft| by one there will be
on less node and the two joined nodes $i$ and $ip$ will now be
after then end (\|Nleft|) of the list
*/
tmpNode = nodes[ip];
nodes[ip] = nodes[Nleft-1];
nodes[Nleft-1] = tmpNode;
/*
In the new node set the child indecies to the
new indexes of the the joined nodes. This info
will be used by \|sigma2_3| in the renormalization
step
*/
newNode->cind_r=Nnext;
newNode->cind_l=Nleft-1;
/*
Set up the \|ta|, \|tb| and \|tc| node array indices. \|ta|
and \|tb| point to the two taxa that where just joined, and
\|tc| points to the newly created taxon.
These globals will be used in the next call to \|calcb|.
*/
ta = Nnext;
tb = Nleft - 1;
tc = i;
--Nleft;
++Nnext;
/*
Print out the values of the various variables
*/
if(printLevel>2) {
int a, b;
fprintf(outfile, "\nReduced d_ij=\n");
for(a=0;a<Nleft;++a)
{
for(b=0;b<Nleft;++b)
fprintf(outfile,"%7.4g ", D(a,b));
fprintf(outfile,"\n");
}
fprintf(outfile,"\n");
}
if(printLevel>3) {
int a, b;
for(a=0;a<Nnext;++a) {
for(b=0;b<Nnext;++b)
fprintf(outfile,"%7.4g ", mD[a][b]);
fprintf(outfile,"\n");
}
fprintf(outfile,"\n");
fprintf(outfile, "c_i = ");
for(a=0;a<Nleft;++a) {
fprintf(outfile,"%7.4g ", C(a));
}
fprintf(outfile,"\n");
for(a=0;a<Nnext;++a) {
fprintf(outfile,"%7.4g ", vC[a]);
}
fprintf(outfile,"\n");
fprintf(outfile, "\n");
}
}
/*
\section{Final three taxa}
Now there are just three taxa left. They will join to the root
node of our tree. Find their branch lengths (which we can do
exactly) and set up the root node to be passed back on return from
this functin.
*/
root = createRootNode();
if(!root) printError("build::buildTree:out of memory-root");
root->child_l = nodes[0];
root->child_m = nodes[1];
root->child_r = nodes[2];
/*
Now get the root branch lengths. We can solve this exactly since
we have three equations and three unknows. The equations to solve
are:
$$
\rho_0+\rho_1 = d_{01},
\rho_0+\rho_2 = d_{02},
\rho_1+\rho_2 = d_{12}
$$
And the solution is:
$$
\rho_0={1 \over 2}\left(d_{01}+d_{02}-d_{12}\right),
\rho_1={1 \over 2}\left(d_{01}-d_{02}+d_{12}\right),
\rho_2={1 \over 2}\left(-d_{01}+d_{02}+d_{12}\right)
$$
*/
root->child_l->rho = 0.5*( D(0,1)+D(0,2)-D(1,2));
root->child_m->rho = 0.5*( D(0,1)-D(0,2)+D(1,2));
root->child_r->rho = 0.5*(-D(0,1)+D(0,2)+D(1,2));
/* check for negative lengths and set to zero if found and decrease
the other each by half the the negative length (note + a neg
number is a decrease) */
if(root->child_l->rho < 0.0) {
root->child_m->rho += 0.5*root->child_l->rho;
root->child_r->rho += 0.5*root->child_l->rho;
root->child_l->rho=0.0;
}
if(root->child_m->rho < 0.0) {
root->child_l->rho += 0.5*root->child_m->rho;
root->child_r->rho += 0.5*root->child_m->rho;
root->child_m->rho=0.0;
}
if(root->child_r->rho < 0.0) {
root->child_l->rho += 0.5*root->child_r->rho;
root->child_m->rho += 0.5*root->child_r->rho;
root->child_r->rho=0.0;
}
/*
Clean up
*/
freeMatrix(mD);
freeMatrix(b);
freeMatrix(delta2B);
freeMatrix(deltaB);
if(recalcB)
freeMatrix(oldDeltaB);
freeMatrix(s);
freeVector(R);
freeVector(LLR);
freeVector(Zscore);
freeVector(vC);
freeMatrix(mS);
freeMatrix(mDelB);
freeMatrix(mDel2B);
free(nodes);
free(q);
free(q2);
return(root);
}
void calc_mesh_density(struct particle *ptcl, float *mesh,
int nmesh, struct run_param *this_run)
{
int nmesh_p2, nmesh_total;
nmesh_p2 = nmesh+2;
nmesh_total = nmesh*nmesh*nmesh_p2;
/* zero out */
for(int i=0;i<nmesh_total;i++) mesh[i] = 0.0;
for(int p=0;p<this_run->npart_total;p++) {
float xpos, ypos, zpos; /* normalized coordinate 0.0 < {x,y,z}pos < 1.0 */
float xt1, dx1;
float wi11,wi21,wi31,wi12,wi22,wi32,wi13,wi23,wi33;
int iw11,iw21,iw31,iw12,iw22,iw32,iw13,iw23,iw33;
xpos = ptcl[p].xpos;
ypos = ptcl[p].ypos;
zpos = ptcl[p].zpos;
xt1 = xpos*(float)nmesh-0.5;
iw21 = (int)(xt1 + 0.5);
dx1 = xt1 - (float)iw21;
wi11 = 0.5*(0.5-dx1)*(0.5-dx1);
wi21 = 0.75-dx1*dx1;
wi31 = 0.5*(0.5+dx1)*(0.5+dx1);
iw11 = iw21-1;
iw31 = iw21+1;
if(iw21 == 0){
iw11 = nmesh-1;
}else if(iw21 == nmesh-1){
iw31 = 0;
}else if(iw21 == nmesh){
iw21 = 0;
iw31 = 1;
}
xt1 = ypos*(float)nmesh-0.5;
iw22 = (int)(xt1 + 0.5);
dx1 = xt1 - (float)iw22;
wi12 = 0.5*(0.5-dx1)*(0.5-dx1);
wi22 = 0.75-dx1*dx1;
wi32 = 0.5*(0.5+dx1)*(0.5+dx1);
iw12 = iw22-1;
iw32 = iw22+1;
if(iw22 == 0){
iw12 = nmesh-1;
}else if(iw22 == nmesh-1){
iw32 = 0;
}else if(iw22 == nmesh){
iw22 = 0;
iw32 = 1;
}
xt1 = zpos*(float)nmesh-0.5;
iw23 = (int)(xt1 + 0.5);
dx1 = xt1 - (float)iw23;
wi13 = 0.5*(0.5-dx1)*(0.5-dx1);
wi23 = 0.75-dx1*dx1;
wi33 = 0.5*(0.5+dx1)*(0.5+dx1);
iw13 = iw23-1;
iw33 = iw23+1;
if(iw23 == 0){
iw13 = nmesh-1;
}else if(iw23 == nmesh-1){
iw33 = 0;
}else if(iw23 == nmesh){
iw23 = 0;
iw33 = 1;
}
wi11 *= ptcl[p].mass;
wi21 *= ptcl[p].mass;
wi31 *= ptcl[p].mass;
RHO(iw11,iw12,iw13)=RHO(iw11,iw12,iw13)+wi11*wi12*wi13;
RHO(iw21,iw12,iw13)=RHO(iw21,iw12,iw13)+wi21*wi12*wi13;
RHO(iw31,iw12,iw13)=RHO(iw31,iw12,iw13)+wi31*wi12*wi13;
RHO(iw11,iw22,iw13)=RHO(iw11,iw22,iw13)+wi11*wi22*wi13;
RHO(iw21,iw22,iw13)=RHO(iw21,iw22,iw13)+wi21*wi22*wi13;
RHO(iw31,iw22,iw13)=RHO(iw31,iw22,iw13)+wi31*wi22*wi13;
RHO(iw11,iw32,iw13)=RHO(iw11,iw32,iw13)+wi11*wi32*wi13;
RHO(iw21,iw32,iw13)=RHO(iw21,iw32,iw13)+wi21*wi32*wi13;
RHO(iw31,iw32,iw13)=RHO(iw31,iw32,iw13)+wi31*wi32*wi13;
RHO(iw11,iw12,iw23)=RHO(iw11,iw12,iw23)+wi11*wi12*wi23;
RHO(iw21,iw12,iw23)=RHO(iw21,iw12,iw23)+wi21*wi12*wi23;
RHO(iw31,iw12,iw23)=RHO(iw31,iw12,iw23)+wi31*wi12*wi23;
RHO(iw11,iw22,iw23)=RHO(iw11,iw22,iw23)+wi11*wi22*wi23;
RHO(iw21,iw22,iw23)=RHO(iw21,iw22,iw23)+wi21*wi22*wi23;
RHO(iw31,iw22,iw23)=RHO(iw31,iw22,iw23)+wi31*wi22*wi23;
RHO(iw11,iw32,iw23)=RHO(iw11,iw32,iw23)+wi11*wi32*wi23;
RHO(iw21,iw32,iw23)=RHO(iw21,iw32,iw23)+wi21*wi32*wi23;
RHO(iw31,iw32,iw23)=RHO(iw31,iw32,iw23)+wi31*wi32*wi23;
RHO(iw11,iw12,iw33)=RHO(iw11,iw12,iw33)+wi11*wi12*wi33;
RHO(iw21,iw12,iw33)=RHO(iw21,iw12,iw33)+wi21*wi12*wi33;
RHO(iw31,iw12,iw33)=RHO(iw31,iw12,iw33)+wi31*wi12*wi33;
RHO(iw11,iw22,iw33)=RHO(iw11,iw22,iw33)+wi11*wi22*wi33;
RHO(iw21,iw22,iw33)=RHO(iw21,iw22,iw33)+wi21*wi22*wi33;
RHO(iw31,iw22,iw33)=RHO(iw31,iw22,iw33)+wi31*wi22*wi33;
RHO(iw11,iw32,iw33)=RHO(iw11,iw32,iw33)+wi11*wi32*wi33;
RHO(iw21,iw32,iw33)=RHO(iw21,iw32,iw33)+wi21*wi32*wi33;
RHO(iw31,iw32,iw33)=RHO(iw31,iw32,iw33)+wi31*wi32*wi33;
}
return;
}
/* Apply the L-BFGS Strang's two-loop recursion to compute a search
direction. */
static opk_status_t
apply(opk_vmlmn_t* opt, const opk_vector_t* g)
{
double sty, yty;
opk_index_t j, k;
if (opt->mp < 1) {
/* Will use the steepest descent direction. */
return OPK_NOT_POSITIVE_DEFINITE;
}
COPY(opt->d, g);
if (opt->method != OPK_VMLMN) {
/* Apply the original L-BFGS Strang's two-loop recursion. */
for (j = 1; j <= opt->mp; ++j) {
k = slot(opt, j);
if (RHO(k) > 0) {
BETA(k) = RHO(k)*DOT(opt->d, S(k));
UPDATE(opt->d, -BETA(k), Y(k));
}
}
if (opt->gamma != 1) {
/* Apply initial inverse Hessian approximation. */
SCALE(opt->d, opt->gamma);
}
for (j = opt->mp; j >= 1; --j) {
k = slot(opt, j);
if (RHO(k) > 0) {
UPDATE(opt->d, BETA(k) - RHO(k)*DOT(opt->d, Y(k)), S(k));
}
}
} else {
/* Apply L-BFGS Strang's two-loop recursion restricted to the subspace of
free variables. */
opt->gamma = 0;
for (j = 1; j <= opt->mp; ++j) {
k = slot(opt, j);
sty = WDOT(Y(k), S(k));
if (sty <= 0) {
RHO(k) = 0;
continue;
}
RHO(k) = 1/sty;
BETA(k) = RHO(k)*WDOT(opt->d, S(k));
UPDATE(opt->d, -BETA(k), Y(k));
if (opt->gamma == 0) {
yty = WDOT(Y(k), Y(k));
if (yty > 0) {
opt->gamma = sty/yty;
}
}
}
if (opt->gamma != 1) {
if (opt->gamma <= 0) {
/* Force using the steepest descent direction. */
return OPK_NOT_POSITIVE_DEFINITE;
}
SCALE(opt->d, opt->gamma);
}
for (j = opt->mp; j >= 1; --j) {
k = slot(opt, j);
if (RHO(k) > 0) {
UPDATE(opt->d, BETA(k) - RHO(k)*WDOT(opt->d, Y(k)), S(k));
}
}
}
if (opt->bounds != 0) {
/* Enforce search direction to belong to the subset of the free
variables. */
opk_vproduct(opt->d, opt->w, opt->d);
}
return OPK_SUCCESS;
}