void EchoIt(MLINK stdlink,MLINK ml,bool b) {
bool inCompound = false;
int i;
double d;
char * s = 0;
char * t = 0;
long m,n;
switch(MLGetType(stdlink)) {
case MLTKINT;
MLGetInteger(stdlink,&i);
MLPutInteger(ml,i);
break;
case MLTKSYMB;
MLGetSymbol(stdlink,&s);
t = new char[strlen(s)+4];
strcpy(t,s);
strcat(t,"MXS");
MLPutSymbol(ml,t);
delete [] t;
MLDisownSymbol(stdlink,s);
break;
case MLTKSTR;
MLGetString(stdlink,&s);
MLPutString(ml,s);
MLDisownString(stdlink,s);
break;
case MLTKINT;
MLGetInteger(stdlink,&i);
MLPutInteger(ml,i);
break;
case MLTKFUNC;
MLGetFunction(stdlink,&s,m);
strcpy(t,s);
strcat(t,"MXS");
if(strcmp(s,"CompoundExpression")==0 && b) {
inCompound = true;
MLPutFunction(ml,t,2*m);
} else {
MLPutFunction(ml,t,m);
};
delete [] t;
for(long n=1;n<=m;++n) {
if(inCompound) {
MLPutFunction(ml,"Print",4L);
MLPutString(ml,"Function:");
MLPutString(ml,s);
MLPutString(ml," ");
MLPutInteger(ml,s_number);
++s_number;
};
EchoIt(stdlink,ml,b);
};
inCompound = false;
break;
default:
DBG();
break;
};
};
PetscErrorCode PetscViewerMathematicaPutMatrix(PetscViewer viewer, int m, int n, PetscReal *a)
{
PetscViewer_Mathematica *vmath = (PetscViewer_Mathematica*) viewer->data;
MLINK link = vmath->link; /* The link to Mathematica */
char *name;
PetscErrorCode ierr;
PetscFunctionBegin;
/* Determine the object name */
if (!vmath->objName) name = "mat";
else name = (char*) vmath->objName;
/* Send the dense matrix object */
MLPutFunction(link, "EvaluatePacket", 1);
MLPutFunction(link, "Set", 2);
MLPutSymbol(link, name);
MLPutFunction(link, "Transpose", 1);
MLPutFunction(link, "Partition", 2);
MLPutRealList(link, a, m*n);
MLPutInteger(link, m);
MLEndPacket(link);
/* Skip packets until ReturnPacket */
ierr = PetscViewerMathematicaSkipPackets(viewer, RETURNPKT);
CHKERRQ(ierr);
/* Skip ReturnPacket */
MLNewPacket(link);
PetscFunctionReturn(0);
}
void dd_MLWriteError(dd_PolyhedraPtr poly)
{
MLPutFunction(stdlink,"List",3);
MLPutFunction(stdlink,"List",0);
MLPutFunction(stdlink,"List",1);
MLPutString(stdlink,"Error occured: code");
MLPutFunction(stdlink,"List",1);
MLPutInteger(stdlink,poly->child->Error);
}
void MmaSink::put(long long x) {
#ifdef DEBUG_MMASINK
GBStream << "sink:long " << this << ' ' << x << '\n';
#endif
MLPutInteger(d_mlink,x);
#ifdef DEBUG_MMASINK
checkforerror();
#endif
++d_count;
};
void MmaSink::put(const Polynomial& x) {
#ifdef DEBUG_MMASINK
GBStream << "sink:polynomial " << this << ' ' << x << '\n';
#endif
int len = x.numberOfTerms();
if(len==0) {
MLPutInteger(d_mlink,0);
++d_count;
} else if(len==1) {
put(*x.begin());
} else {
MLPutFunction(d_mlink,"Plus",len);
++d_count;
d_count -= len;
PolynomialIterator w = x.begin();
while(len) {
put(*w);
--len;++w;
};
};
#ifdef DEBUG_MMASINK
checkforerror();
#endif
};
void MmaSink::put(const Monomial& x) {
#ifdef DEBUG_MMASINK
GBStream << "sink:monomial " << this << ' ' << x << '\n';
#endif
int len = x.numberOfFactors();
if(len==0) {
MLPutInteger(d_mlink,1);
++d_count;
} else if(len==1) {
put(*x.begin());
} else {
MLPutFunction(d_mlink,"NonCommutativeMultiply",len);
++d_count;
d_count -= len;
MonomialIterator w = x.begin();
while(len) {
put(*w);
--len;++w;
};
};
#ifdef DEBUG_MMASINK
checkforerror();
#endif
};
PetscErrorCode PetscViewerMathematicaPutCSRMatrix(PetscViewer viewer, int m, int n, int *i, int *j, PetscReal *a)
{
PetscViewer_Mathematica *vmath = (PetscViewer_Mathematica*) viewer->data;
MLINK link = vmath->link; /* The link to Mathematica */
const char *symbol;
char *name;
PetscBool match;
PetscErrorCode ierr;
PetscFunctionBegin;
/* Determine the object name */
if (!vmath->objName) name = "mat";
else name = (char*) vmath->objName;
/* Make sure Mathematica recognizes sparse matrices */
MLPutFunction(link, "EvaluatePacket", 1);
MLPutFunction(link, "Needs", 1);
MLPutString(link, "LinearAlgebra`CSRMatrix`");
MLEndPacket(link);
/* Skip packets until ReturnPacket */
ierr = PetscViewerMathematicaSkipPackets(viewer, RETURNPKT);
CHKERRQ(ierr);
/* Skip ReturnPacket */
MLNewPacket(link);
/* Send the CSRMatrix object */
MLPutFunction(link, "EvaluatePacket", 1);
MLPutFunction(link, "Set", 2);
MLPutSymbol(link, name);
MLPutFunction(link, "CSRMatrix", 5);
MLPutInteger(link, m);
MLPutInteger(link, n);
MLPutFunction(link, "Plus", 2);
MLPutIntegerList(link, i, m+1);
MLPutInteger(link, 1);
MLPutFunction(link, "Plus", 2);
MLPutIntegerList(link, j, i[m]);
MLPutInteger(link, 1);
MLPutRealList(link, a, i[m]);
MLEndPacket(link);
/* Skip packets until ReturnPacket */
ierr = PetscViewerMathematicaSkipPackets(viewer, RETURNPKT);
CHKERRQ(ierr);
/* Skip ReturnPacket */
MLNewPacket(link);
/* Check that matrix is valid */
MLPutFunction(link, "EvaluatePacket", 1);
MLPutFunction(link, "ValidQ", 1);
MLPutSymbol(link, name);
MLEndPacket(link);
ierr = PetscViewerMathematicaSkipPackets(viewer, RETURNPKT);
CHKERRQ(ierr);
MLGetSymbol(link, &symbol);
ierr = PetscStrcmp("True", (char*) symbol, &match);
CHKERRQ(ierr);
if (!match) {
MLDisownSymbol(link, symbol);
SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB, "Invalid CSR matrix in Mathematica");
}
MLDisownSymbol(link, symbol);
/* Skip ReturnPacket */
MLNewPacket(link);
PetscFunctionReturn(0);
}
// return list of live handles to Mathematica
// used for debugging
void eng_get_handles() {
MLPutFunction(stdlink, "List", handles.data.size());
for (MatlabHandleSet::mbmap::iterator i = handles.data.begin(); i != handles.data.end(); ++i)
MLPutInteger(stdlink, i->first);
}
static int Integrate(This *t, real *integral, real *error, real *prob)
{
TYPEDEFREGION;
Totals totals[NCOMP];
real nneed, weight;
count dim, comp, iter, pass = 0, err, iregion;
number nwant, nmin = INT_MAX;
int fail;
if( VERBOSE > 1 ) {
char s[512];
sprintf(s, "Divonne input parameters:\n"
" ndim " COUNT "\n ncomp " COUNT "\n"
" epsrel " REAL "\n epsabs " REAL "\n"
" flags %d\n seed %d\n"
" mineval " NUMBER "\n maxeval " NUMBER "\n"
" key1 %d\n key2 %d\n key3 %d\n maxpass " COUNT "\n"
" border " REAL "\n maxchisq " REAL "\n mindeviation " REAL "\n"
" ngiven " NUMBER "\n nextra " NUMBER,
t->ndim, t->ncomp,
t->epsrel, t->epsabs,
t->flags, t->seed,
t->mineval, t->maxeval,
t->key1, t->key2, t->key3, t->maxpass,
t->border.lower, t->maxchisq, t->mindeviation,
t->ngiven, t->nextra);
Print(s);
}
if( BadComponent(t) ) return -2;
if( BadDimension(t, t->key1) ||
BadDimension(t, t->key2) ||
((t->key3 & -2) && BadDimension(t, t->key3)) ) return -1;
t->neval_opt = t->neval_cut = 0;
t->size = CHUNKSIZE;
MemAlloc(t->voidregion, t->size*sizeof(Region));
for( dim = 0; dim < t->ndim; ++dim ) {
Bounds *b = &RegionPtr(0)->bounds[dim];
b->lower = 0;
b->upper = 1;
}
RuleIni(&t->rule7);
RuleIni(&t->rule9);
RuleIni(&t->rule11);
RuleIni(&t->rule13);
SamplesIni(&t->samples[0]);
SamplesIni(&t->samples[1]);
SamplesIni(&t->samples[2]);
if( (fail = setjmp(t->abort)) ) goto abort;
t->epsabs = Max(t->epsabs, NOTZERO);
/* Step 1: partition the integration region */
if( VERBOSE ) Print("Partitioning phase:");
if( IsSobol(t->key1) || IsSobol(t->key2) || IsSobol(t->key3) )
IniRandom(t);
SamplesLookup(t, &t->samples[0], t->key1,
(number)47, (number)INT_MAX, (number)0);
SamplesAlloc(t, &t->samples[0]);
t->totals = totals;
Zap(totals);
t->phase = 1;
Explore(t, 0, &t->samples[0], INIDEPTH, 1);
for( iter = 1; ; ++iter ) {
Totals *maxtot;
count valid;
for( comp = 0; comp < t->ncomp; ++comp ) {
Totals *tot = &totals[comp];
tot->avg = tot->spreadsq = 0;
tot->spread = tot->secondspread = -INFTY;
}
for( iregion = 0; iregion < t->nregions; ++iregion ) {
Region *region = RegionPtr(iregion);
for( comp = 0; comp < t->ncomp; ++comp ) {
cResult *r = ®ion->result[comp];
Totals *tot = &totals[comp];
tot->avg += r->avg;
tot->spreadsq += Sq(r->spread);
if( r->spread > tot->spread ) {
tot->secondspread = tot->spread;
tot->spread = r->spread;
tot->iregion = iregion;
}
else if( r->spread > tot->secondspread )
tot->secondspread = r->spread;
}
}
maxtot = totals;
valid = 0;
for( comp = 0; comp < t->ncomp; ++comp ) {
Totals *tot = &totals[comp];
integral[comp] = tot->avg;
valid += tot->avg == tot->avg;
if( tot->spreadsq > maxtot->spreadsq ) maxtot = tot;
tot->spread = sqrt(tot->spreadsq);
error[comp] = tot->spread*t->samples[0].weight;
}
if( VERBOSE ) {
char s[128 + 64*NCOMP], *p = s;
p += sprintf(p, "\n"
"Iteration " COUNT " (pass " COUNT "): " COUNT " regions\n"
NUMBER7 " integrand evaluations so far,\n"
NUMBER7 " in optimizing regions,\n"
NUMBER7 " in finding cuts",
iter, pass, t->nregions, t->neval, t->neval_opt, t->neval_cut);
for( comp = 0; comp < t->ncomp; ++comp )
p += sprintf(p, "\n[" COUNT "] "
REAL " +- " REAL,
comp + 1, integral[comp], error[comp]);
Print(s);
}
if( valid == 0 ) goto abort; /* all NaNs */
if( t->neval > t->maxeval ) break;
nneed = maxtot->spread/MaxErr(maxtot->avg);
if( nneed < MAXPRIME ) {
cnumber n = t->neval + t->nregions*(number)ceil(nneed);
if( n < nmin ) {
nmin = n;
pass = 0;
}
else if( ++pass > t->maxpass && n >= t->mineval ) break;
}
Split(t, maxtot->iregion, DEPTH);
}
/* Step 2: do a "full" integration on each region */
/* nneed = t->samples[0].neff + 1; */
nneed = 2*t->samples[0].neff;
for( comp = 0; comp < t->ncomp; ++comp ) {
Totals *tot = &totals[comp];
creal maxerr = MaxErr(tot->avg);
tot->nneed = tot->spread/maxerr;
nneed = Max(nneed, tot->nneed);
tot->maxerrsq = Sq(maxerr);
tot->mindevsq = tot->maxerrsq*Sq(t->mindeviation);
}
nwant = (number)Min(ceil(nneed), MARKMASK/40.);
err = SamplesLookup(t, &t->samples[1], t->key2, nwant,
(t->maxeval - t->neval)/t->nregions + 1, t->samples[0].n + 1);
/* the number of points needed to reach the desired accuracy */
fail = Unmark(err)*t->nregions;
if( Marked(err) ) {
if( VERBOSE ) Print("\nNot enough samples left for main integration.");
for( comp = 0; comp < t->ncomp; ++comp )
prob[comp] = -999;
weight = t->samples[0].weight;
}
else {
bool can_adjust = (t->key3 == 1 && t->samples[1].sampler != SampleRule &&
(t->key2 < 0 || t->samples[1].neff < MAXPRIME));
count df, nlimit;
SamplesAlloc(t, &t->samples[1]);
if( VERBOSE ) {
char s[128];
sprintf(s, "\nMain integration on " COUNT
" regions with " NUMBER " samples per region.",
t->nregions, t->samples[1].neff);
Print(s);
}
ResClear(integral);
ResClear(error);
ResClear(prob);
nlimit = t->maxeval - t->nregions*t->samples[1].n;
df = 0;
for( iregion = 0; iregion < t->nregions; ++iregion ) {
Region *region = RegionPtr(iregion);
char s[64*NDIM + 256*NCOMP], *p = s;
int todo;
refine:
t->phase = 2;
t->samples[1].sampler(t, &t->samples[1], region->bounds, region->vol);
if( can_adjust )
for( comp = 0; comp < t->ncomp; ++comp )
totals[comp].spreadsq -= Sq(region->result[comp].spread);
nlimit += t->samples[1].n;
todo = 0;
for( comp = 0; comp < t->ncomp; ++comp ) {
cResult *r = ®ion->result[comp];
Totals *tot = &totals[comp];
t->samples[0].avg[comp] = r->avg;
t->samples[0].err[comp] = r->err;
if( t->neval < nlimit ) {
creal avg2 = t->samples[1].avg[comp];
creal err2 = t->samples[1].err[comp];
creal diffsq = Sq(avg2 - r->avg);
#define Var(s) Sq((s.err[comp] == 0) ? r->spread*s.weight : s.err[comp])
if( err2*tot->nneed > r->spread ||
diffsq > Max(t->maxchisq*(Var(t->samples[0]) + Var(t->samples[1])),
EPS*Sq(avg2)) ) {
if( t->key3 && diffsq > tot->mindevsq ) {
if( t->key3 == 1 ) {
ccount xregion = t->nregions;
if( VERBOSE > 2 ) Print("\nSplit");
t->phase = 1;
Explore(t, iregion, &t->samples[1], POSTDEPTH, 2);
if( can_adjust ) {
number nnew;
count ireg, xreg;
for( ireg = iregion, xreg = xregion;
ireg < t->nregions; ireg = xreg++ ) {
cResult *result = RegionPtr(ireg)->result;
count c;
for( c = 0; c < t->ncomp; ++c )
totals[c].spreadsq += Sq(result[c].spread);
}
nnew = (tot->spreadsq/Sq(MARKMASK) > tot->maxerrsq) ?
MARKMASK :
(number)ceil(sqrt(tot->spreadsq/tot->maxerrsq));
if( nnew > nwant + nwant/64 ) {
ccount err = SamplesLookup(t, &t->samples[1], t->key2, nnew,
(t->maxeval - t->neval)/t->nregions + 1, t->samples[1].n);
fail += Unmark(err)*t->nregions;
nwant = nnew;
SamplesFree(&t->samples[1]);
SamplesAlloc(t, &t->samples[1]);
if( t->key2 > 0 && t->samples[1].neff >= MAXPRIME )
can_adjust = false;
if( VERBOSE > 2 ) {
char s[128];
sprintf(s, "Sampling remaining " COUNT
" regions with " NUMBER " points per region.",
t->nregions, t->samples[1].neff);
Print(s);
}
}
}
goto refine;
}
todo |= 3;
}
todo |= 1;
}
}
}
if( can_adjust ) {
for( comp = 0; comp < t->ncomp; ++comp )
totals[comp].maxerrsq -=
Sq(region->result[comp].spread*t->samples[1].weight);
}
switch( todo ) {
case 1: /* get spread right */
Explore(t, iregion, &t->samples[1], 0, 2);
break;
case 3: /* sample region again with more points */
if( SamplesIniQ(&t->samples[2]) ) {
SamplesLookup(t, &t->samples[2], t->key3,
nwant, (number)INT_MAX, (number)0);
SamplesAlloc(t, &t->samples[2]);
}
t->phase = 3;
t->samples[2].sampler(t, &t->samples[2], region->bounds, region->vol);
Explore(t, iregion, &t->samples[2], 0, 2);
++region->depth; /* misused for df here */
++df;
}
++region->depth; /* misused for df here */
if( VERBOSE > 2 ) {
for( dim = 0; dim < t->ndim; ++dim ) {
cBounds *b = ®ion->bounds[dim];
p += sprintf(p,
(dim == 0) ? "\nRegion (" REALF ") - (" REALF ")" :
"\n (" REALF ") - (" REALF ")",
b->lower, b->upper);
}
}
for( comp = 0; comp < t->ncomp; ++comp ) {
Result *r = ®ion->result[comp];
creal x1 = t->samples[0].avg[comp];
creal s1 = Var(t->samples[0]);
creal x2 = t->samples[1].avg[comp];
creal s2 = Var(t->samples[1]);
creal r2 = (s1 == 0) ? Sq(t->samples[1].neff*t->samples[0].weight) : s2/s1;
real norm = 1 + r2;
real avg = x2 + r2*x1;
real sigsq = s2;
real chisq = Sq(x2 - x1);
real chiden = s1 + s2;
if( todo == 3 ) {
creal x3 = t->samples[2].avg[comp];
creal s3 = Var(t->samples[2]);
creal r3 = (s2 == 0) ? Sq(t->samples[2].neff*t->samples[1].weight) : s3/s2;
norm = 1 + r3*norm;
avg = x3 + r3*avg;
sigsq = s3;
chisq = s1*Sq(x3 - x2) + s2*Sq(x3 - x1) + s3*chisq;
chiden = s1*s2 + s3*chiden;
}
avg = LAST ? r->avg : (sigsq *= norm = 1/norm, avg*norm);
if( chisq > EPS ) chisq /= Max(chiden, NOTZERO);
#define Out(s) s.avg[comp], r->spread*s.weight, s.err[comp]
if( VERBOSE > 2 ) {
p += sprintf(p, "\n[" COUNT "] "
REAL " +- " REAL "(" REAL ")\n "
REAL " +- " REAL "(" REAL ")",
comp + 1, Out(t->samples[0]), Out(t->samples[1]));
if( todo == 3 ) p += sprintf(p, "\n "
REAL " +- " REAL "(" REAL ")",
Out(t->samples[2]));
p += sprintf(p, " \tchisq " REAL, chisq);
}
integral[comp] += avg;
error[comp] += sigsq;
prob[comp] += chisq;
r->avg = avg;
r->spread = sqrt(sigsq);
r->chisq = chisq;
}
if( VERBOSE > 2 ) Print(s);
}
for( comp = 0; comp < t->ncomp; ++comp )
error[comp] = sqrt(error[comp]);
df += t->nregions;
if( VERBOSE > 2 ) {
char s[16 + 128*NCOMP], *p = s;
p += sprintf(p, "\nTotals:");
for( comp = 0; comp < t->ncomp; ++comp )
p += sprintf(p, "\n[" COUNT "] "
REAL " +- " REAL " \tchisq " REAL " (" COUNT " df)",
comp + 1, integral[comp], error[comp], prob[comp], df);
Print(s);
}
for( comp = 0; comp < t->ncomp; ++comp )
prob[comp] = ChiSquare(prob[comp], df);
weight = 1;
}
#ifdef MLVERSION
if( REGIONS ) {
MLPutFunction(stdlink, "List", 2);
MLPutFunction(stdlink, "List", t->nregions);
for( iregion = 0; iregion < t->nregions; ++iregion ) {
Region *region = RegionPtr(iregion);
cBounds *b = region->bounds;
real lower[NDIM], upper[NDIM];
for( dim = 0; dim < t->ndim; ++dim ) {
lower[dim] = b[dim].lower;
upper[dim] = b[dim].upper;
}
MLPutFunction(stdlink, "Cuba`Divonne`region", 4);
MLPutRealList(stdlink, lower, t->ndim);
MLPutRealList(stdlink, upper, t->ndim);
MLPutFunction(stdlink, "List", t->ncomp);
for( comp = 0; comp < t->ncomp; ++comp ) {
cResult *r = ®ion->result[comp];
real res[] = {r->avg, r->spread*weight, r->chisq};
MLPutRealList(stdlink, res, Elements(res));
}
MLPutInteger(stdlink, region->depth); /* misused for df */
}
}
#endif
abort:
SamplesFree(&t->samples[2]);
SamplesFree(&t->samples[1]);
SamplesFree(&t->samples[0]);
RuleFree(&t->rule13);
RuleFree(&t->rule11);
RuleFree(&t->rule9);
RuleFree(&t->rule7);
free(t->voidregion);
return fail;
}
static int Integrate(creal epsrel, creal epsabs,
cint flags, cnumber mineval, cnumber maxeval,
int key1, int key2, int key3, ccount maxpass,
creal maxchisq, creal mindeviation,
real *integral, real *error, real *prob)
{
TYPEDEFREGION;
Region anchor, *region;
Totals totals[NCOMP];
real nneed, weight;
count dim, comp, iter, nregions, pass = 0, err;
number nwant, nmin = INT_MAX;
int fail = -1;
if( VERBOSE > 1 ) {
char s[512];
sprintf(s, "Divonne input parameters:\n"
" ndim " COUNT "\n ncomp " COUNT "\n"
" epsrel " REAL "\n epsabs " REAL "\n"
" flags %d\n mineval " NUMBER "\n maxeval " NUMBER "\n"
" key1 %d\n key2 %d\n key3 %d\n maxpass " COUNT "\n"
" border " REAL "\n maxchisq " REAL "\n mindeviation " REAL "\n"
" ngiven " NUMBER "\n nextra " NUMBER "\n",
ndim_, ncomp_,
epsrel, epsabs,
flags, mineval, maxeval,
key1, key2, key3, maxpass,
border_.lower, maxchisq, mindeviation,
ngiven_, nextra_);
Print(s);
}
anchor.next = NULL;
for( dim = 0; dim < ndim_; ++dim ) {
Bounds *b = &anchor.bounds[dim];
b->lower = 0;
b->upper = 1;
}
RuleIni(&rule7_);
RuleIni(&rule9_);
RuleIni(&rule11_);
RuleIni(&rule13_);
SamplesIni(&samples_[0]);
SamplesIni(&samples_[1]);
SamplesIni(&samples_[2]);
#ifdef MLVERSION
if( setjmp(abort_) ) goto abort;
#endif
/* Step 1: partition the integration region */
if( VERBOSE ) Print("Partitioning phase:");
if( IsSobol(key1) || IsSobol(key2) || IsSobol(key3) )
IniRandom(2*maxeval, flags);
SamplesLookup(&samples_[0], key1,
(number)47, (number)INT_MAX, (number)0);
SamplesAlloc(&samples_[0]);
totals_ = totals;
Zap(totals);
phase_ = 1;
Explore(&anchor, &samples_[0], INIDEPTH, 1);
for( iter = 1; ; ++iter ) {
Totals *maxtot;
for( comp = 0; comp < ncomp_; ++comp ) {
Totals *tot = &totals[comp];
tot->avg = tot->spreadsq = 0;
tot->spread = tot->secondspread = -INFTY;
}
nregions = 0;
for( region = anchor.next; region; region = region->next ) {
++nregions;
for( comp = 0; comp < ncomp_; ++comp ) {
cResult *r = ®ion->result[comp];
Totals *tot = &totals[comp];
tot->avg += r->avg;
tot->spreadsq += Sq(r->spread);
if( r->spread > tot->spread ) {
tot->secondspread = tot->spread;
tot->spread = r->spread;
tot->region = region;
}
else if( r->spread > tot->secondspread )
tot->secondspread = r->spread;
}
}
maxtot = totals;
for( comp = 0; comp < ncomp_; ++comp ) {
Totals *tot = &totals[comp];
integral[comp] = tot->avg;
if( tot->spreadsq > maxtot->spreadsq ) maxtot = tot;
tot->spread = sqrt(tot->spreadsq);
error[comp] = tot->spread*samples_[0].weight;
}
if( VERBOSE ) {
char s[128 + 64*NCOMP], *p = s;
p += sprintf(p, "\n"
"Iteration " COUNT " (pass " COUNT "): " COUNT " regions\n"
NUMBER7 " integrand evaluations so far,\n"
NUMBER7 " in optimizing regions,\n"
NUMBER7 " in finding cuts",
iter, pass, nregions, neval_, neval_opt_, neval_cut_);
for( comp = 0; comp < ncomp_; ++comp )
p += sprintf(p, "\n[" COUNT "] "
REAL " +- " REAL,
comp + 1, integral[comp], error[comp]);
Print(s);
}
if( neval_ > maxeval ) break;
nneed = maxtot->spread/MaxErr(maxtot->avg);
if( nneed < MAXPRIME ) {
cnumber n = neval_ + nregions*(number)ceil(nneed);
if( n < nmin ) {
nmin = n;
pass = 0;
}
else if( ++pass > maxpass && n >= mineval ) break;
}
Split(maxtot->region, DEPTH);
}
/* Step 2: do a "full" integration on each region */
/* nneed = samples_[0].neff + 1; */
nneed = 2*samples_[0].neff;
for( comp = 0; comp < ncomp_; ++comp ) {
Totals *tot = &totals[comp];
creal maxerr = MaxErr(tot->avg);
tot->nneed = tot->spread/maxerr;
nneed = Max(nneed, tot->nneed);
tot->maxerrsq = Sq(maxerr);
tot->mindevsq = tot->maxerrsq*Sq(mindeviation);
}
nwant = (number)Min(ceil(nneed), MARKMASK/40.);
err = SamplesLookup(&samples_[1], key2, nwant,
(maxeval - neval_)/nregions + 1, samples_[0].n + 1);
/* the number of points needed to reach the desired accuracy */
fail = Unmark(err)*nregions;
if( Marked(err) ) {
if( VERBOSE ) Print("\nNot enough samples left for main integration.");
for( comp = 0; comp < ncomp_; ++comp )
prob[comp] = -999;
weight = samples_[0].weight;
nregions_ = nregions;
}
else {
bool can_adjust = (key3 == 1 && samples_[1].sampler != SampleRule &&
(key2 < 0 || samples_[1].neff < MAXPRIME));
count df, nlimit;
SamplesAlloc(&samples_[1]);
if( VERBOSE ) {
char s[128];
sprintf(s, "\nMain integration on " COUNT
" regions with " NUMBER " samples per region.",
nregions, samples_[1].neff);
Print(s);
}
ResClear(integral);
ResClear(error);
ResClear(prob);
nlimit = maxeval - nregions*samples_[1].n;
df = nregions_ = 0;
for( region = anchor.next; region; region = region->next ) {
char s[64*NDIM + 256*NCOMP], *p = s;
int todo;
refine:
phase_ = 2;
samples_[1].sampler(&samples_[1], region->bounds, region->vol);
if( can_adjust ) {
--nregions;
for( comp = 0; comp < ncomp_; ++comp )
totals[comp].spreadsq -= Sq(region->result[comp].spread);
}
nlimit += samples_[1].n;
todo = 0;
for( comp = 0; comp < ncomp_; ++comp ) {
cResult *r = ®ion->result[comp];
Totals *tot = &totals[comp];
samples_[0].avg[comp] = r->avg;
samples_[0].err[comp] = r->err;
if( neval_ < nlimit ) {
creal avg2 = samples_[1].avg[comp];
creal err2 = samples_[1].err[comp];
creal diffsq = Sq(avg2 - r->avg);
#define Var(s) Sq((s.err[comp] == 0) ? r->spread*s.weight : s.err[comp])
if( err2*tot->nneed > r->spread ||
diffsq > Max(maxchisq*(Var(samples_[0]) + Var(samples_[1])),
EPS*Sq(avg2)) ) {
if( key3 && diffsq > tot->mindevsq ) {
if( key3 == 1 ) {
const Region *next = region->next;
if( VERBOSE > 2 ) Print("\nSplit");
phase_ = 1;
Explore(region, &samples_[1], POSTDEPTH, 2);
if( can_adjust ) {
number nnew;
Region *child;
for( child = region; child != next; child = child->next ) {
count c;
for( c = 0; c < ncomp_; ++c )
totals[c].spreadsq += Sq(child->result[c].spread);
++nregions;
}
nnew = (tot->spreadsq/Sq(MARKMASK) > tot->maxerrsq) ?
MARKMASK :
(number)ceil(sqrt(tot->spreadsq/tot->maxerrsq));
if( nnew > nwant + nwant/64 ) {
ccount err = SamplesLookup(&samples_[1], key2, nnew,
(maxeval - neval_)/nregions + 1, samples_[1].n);
fail += Unmark(err)*nregions;
nwant = nnew;
SamplesFree(&samples_[1]);
SamplesAlloc(&samples_[1]);
if( key2 > 0 && samples_[1].neff >= MAXPRIME )
can_adjust = false;
if( VERBOSE > 2 ) {
char s[128];
sprintf(s, "Sampling remaining " COUNT
" regions with " NUMBER " points per region.",
nregions, samples_[1].neff);
Print(s);
}
}
}
goto refine;
}
todo |= 3;
}
todo |= 1;
}
}
}
if( can_adjust ) {
for( comp = 0; comp < ncomp_; ++comp )
totals[comp].maxerrsq -=
Sq(region->result[comp].spread*samples_[1].weight);
}
switch( todo ) {
case 1: /* get spread right */
Explore(region, &samples_[1], 0, 2);
break;
case 3: /* sample region again with more points */
if( MEM(&samples_[2]) == NULL ) {
SamplesLookup(&samples_[2], key3,
nwant, (number)INT_MAX, (number)0);
SamplesAlloc(&samples_[2]);
}
phase_ = 3;
samples_[2].sampler(&samples_[2], region->bounds, region->vol);
Explore(region, &samples_[2], 0, 2);
++region->depth; /* misused for df here */
++df;
}
++region->depth; /* misused for df here */
++nregions_;
if( VERBOSE > 2 ) {
for( dim = 0; dim < ndim_; ++dim ) {
cBounds *b = ®ion->bounds[dim];
p += sprintf(p,
(dim == 0) ? "\nRegion (" REALF ") - (" REALF ")" :
"\n (" REALF ") - (" REALF ")",
b->lower, b->upper);
}
}
for( comp = 0; comp < ncomp_; ++comp ) {
Result *r = ®ion->result[comp];
creal x1 = samples_[0].avg[comp];
creal s1 = Var(samples_[0]);
creal x2 = samples_[1].avg[comp];
creal s2 = Var(samples_[1]);
creal r2 = (s1 == 0) ? Sq(samples_[1].neff*samples_[0].weight) : s2/s1;
real norm = 1 + r2;
real avg = x2 + r2*x1;
real sigsq = s2;
real chisq = Sq(x2 - x1);
real chiden = s1 + s2;
if( todo == 3 ) {
creal x3 = samples_[2].avg[comp];
creal s3 = Var(samples_[2]);
creal r3 = (s2 == 0) ? Sq(samples_[2].neff*samples_[1].weight) : s3/s2;
norm = 1 + r3*norm;
avg = x3 + r3*avg;
sigsq = s3;
chisq = s1*Sq(x3 - x2) + s2*Sq(x3 - x1) + s3*chisq;
chiden = s1*s2 + s3*chiden;
}
avg = LAST ? r->avg : (sigsq *= norm = 1/norm, avg*norm);
if( chisq > EPS ) chisq /= Max(chiden, NOTZERO);
#define Out(s) s.avg[comp], r->spread*s.weight, s.err[comp]
if( VERBOSE > 2 ) {
p += sprintf(p, "\n[" COUNT "] "
REAL " +- " REAL "(" REAL ")\n "
REAL " +- " REAL "(" REAL ")",
comp + 1, Out(samples_[0]), Out(samples_[1]));
if( todo == 3 ) p += sprintf(p, "\n "
REAL " +- " REAL "(" REAL ")",
Out(samples_[2]));
p += sprintf(p, " \tchisq " REAL, chisq);
}
integral[comp] += avg;
error[comp] += sigsq;
prob[comp] += chisq;
r->avg = avg;
r->spread = sqrt(sigsq);
r->chisq = chisq;
}
if( VERBOSE > 2 ) Print(s);
}
for( comp = 0; comp < ncomp_; ++comp )
error[comp] = sqrt(error[comp]);
df += nregions_;
if( VERBOSE > 2 ) {
char s[16 + 128*NCOMP], *p = s;
p += sprintf(p, "\nTotals:");
for( comp = 0; comp < ncomp_; ++comp )
p += sprintf(p, "\n[" COUNT "] "
REAL " +- " REAL " \tchisq " REAL " (" COUNT " df)",
comp + 1, integral[comp], error[comp], prob[comp], df);
Print(s);
}
for( comp = 0; comp < ncomp_; ++comp )
prob[comp] = ChiSquare(prob[comp], df);
weight = 1;
}
#ifdef MLVERSION
if( REGIONS ) {
MLPutFunction(stdlink, "List", 2);
MLPutFunction(stdlink, "List", nregions_);
for( region = anchor.next; region; region = region->next ) {
cBounds *b = region->bounds;
real lower[NDIM], upper[NDIM];
for( dim = 0; dim < ndim_; ++dim ) {
lower[dim] = b[dim].lower;
upper[dim] = b[dim].upper;
}
MLPutFunction(stdlink, "Cuba`Divonne`region", 4);
MLPutRealList(stdlink, lower, ndim_);
MLPutRealList(stdlink, upper, ndim_);
MLPutFunction(stdlink, "List", ncomp_);
for( comp = 0; comp < ncomp_; ++comp ) {
cResult *r = ®ion->result[comp];
real res[] = {r->avg, r->spread*weight, r->chisq};
MLPutRealList(stdlink, res, Elements(res));
}
MLPutInteger(stdlink, region->depth); /* misused for df */
}
}
#endif
#ifdef MLVERSION
abort:
#endif
SamplesFree(&samples_[2]);
SamplesFree(&samples_[1]);
SamplesFree(&samples_[0]);
RuleFree(&rule13_);
RuleFree(&rule11_);
RuleFree(&rule9_);
RuleFree(&rule7_);
for( region = anchor.next; region; ) {
Region *next = region->next;
free(region);
region = next;
}
return fail;
}
