BEGIN_C_DECLS
/*--------------------------------------------------------------------------*/
fint hos_forward_(fint* ftag,
fint* fm,
fint* fn,
fint* fd,
fint* fk,
fdouble* fbase,
fdouble* fx,
fdouble* fvalue,
fdouble* fy) {
int rc= -1;
int tag=*ftag, m=*fm, n=*fn, d=*fd, k=*fk;
double* base = myalloc1(n);
double* value = myalloc1(m);
double** X = myalloc2(n,d);
double** Y = myalloc2(m,d);
spread1(n,fbase,base);
spread2(n,d,fx,X);
rc= hos_forward(tag,m,n,d,k,base,X,value,Y);
pack2(m,d,Y,fy);
pack1(m,value,fvalue);
free((char*)*X);
free((char*)X);
free((char*)*Y);
free((char*)Y);
free((char*)base);
free((char*)value);
return rc;
}
/*--------------------------------------------------------------------------*/
fint fov_forward_(fint* ftag,
fint* fm,
fint* fn,
fint* fp,
fdouble* fbase,
fdouble* fx,
fdouble* fvalue,
fdouble* fy) {
int rc= -1;
int tag=*ftag, m=*fm, n=*fn, p=*fp;
double* base = myalloc1(n);
double* value = myalloc1(m);
double** X = myalloc2(n,p);
double** Y = myalloc2(m,p);
spread1(n,fbase,base);
spread2(n,p,fx,X);
rc= fov_forward(tag,m,n,p,base,X,value,Y);
pack2(m,p,Y,fy);
pack1(m,value,fvalue);
free((char*)*X);
free((char*)X);
free((char*)*Y);
free((char*)Y);
free((char*)base);
free((char*)value);
return rc;
}
void * myalloc(int size) {
void *myalloc(int size);
void *ptr = myalloc2(size);
if (ptr == NULL) {
coalesce();
ptr = myalloc2(size);
}
return ptr;
}
BEGIN_C_DECLS
/****************************************************************************/
/* DRIVERS FOR ODEs */
/*--------------------------------------------------------------------------*/
/* forodec */
/* forodec(tag, n, tau, dold, dnew, X[n][d+1]) */
fint forodec_(fint* ftag, /* tape identifier */
fint* fn, /* space dimension */
fdouble* ftau, /* scaling defaults to 1.0 */
fint* fdol, /* previous degree defaults to zero */
fint* fdeg, /* New degree of consistency */
fdouble* fy) /* Taylor series */
{
int rc= -1;
short tag= (short) *ftag;
int n=*fn, dol=*fdol, deg=*fdeg;
int i;
double tau=*ftau;
double** Y = myalloc2(n,deg+1);
for(i=0;i<n;i++)
*Y[i] = fy[i];
rc= forodec(tag,n,tau,dol,deg,Y);
pack2(n,deg+1,Y,fy);
free((char*)*Y);
free((char*)Y);
return rc;
}
void mallocEscapeFreeCustomAlloc2() {
int *p = malloc(12);
myfoo(p);
free(p);
myalloc2(&p);
free(p); // no warning
}
/*--------------------------------------------------------------------------*/
fint fov_reverse_(fint* ftag,
fint* fm,
fint* fn,
fint* fq,
fdouble* fu,
fdouble* fz) {
int rc=-1;
int tag=*ftag, m=*fm, n=*fn, q=*fq;
double** U = myalloc2(q,m);
double** Z = myalloc2(q,n);
spread2(q,m,fu,U);
rc=fov_reverse(tag,m,n,q,U,Z);
pack2(q,n,Z,fz);
free((char*)*Z);
free((char*)Z);
free((char*)*U);
free((char*)U);
return rc;
}
/*--------------------------------------------------------------------------*/
fint hos_ti_reverse_(
fint* ftag,
fint* fm,
fint* fn,
fint* fd,
fdouble* fu,
fdouble* fz) {
int rc=-1;
int tag=*ftag, m=*fm, n=*fn, d=*fd;
double** Z = myalloc2(n,d+1);
double** U = myalloc2(m,d+1);
spread2(m,d+1,fu,U);
rc=hos_ti_reverse(tag,m,n,d,U,Z);
pack2(n,d+1,Z,fz);
free((char*)*Z);
free((char*)Z);
free((char*)*U);
free((char*)U);
return rc;
}
/* jacobian(tag, m, n, x[n], J[m][n]) */
fint jacobian_(fint* ftag,
fint* fdepen,
fint* findep,
fdouble *fargument,
fdouble *fjac) {
int rc= -1;
int tag=*ftag, depen=*fdepen, indep=*findep;
double** Jac = myalloc2(depen,indep);
double* argument = myalloc1(indep);
spread1(indep,fargument,argument);
rc= jacobian(tag,depen,indep,argument,Jac);
pack2(depen,indep,Jac,fjac);
free((char*)*Jac);
free((char*)Jac);
free((char*)argument);
return rc;
}
/* hessian(tag, n, x[n], lower triangle of H[n][n]) */
fint hessian_(fint* ftag,
fint* fn,
fdouble* fx,
fdouble* fh) /* length of h should be n*n but the
upper half of this matrix remains unchanged */
{
int rc= -1;
int tag=*ftag, n=*fn;
double** H = myalloc2(n,n);
double* x = myalloc1(n);
spread1(n,fx,x);
rc= hessian(tag,n,x,H);
pack2(n,n,H,fh);
free((char*)*H);
free((char*)H);
free((char*)x);
return rc;
}
/*--------------------------------------------------------------------------*/
fint hos_reverse_(fint* ftag,
fint* fm,
fint* fn,
fint* fd,
fdouble* fu,
fdouble* fz) {
int rc=-1;
int tag=*ftag, m=*fm, n=*fn, d=*fd;
double** Z = myalloc2(n,d+1);
double* u = myalloc1(m);
spread1(m,fu,u);
rc=hos_reverse(tag,m,n,d,u,Z);
pack2(n,d+1,Z,fz);
free((char*)*Z);
free((char*)Z);
free((char*)u);
return rc;
}
/*--------------------------------------------------------------------------*/
fint hov_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 = myalloc2(q,m);
double*** Z = myalloc3(q,n,d+1);
short ** nop = 0;
spread2(q,m,fu,U);
rc=hov_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);
return rc;
}
BEGIN_C_DECLS
/****************************************************************************/
/* DRIVERS FOR ODEs */
/*--------------------------------------------------------------------------*/
/* forodec */
/* forodec(tag, n, tau, dold, dnew, X[n][d+1]) */
int forodec(short tag, /* tape identifier */
int n, /* space dimension */
double tau, /* scaling defaults to 1.0 */
int dol, /* previous degree defaults to zero */
int deg, /* New degree of consistency */
double** Y) /* Taylor series */
{
/*********************************************************************
This is assumed to be the autonomous case.
Here we are just going around computing the vectors
y[][j] for dol < j <= deg
by successive calls to forward that works on the tape identified
by tag. This tape (array of file) must obviously have been
generated by a the execution of an active section between
trace_on and trace_off with n independent and n dependent variables
y must have been set up as pointer to an array of n pointers
to double arrays containing at least deg+1 components.
The scaling by tau is sometimes necessary to avoid overflow.
**********************************************************************/
int rc= 3;
int i, j, k;
double taut;
ADOLC_OPENMP_THREAD_NUMBER;
ADOLC_OPENMP_GET_THREAD_NUMBER;
if ( n > ADOLC_CURRENT_TAPE_INFOS.pTapeInfos.forodec_nax ||
deg > ADOLC_CURRENT_TAPE_INFOS.pTapeInfos.forodec_dax )
{
if (ADOLC_CURRENT_TAPE_INFOS.pTapeInfos.forodec_nax) {
myfree1(ADOLC_CURRENT_TAPE_INFOS.pTapeInfos.forodec_y);
myfree1(ADOLC_CURRENT_TAPE_INFOS.pTapeInfos.forodec_z);
myfree2(ADOLC_CURRENT_TAPE_INFOS.pTapeInfos.forodec_Z);
}
ADOLC_CURRENT_TAPE_INFOS.pTapeInfos.forodec_Z = myalloc2(n, deg);
ADOLC_CURRENT_TAPE_INFOS.pTapeInfos.forodec_z = myalloc1(n);
ADOLC_CURRENT_TAPE_INFOS.pTapeInfos.forodec_y = myalloc1(n);
ADOLC_CURRENT_TAPE_INFOS.pTapeInfos.forodec_nax = n;
ADOLC_CURRENT_TAPE_INFOS.pTapeInfos.forodec_dax = deg;
}
for (i = 0; i < n; ++i) {
ADOLC_CURRENT_TAPE_INFOS.pTapeInfos.forodec_y[i] = Y[i][0];
/*printf("y[%i] = %f\n",i,y[i]);*/
for (k = 0; k < deg; ++k) {
Y[i][k] = Y[i][k+1];
/*printf("Y[%i][%i] = %f\n",i,k,Y[i][k]);*/
}
}
/****** Here we get going ********/
if (dol == 0) {
j = dol; /* j = 0 */
k = (deg) * (j == deg-1 ) ; /* keep death values in prepration */
MINDEC(rc, zos_forward(tag, n, n, k,
ADOLC_CURRENT_TAPE_INFOS.pTapeInfos.forodec_y,
ADOLC_CURRENT_TAPE_INFOS.pTapeInfos.forodec_z));
/* for reverse called by jacode */
if(rc < 0) return rc;
taut = tau / (1 + j); /* only the last time through. */
for (i = 0; i < n; ++i)
Y[i][j] = taut * ADOLC_CURRENT_TAPE_INFOS.pTapeInfos.forodec_z[i];
dol++; /* !!! */
}
for (j = dol; j < deg; ++j) {
k = (deg)*(j == deg-1) ; /* keep death values in prepration */
MINDEC(rc, hos_forward(tag, n, n, j, k,
ADOLC_CURRENT_TAPE_INFOS.pTapeInfos.forodec_y,
Y, ADOLC_CURRENT_TAPE_INFOS.pTapeInfos.forodec_z,
ADOLC_CURRENT_TAPE_INFOS.pTapeInfos.forodec_Z));
/* for reverse called by jacode */
if( rc < 0) return rc;
taut = tau / (1 + j); /* only the last time through. */
for (i = 0; i < n; ++i)
Y[i][j] = taut *
ADOLC_CURRENT_TAPE_INFOS.pTapeInfos.forodec_Z[i][j-1];
}
/****** Done ********/
for (i = 0; i < n; ++i) {
for (k = deg; k > 0; --k) {
Y[i][k] = Y[i][k-1];
/*printf("Y[%i][%i] = %f\n",i,k,Y[i][k]);*/
}
Y[i][0] = ADOLC_CURRENT_TAPE_INFOS.pTapeInfos.forodec_y[i];
/*printf("Y[%i][0] = %f\n",i,Y[i][0]);*/
}
return rc;
}
int inverse_tensor_eval( int tag, int n, int d, int p,
double *x, double **tensor, double** S ) {
static int dim;
static int dold,pold;
static struct item *coeff_list;
int i,j,dimten;
int *it = (int*) malloc(d*sizeof(int));
double** X;
double** Y;
int *jm;
double *y = (double*) malloc(n*sizeof(double));
struct item *ptr;
int rc = 3;
dimten=binomi(p+d,d);
for(i=0;i<n;i++)
for(j=0;j<dimten;j++)
tensor[i][j] = 0;
MINDEC(rc,zos_forward(1,n,n,0,x,y));
if (d > 0) {
if ((d != dold) || (p != pold)) {
if (pold) { /* olvo 980728 */
dim = binomi(pold+dold-1,dold);
freecoefflist(dim,coeff_list);
free((char*) coeff_list);
}
dim = binomi(p+d-1,d);
coeff_list = (struct item *) malloc(sizeof(struct item)*dim);
coeff(p,d, coeff_list);
dold = d;
pold = p;
}
jm = (int *)malloc(sizeof(int)*p);
X = myalloc2(n,d+1);
Y = myalloc2(n,d+1);
for (i=0; i<n; i++) {
X[i][0] = x[i];
for (j=1; j<d; j++)
X[i][j] = 0;
Y[i][0] = y[i];
}
if (d == 1) {
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);
ptr = &coeff_list[i];
multma2vec1(n,p,d,Y,S,jm);
MINDEC(rc,inverse_Taylor_prop(tag,n,d,Y,X));
if (rc == -3)
return -3;
do {
for(j=0;j<n;j++)
tensor[j][ptr->a] += X[j][ptr->b]*ptr->c;
ptr = ptr->next;
} while (ptr != NULL);
}
} else {
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);
multma2vec1(n,p,d,Y,S,jm); /* Store S*jm in Y */
MINDEC(rc,inverse_Taylor_prop(tag,n,d,Y,X));
if (rc == -3)
return -3;
ptr = &coeff_list[i];
do {
for(j=0;j<n;j++)
tensor[j][ptr->a] += X[j][ptr->b]*ptr->c;
ptr = ptr->next;
} while (ptr != NULL);
}
}
free((char*) jm);
free((char*) *X);
free((char*) X);
free((char*) *Y);
free((char*) Y);
}
for(i=0;i<n;i++)
tensor[i][0] = x[i];
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;
}
int jac_solv( unsigned short tag, int n, double* x, double* b,
unsigned short sparse, unsigned short mode ) {
static double **J;
static double **I;
static double *y;
static double *xold;
static int* ri;
static int* ci;
static int nax,tagold,modeold,cgd;
int i,j;
int rc = 3;
if ((n != nax) || (tag != tagold)) {
if (nax) {
free(*J);
free(J);
free(*I);
free(I);
free(xold);
free(ri);
free(ci);
free(y);
}
J = myalloc2(n,n);
I = myalloc2(n,n);
y = myalloc1(n);
xold = myalloc1(n);
ri = (int*)malloc(n*sizeof(int));
ci = (int*)malloc(n*sizeof(int));
for (i=0; i<n; i++) {
xold[i] = 0;
for (j=0;j<n;j++)
I[i][j]=(i==j)?1.0:0.0;
}
cgd = 1;
modeold = 0;
nax = n;
tagold = tag;
}
if (cgd == 0)
for (i=0; i<n; i++)
if (x[i] != xold[i])
cgd = 1;
if (cgd == 1)
for (i=0; i<n; i++)
xold[i] = x[i];
switch(mode) {
case 0:
MINDEC(rc,zos_forward(tag,n,n,1,x,y));
MINDEC(rc,fov_reverse(tag,n,n,n,I,J));
break;
case 1:
if ((modeold == 0) || (cgd == 1)) {
MINDEC(rc,zos_forward(tag,n,n,1,x,y));
MINDEC(rc,fov_reverse(tag,n,n,n,I,J));
}
if (LUFactorization(J,n,ri,ci) < 0)
return -3;
modeold = 1;
break;
case 2:
if ((modeold < 1) || (cgd == 1)) {
MINDEC(rc,zos_forward(tag,n,n,1,x,y));
MINDEC(rc,fov_reverse(tag,n,n,n,I,J));
if (LUFactorization(J,n,ri,ci) < 0)
return -3;
}
GauszSolve(J,n,ri,ci,b);
modeold = 2;
break;
}
cgd = 0;
return rc;
}
int main(int argc, char *argv[]) {
int n=get_num_ind();
int i,j;
struct timeval tv1,tv2;
adouble *xad;
adouble fad;
double f;
double *x;
x=new double[n];
xad=new adouble[n];
get_initial_value(x);
printf("evaluating the function...");
trace_on(tag);
for(i=0;i<n;i++)
{
xad[i] <<= x[i];
}
fad=func_eval(xad);
fad >>= f;
trace_off();
printf("done!\n");
// printf("function value =<%10.20f>\n",f);
// function(tag,1,n,x,&f);
// printf("adolc func value=<%10.20f>\n",f);
//tape_doc(tag,1,n,x,&f);
#ifdef _compare_with_full
double **H;
H = myalloc2(n,n);
printf("computing full hessain....");
gettimeofday(&tv1,NULL);
hessian(tag,n,x,H);
printf("done\n");
gettimeofday(&tv2,NULL);
printf("Computing the full hessian cost %10.6f seconds\n",(tv2.tv_sec-tv1.tv_sec)+(double)(tv2.tv_usec-tv1.tv_usec)/1000000);
#ifdef _PRINTOUT
for(i=0;i<n;i++){
for(j=0;j<n;j++){
printf("H[%d][%d]=<%10.10f>",i,j,H[i][j]);
}
printf("\n");
}
printf("\n");
#endif
#endif
#ifdef edge_pushing
unsigned int *rind = NULL;
unsigned int *cind = NULL;
double *values = NULL;
int nnz;
int options[2];
options[0]=PRE_ACC;
options[1]=COMPUT_GRAPH;
gettimeofday(&tv1,NULL);
// edge_hess(tag, 1, n, x, &nnz, &rind, &cind, &values, options);
sparse_hess(tag,n,0,x, &nnz, &rind, &cind, &values, options);
gettimeofday(&tv2,NULL);
printf("Sparse Hessian: edge pushing cost %10.6f seconds\n",(tv2.tv_sec-tv1.tv_sec)+(double)(tv2.tv_usec-tv1.tv_usec)/1000000);
#ifdef _PRINTOUT
for(i=0;i<nnz;i++){
printf("<%d,%d>:<%10.10f>\n",cind[i],rind[i],values[i]);
// printf("%d %d \n", rind[i], cind[i]);
}
#endif
#endif
#ifdef _compare_with_full
#ifdef edge_pushing
compare_matrix(n,H,nnz,cind,rind,values);
#endif
myfree2(H);
#endif
#ifdef edge_pushing
printf("nnz=%d\n", nnz);
free(rind); rind=NULL;
free(cind); cind=NULL;
free(values); values=NULL;
#endif
delete[] x;
delete[] xad;
return 0;
}
int main(int argc, char *argv[]) {
int n=NUM_IND;
int i,j;
struct timeval tv1,tv2;
adouble *xad;
adouble fad;
double f;
double *x;
x=new double[n];
xad=new adouble[n];
get_initials(x, n);
// printf("evaluating the function...");
trace_on(tag);
for(i=0;i<n;i++)
{
xad[i] <<= x[i];
}
fad=eval_func<adouble>(xad, n);
fad >>= f;
trace_off();
// printf("done!\n");
std::cout << "y = " << f << std::endl;
#ifdef COMPARE_WITH_FULL_HESS
double **H;
H = myalloc2(n,n);
printf("computing full hessain....");
gettimeofday(&tv1,NULL);
hessian(tag,n,x,H);
printf("done\n");
gettimeofday(&tv2,NULL);
printf("Computing the full hessian cost %10.6f seconds\n",(tv2.tv_sec-tv1.tv_sec)+(double)(tv2.tv_usec-tv1.tv_usec)/1000000);
#ifdef PRINT_RESULTS
for(i=0;i<n;i++){
for(j=0;j<n;j++){
printf("H[%d][%d]=<%10.10f>",i,j,H[i][j]);
}
printf("\n");
}
printf("\n");
#endif
#endif
unsigned int *rind = NULL;
unsigned int *cind = NULL;
double *values = NULL;
int nnz;
int options[2];
#ifdef LIVARH
options[0]=0;
options[1]=1;
gettimeofday(&tv1,NULL);
edge_hess(tag, 1, n, x, &nnz, &rind, &cind, &values, options);
gettimeofday(&tv2,NULL);
printf("Sparse Hessian: LivarH cost %10.6f seconds\n",(tv2.tv_sec-tv1.tv_sec)+(double)(tv2.tv_usec-tv1.tv_usec)/1000000);
#endif
#ifdef LIVARHACC
options[0]=1;
options[1]=1;
gettimeofday(&tv1,NULL);
edge_hess(tag, 1, n, x, &nnz, &rind, &cind, &values, options);
gettimeofday(&tv2,NULL);
printf("Sparse Hessian: LivarHACC cost %10.6f seconds\n",(tv2.tv_sec-tv1.tv_sec)+(double)(tv2.tv_usec-tv1.tv_usec)/1000000);
#endif
// Sparse ADOL-C drivers report the upper matrix
#ifdef DIRECT
options[0]=0;
options[1]=1;
gettimeofday(&tv1,NULL);
sparse_hess(tag, n, 0, x, &nnz, &cind, &rind, &values, options);
gettimeofday(&tv2,NULL);
printf("Sparse Hessian: direct recovery cost %10.6f seconds\n",(tv2.tv_sec-tv1.tv_sec)+(double)(tv2.tv_usec-tv1.tv_usec)/1000000);
#endif
#ifdef INDIRECT
options[0]=0;
options[1]=0;
gettimeofday(&tv1,NULL);
sparse_hess(tag, n, 0, x, &nnz, &cind, &rind, &values, options);
gettimeofday(&tv2,NULL);
printf("Sparse Hessian: indirect recovery cost %10.6f seconds\n",(tv2.tv_sec-tv1.tv_sec)+(double)(tv2.tv_usec-tv1.tv_usec)/1000000);
#endif
#ifdef PRINT_RESULTS
for(i=0;i<nnz;i++){
printf("<%d,%d>:<%10.10f>\n",rind[i],cind[i],values[i]);
}
#endif
#ifdef COMPARE_WITH_FULL_HESS
compare_matrix(n,H,nnz,rind,cind,values);
myfree2(H);
#endif
free(rind); rind=NULL;
free(cind); cind=NULL;
free(values); values=NULL;
delete[] x;
delete[] xad;
return 0;
}
/* MAIN PROGRAM */
int main() { /*------------------------------------------------------------------------*/
/* variables */
const int tag = 1; // tape tag
const int size = 5; // system size
const int indep = size*size+size; // # of indeps
const int depen = size; // # of deps
double A[size][size], a1[size], a2[size], // passive variables
b[size], x[size];
adouble **AA, *AAp, *Abx; // active variables
double *args = myalloc1(indep); // arguments
double **jac = myalloc2(depen,indep); // the Jacobian
double *laghessvec = myalloc1(indep); // Hessian-vector product
int i,j;
/*------------------------------------------------------------------------*/
/* Info */
fprintf(stdout,"LINEAR SYSTEM SOLVING by "
"LU-DECOMPOSITION (ADOL-C Example)\n\n");
/*------------------------------------------------------------------------*/
/* Allocation und initialization of the system matrix */
AA = new adouble*[size];
AAp = new adouble[size*size];
for (i=0; i<size; i++) {
AA[i] = AAp;
AAp += size;
}
Abx = new adouble[size];
for(i=0; i<size; i++) {
a1[i] = i*0.25;
a2[i] = i*0.33;
}
for(i=0; i<size; i++) {
for(j=0; j<size; j++)
A[i][j] = a1[i]*a2[j];
A[i][i] += i+1;
b[i] = -i-1;
}
/*------------------------------------------------------------------------*/
/* Taping the computation of the determinant */
trace_on(tag);
/* marking indeps */
for(i=0; i<size; i++)
for(j=0; j<size; j++)
AA[i][j] <<= (args[i*size+j] = A[i][j]);
for(i=0; i<size; i++)
Abx[i] <<= (args[size*size+i] = b[i]);
/* LU-factorization and computation of solution */
LUfact(size,AA);
LUsolve(size,AA,Abx);
/* marking deps */
for (i=0; i<size; i++)
Abx[i] >>= x[i];
trace_off();
fprintf(stdout," x[0] (original): %16.4le\n",x[0]);
/*------------------------------------------------------------------------*/
/* Recomputation */
function(tag,depen,indep,args,x);
fprintf(stdout," x[0] (from tape): %16.4le\n",x[0]);
/*------------------------------------------------------------------------*/
/* Computation of Jacobian */
jacobian(tag,depen,indep,args,jac);
fprintf(stdout," Jacobian:\n");
for (i=0; i<depen; i++) {
for (j=0; j<indep; j++)
fprintf(stdout," %14.6le",jac[i][j]);
fprintf(stdout,"\n");
}
/*------------------------------------------------------------------------*/
/* Computation of Lagrange-Hessian-vector product */
lagra_hess_vec(tag,depen,indep,args,args,x,laghessvec);
fprintf(stdout," Part of Lagrange-Hessian-vector product:\n");
for (i=0; i<size; i++) {
for (j=0; j<size; j++)
fprintf(stdout," %14.6le",laghessvec[i*size+j]);
fprintf(stdout,"\n");
}
/*------------------------------------------------------------------------*/
/* Tape-documentation */
tape_doc(tag,depen,indep,args,x);
/*------------------------------------------------------------------------*/
/* Tape statistics */
int tape_stats[STAT_SIZE];
tapestats(tag,tape_stats);
fprintf(stdout,"\n independents %d\n",tape_stats[NUM_INDEPENDENTS]);
fprintf(stdout," dependents %d\n",tape_stats[NUM_DEPENDENTS]);
fprintf(stdout," operations %d\n",tape_stats[NUM_OPERATIONS]);
fprintf(stdout," operations buffer size %d\n",tape_stats[OP_BUFFER_SIZE]);
fprintf(stdout," locations buffer size %d\n",tape_stats[LOC_BUFFER_SIZE]);
fprintf(stdout," constants buffer size %d\n",tape_stats[VAL_BUFFER_SIZE]);
fprintf(stdout," maxlive %d\n",tape_stats[NUM_MAX_LIVES]);
fprintf(stdout," valstack size %d\n\n",tape_stats[TAY_STACK_SIZE]);
/*------------------------------------------------------------------------*/
/* That's it */
return 1;
}
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;
}