/*--------------------------------------------------------------------------*/
fint hov_forward_(fint* ftag,
fint* fm,
fint* fn,
fint* fd,
fint* fp,
fdouble* fbase,
fdouble* fx,
fdouble* fvalue,
fdouble* fy) {
int rc= -1;
int tag=*ftag, m=*fm, n=*fn, d=*fd, p=*fp;
double* base = myalloc1(n);
double* value = myalloc1(m);
double*** X = myalloc3(n,p,d);
double*** Y = myalloc3(m,p,d);
spread1(n,fbase,base);
spread3(n,p,d,fx,X);
rc= hov_forward(tag,m,n,d,p,base,X,value,Y);
pack3(m,p,d,Y,fy);
pack1(m,value,fvalue);
free((char*)**X);
free((char*)*X);
free((char*)X);
free((char*)**Y);
free((char*)*Y);
free((char*)Y);
free((char*)base);
free((char*)value);
return rc;
}
/* accodec(n, tau, d, Z[n][n][d+1], B[n][n][d+1], nz[n][n]) */
fint accodec_(fint* fn, /* space dimension */
fdouble* ftau, /* scaling defaults to 1.0 */
fint* fdeg, /* highest degree */
fdouble* fa, /* input tensor of "partial" Jacobians */
fdouble* fb) /* output tensor of "total" Jacobians */
{
int rc= 1;
int n=*fn, deg=*fdeg;
double tau=*ftau;
double*** A = myalloc3(n,n,deg);
double*** B = myalloc3(n,n,deg);
spread3(n,n,deg,fa,A);
accodec(n,tau,deg,A,B,0);
pack3(n,n,deg,B,fb);
free((char*)**A);
free((char*)*A);
free((char*)A);
free((char*)**B);
free((char*)*B);
free((char*)B);
return rc;
}
/*--------------------------------------------------------------------------*/
fint hov_ti_reverse_(
fint* ftag,
fint* fm,
fint* fn,
fint* fd,
fint* fq,
fdouble* fu,
fdouble* fz) {
int rc=-1;
int tag=*ftag, m=*fm, n=*fn, d=*fd, q=*fq;
double*** U = myalloc3(q,m,d+1);
double*** Z = myalloc3(q,n,d+1);
short ** nop = 0;
spread3(q,m,d+1,fu,U);
rc=hov_ti_reverse(tag,m,n,d,q,U,Z,nop);
pack3(q,n,d+1,Z,fz);
free((char*)**Z);
free((char*)*Z);
free((char*)Z);
free((char*)**U);
free((char*)*U);
free((char*)U);
return rc;
}
int tensor_eval( int tag, int m, int n, int d, int p,
double* x, double **tensor, double **S ) {
static int bd,dim;
static int dold,pold;
static struct item *coeff_list;
int i,j,k,dimten,ctr;
int **jm, jmbd=0;
int *it = (int*) malloc(d*sizeof(int));
double *y = (double*) malloc(m*sizeof(double));
double*** X;
double*** Y;
struct item *ptr[10];
int rc = 3;
dimten=binomi(p+d,d);
for (i=0; i<m; i++)
for (j=0; j<dimten; j++)
tensor[i][j] = 0;
if (d == 0) {
MINDEC(rc,zos_forward(1,m,n,0,x,y));
} else {
if ((d != dold) || (p != pold)) {
if (pold) {
dim = binomi(pold+dold-1,dold);
freecoefflist(dim,coeff_list);
free((char*) coeff_list);
}
dim = binomi(p+d-1,d);
if (dim < 10)
bd = dim;
else
bd = 10;
coeff_list = (struct item *) malloc(sizeof(struct item)*dim);
coeff(p,d, coeff_list);
dold = d;
pold = p;
}
jmbd = bd;
jm = (int **) malloc(jmbd*sizeof(int*));
for (i=0; i<jmbd; i++)
jm[i] = (int *) malloc(p*sizeof(int));
if (d == 1) {
X = myalloc3(1,n,bd);
Y = myalloc3(1,m,bd);
ctr = 0;
it[0] = 0;
for (i=0; i<dim; i++) /* sum over all multiindices jm with |jm| = d */
{ it[0] = it[0]+1;
convert(p,d,it,jm[ctr]);
ptr[ctr] = &coeff_list[i];
if (ctr < bd-1)
ctr += 1;
else {
multma2vec2(n,p,bd,X[0],S,jm);
MINDEC(rc,fov_forward(tag,m,n,bd,x,X[0],y,Y[0]));
for (k=0; k<bd; k++)
do {
for (j=0; j<m; j++)
tensor[j][ptr[k]->a] += Y[0][j][k]*ptr[k]->c;
ptr[k] = ptr[k]->next;
} while (ptr[k] != NULL);
if (dim-i < bd)
bd = dim-i-1;
ctr = 0;
}
}
} else {
X = myalloc3(n,bd,d);
Y = myalloc3(m,bd,d);
ctr = 0;
for (i=0; i<d-1; i++)
it[i] = 1;
it[d-1] = 0;
for (i=0; i<dim; i++) /* sum over all multiindices jm with |jm| = d */
{ it[d-1] = it[d-1]+1;
for (j=d-2; j>=0; j--)
it[j] = it[j] + it[j+1]/(p+1);
for (j=1; j<d; j++)
if (it[j] > p)
it[j] = it[j-1];
convert(p,d,it,jm[ctr]);
ptr[ctr] = &coeff_list[i];
if (ctr < bd-1)
ctr += 1;
else {
multma3vec2(n,p,d,bd,X,S,jm);
MINDEC(rc,hov_forward(tag,m,n,d,bd,x,X,y,Y));
for (k=0; k<bd; k++)
do {
for (j=0; j<m; j++)
tensor[j][ptr[k]->a] += Y[j][k][ptr[k]->b-1]*ptr[k]->c;
ptr[k] = ptr[k]->next;
} while (ptr[k] != NULL);
if (dim-i < bd)
bd = dim-i-1;
ctr = 0;
}
}
}
for (i=0; i<jmbd; i++)
free((char*) *(jm+i));
free((char*) jm);
free((char*) **X);
free((char*) *X);
free((char*) X);
free((char*) **Y);
free((char*) *Y);
free((char*) Y);
}
for(i=0;i<m;i++)
tensor[i][0] = y[i];
bd = jmbd;
free((char*) y);
free((char*) it);
return rc;
}
int inverse_Taylor_prop( unsigned short tag, int n, int d,
double** Y, double** X ) {
int i,j,l,q;
static double **I;
register double bi;
static double** Xhelp;
static double** W;
static double* xold;
static double ***A;
static double *w;
static int *dd;
static double *b;
static int nax,dax,bd,cgd;
static short **nonzero;
short* nz;
double* Aij;
double* Xj;
int ii, di, da, Di;
int rc = 3;
/* Re/Allocation Stuff */
if ((n != nax) || (d != dax)) {
if (nax) {
free(**A);
free(*A);
free(A);
free(*I);
free(I);
free(*W);
free(W);
free(*Xhelp);
free(Xhelp);
free(w);
free(xold);
free(*nonzero);
free(nonzero);
free(dd);
free(b);
}
A = myalloc3(n,n,d+1);
I = myalloc2(n,n);
W = myalloc2(n,d);
Xhelp = myalloc2(n,d);
w = myalloc1(n);
dd = (int*)malloc((d+1)*sizeof(int));
b = (double*)malloc(n*sizeof(double));
xold = (double*)malloc(n*sizeof(double));
nonzero = (short**)malloc(n*sizeof(short*));
nz = (short*)malloc(n*n*sizeof(short));
for (i=0; i<n; i++) {
nonzero[i] = nz;
nz = nz + n;
xold[i] = 0;
for (j=0; j<n; j++)
I[i][j]=(i==j)?1.0:0.0;
}
cgd = 1;
nax=n;
dax=d;
dd[0] = d+1;
i = -1;
while(dd[++i] > 1)
dd[i+1] = (int)ceil(dd[i]*0.5);
bd = i+1;
}
if (cgd == 0)
for (i=0; i<n; i++)
if (X[i][0] != xold[i])
cgd = 1;
if (cgd == 1) {
cgd = 0;
for (i=0; i<n; i++)
xold[i] = X[i][0];
MINDEC(rc,jac_solv(tag,n,xold,b,0,1));
if (rc == -3)
return -3;
}
ii = bd;
for (i=0; i<n; i++)
for (j=0; j<d; j++)
Xhelp[i][j] = X[i][j+1];
while (--ii > 0) {
di = dd[ii-1]-1;
Di = dd[ii-1]-dd[ii]-1;
MINDEC(rc,hos_forward(tag,n,n,di,Di+1,xold,Xhelp,w,W));
MINDEC(rc,hov_reverse(tag,n,n,Di,n,I,A,nonzero));
da = dd[ii];
for (l=da; l<dd[ii-1]; l++) {
for (i=0; i<n; i++) {
if (l == 0)
bi = w[i]-Y[i][0];
else
bi = W[i][l-1]-Y[i][l];
for (j=0; j<n; j++)
if (nonzero[i][j]>1) {
Aij = A[i][j];
Xj = X[j]+l;
for (q=da; q<l; q++)
bi += (*(++Aij))*(*(--Xj));
}
b[i] = -bi;
}
MINDEC(rc,jac_solv(tag,n,xold,b,0,2));
if (rc == -3)
return -3;
for (i=0; i<n; i++) {
X[i][l] += b[i];
/* 981214 new nl */
Xhelp[i][l-1] += b[i];
}
}
}
return rc;
}
double evaluate_derivatives(int n, int m, double* x, int* options) {
int order = options[0];
int nnz;
double t1 = k_getTime();
if (options[1] == 0) { // Teed = new double*[n];
assert(m == 1);
double** seed = new double*[n];
for (int i = 0; i < n; i++) {
seed[i] = new double[n];
for (int j = 0; j < n; j++) {
seed[i][j] = ((i==j)?1.0:0.0);
}
}
int dim = binomi(n+order, order);
double** tensorhelp = myalloc2(1, dim);
tensor_eval(TAG, 1, n, order, n, x, tensorhelp, seed);
for (int i = 0; i < n; i++) {
delete[] seed[i];
}
delete[] seed;
myfree2(tensorhelp);
} else {
if (order == 2) { // Hessian
assert(m == 1);
if (options[1] == 1 || options[1] == 2) { // Direct or Indirect
int opt[2] = {0, 0}; // default is indirect;
if (options[1] == 1) {opt[0] = 1;} // set direct;
unsigned int * rind = NULL;
unsigned int * cind = NULL;
double * values = NULL;
sparse_hess(TAG, n, 0, x, &nnz, &rind, &cind, &values, opt);
#ifdef PRINT_RESULT
for (int i = 0; i < nnz; i++) {
printf("H[%d, %d] = %.6f\n", rind[i], cind[i], values[i]);
}
#endif
free(rind);
free(cind);
free(values);
} else if (options[1] == 3) { // FullHess
double** H = new double*[n];
for (int i = 0; i < n; i++) {
H[i] = new double[n];
}
hessian(TAG, n, x, H);
nnz = n*n;
#ifdef PRINT_RESULT
for (int i = 0; i < n; i++) {
for (int j = 0; j <= i; j++) {
printf("H[%d, %d] = %.6f\n", i, j, H[i][j]);
}
}
#endif
for (int i = 0; i < n; i++) {
delete[] H[i];
}
delete[] H;
} else if (options[1] == 4) { // Single Hv
double v[n];
double Hv[n];
for (int i = 0; i < n; i++) {
v[i] = 1.0;
Hv[i] = 0.0;
}
hess_vec(TAG, n, x, v, Hv);
nnz = n;
} else if (options[1] == 5) { // dense second order reverse
double** H = new double*[n];
for (int i = 0; i < n; i++) {
H[i] = new double[n];
}
hessian_dense(TAG, n, x, H);
nnz = n*n;
#ifdef PRINT_RESULT
for (int i = 0; i < n; i++) {
for (int j = 0; j <= i; j++) {
printf("H[%d, %d] = %.6f\n", i, j, H[i][j]);
}
}
#endif
for (int i = 0; i < n; i++) {
delete[] H[i];
}
delete[] H;
} else if (options[1] == 6){ // sparse second order reverse
unsigned int * rind = NULL;
unsigned int * cind = NULL;
double * values = NULL;
hessian_sparse(TAG, n, x, &nnz, &rind, &cind, &values);
#ifdef PRINT_RESULT
for (int i = 0; i < nnz; i++) {
printf("H[%d, %d] = %.6f\n", rind[i], cind[i], values[i]);
}
#endif
free(rind);
free(cind);
free(values);
} else if (options[1] == 7) { // Hess-matrix options
double** H = myalloc2(n, n);
double y;
double*** Xppp = myalloc3(n, n, 1);
double*** Yppp = myalloc3(1, n, 1);
for (int i = 0; i < n; i++) {
for (int j = 0; j < n; j++) {
Xppp[i][j][0] = 0;
}
Xppp[i][i][0] = 1.0;
}
double** Upp = myalloc2(1,2);
Upp[0][0] = 1; Upp[0][1] = 0;
double*** Zppp = myalloc3(n, n, 2);
int ret_val = hov_wk_forward(TAG,1,n,1,2,n,x,Xppp,&y,Yppp);
ret_val = hos_ov_reverse(TAG,1,n,1,n,Upp,Zppp);
for (int i = 0; i < n; ++i) {
for (int l = 0; l < n; ++l) {
H[l][i] = Zppp[i][l][1];
}
}
#ifdef PRINT_RESULT
for (int i = 0; i < n; i++) {
for (int j = 0; j <= i; j++) {
printf("H[%d, %d] = %.6f\n", i, j, H[i][j]);
}
}
#endif
myfree2(H);
myfree3(Xppp);
myfree3(Yppp);
myfree2(Upp);
myfree3(Zppp);
}
} else if (order == 1) { // Gradient or Jacobian
if (m == 1) { // gradient
double g[n];
gradient(TAG, n, x, g);
#ifdef PRINT_RESULT
for (int i = 0; i < n; i++) {
printf("g[%d] = %.6f\n", i, g[i]);
}
#endif
} else { // jacobian
double** J = new double*[m];
for (int i = 0; i < m; i++) {
J[i] = new double[n];
}
jacobian(TAG, m, n, x, J);
#ifdef PRINT_RESULT
for (int i = 0; i < m; i++) {
for (int j = 0; j < n; j++) {
printf("J[%d][%d] = %.6f\n", i, j, J[i][j]);
}
}
#endif
for (int i = 0; i < m; i++) {
delete[] J[i];
}
delete[] J;
}
nnz = n*m;
}
}
double time_elapsed = k_getTime() - t1;
size_t size;
size_t** tind;
double* values;
printf("ADOLC nnz[%d] method[%d] order[%d] timing = %.6f\n", nnz, options[1], options[0], time_elapsed);
return time_elapsed;
}
