Extern void EXPORT(Divonne)(ccount ndim, ccount ncomp,
Integrand integrand,
creal epsrel, creal epsabs,
cint flags, cnumber mineval, cnumber maxeval,
cint key1, cint key2, cint key3, ccount maxpass,
creal border, creal maxchisq, creal mindeviation,
cnumber ngiven, ccount ldxgiven, real *xgiven,
cnumber nextra, PeakFinder peakfinder,
int *pnregions, number *pneval, int *pfail,
real *integral, real *error, real *prob)
{
ndim_ = ndim;
ncomp_ = ncomp;
if( BadComponent(ncomp) ||
BadDimension(ndim, flags, key1) ||
BadDimension(ndim, flags, key2) ||
((key3 & -2) && BadDimension(ndim, flags, key3)) ) *pfail = -1;
else {
neval_ = neval_opt_ = neval_cut_ = 0;
integrand_ = integrand;
peakfinder_ = peakfinder;
border_.lower = border;
border_.upper = 1 - border_.lower;
ngiven_ = ngiven;
xgiven_ = NULL;
ldxgiven_ = IMax(ldxgiven, ndim_);
nextra_ = nextra;
if( ngiven + nextra ) {
cnumber nxgiven = ngiven*ldxgiven;
cnumber nxextra = nextra*ldxgiven;
cnumber nfgiven = ngiven*ncomp;
cnumber nfextra = nextra*ncomp;
Alloc(xgiven_, nxgiven + nxextra + nfgiven + nfextra);
xextra_ = xgiven_ + nxgiven;
fgiven_ = xextra_ + nxextra;
fextra_ = fgiven_ + nfgiven;
if( nxgiven ) {
phase_ = 0;
Copy(xgiven_, xgiven, nxgiven);
DoSample(ngiven_, ldxgiven_, xgiven_, fgiven_);
}
}
*pfail = Integrate(epsrel, Max(epsabs, NOTZERO),
flags, mineval, maxeval, key1, key2, key3, maxpass,
maxchisq, mindeviation,
integral, error, prob);
*pnregions = nregions_;
*pneval = neval_;
if( xgiven_ ) free(xgiven_);
}
}
Extern void EXPORT(Vegas)(ccount ndim, ccount ncomp,
Integrand integrand,
creal epsrel, creal epsabs,
cint flags, cnumber mineval, cnumber maxeval,
cnumber nstart, cnumber nincrease,
number *pneval, int *pfail,
real *integral, real *error, real *prob)
{
ndim_ = ndim;
ncomp_ = ncomp;
if( BadComponent(ncomp) || BadDimension(ndim, flags) ) *pfail = -1;
else {
neval_ = 0;
integrand_ = integrand;
*pfail = Integrate(epsrel, epsabs,
flags, mineval, maxeval, nstart, nincrease,
integral, error, prob);
*pneval = neval_;
}
}
Extern void EXPORT(Suave)(ccount ndim, ccount ncomp,
Integrand integrand,
creal epsrel, creal epsabs,
cint flags, cnumber mineval, cnumber maxeval,
cnumber nnew, creal flatness,
count *pnregions, number *pneval, int *pfail,
real *integral, real *error, real *prob)
{
ndim_ = ndim;
ncomp_ = ncomp;
if( BadComponent(ncomp) || BadDimension(ndim, flags) ) *pfail = -1;
else {
neval_ = 0;
integrand_ = integrand;
*pfail = Integrate(epsrel, Max(epsabs, NOTZERO),
flags, mineval, maxeval, nnew, flatness,
integral, error, prob);
*pnregions = nregions_;
*pneval = neval_;
}
}
static int Integrate(This *t, real *integral, real *error, real *prob)
{
bin_t *bins;
count dim, comp;
int fail;
StateDecl;
csize_t statesize = sizeof(State) +
NCOMP*sizeof(Cumulants) + NDIM*sizeof(Grid);
Sized(State, state, statesize);
Cumulants *c, *C = state->cumul + t->ncomp;
Grid *state_grid = (Grid *)C;
Array(Grid, margsum, NCOMP, NDIM);
Vector(char, out, 128*NCOMP + 256);
if( VERBOSE > 1 ) {
sprintf(out, "Vegas 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"
" nstart " NUMBER "\n nincrease " NUMBER "\n"
" nbatch " NUMBER "\n gridno %d\n"
" statefile \"%s\"",
t->ndim, t->ncomp,
t->epsrel, t->epsabs,
t->flags, t->seed,
t->mineval, t->maxeval,
t->nstart, t->nincrease, t->nbatch,
t->gridno, t->statefile);
Print(out);
}
if( BadComponent(t) ) return -2;
if( BadDimension(t) ) return -1;
FrameAlloc(t, ShmRm(t));
ForkCores(t);
Alloc(bins, t->nbatch*t->ndim);
if( (fail = setjmp(t->abort)) ) goto abort;
IniRandom(t);
StateSetup(t);
if( StateReadTest(t) ) {
StateReadOpen(t, fd) {
if( read(fd, state, statesize) != statesize ||
state->signature != StateSignature(t, 1) ) break;
} StateReadClose(t, fd);
t->neval = state->neval;
t->rng.skiprandom(t, t->neval);
}
if( ini ) {
state->niter = 0;
state->nsamples = t->nstart;
FClear(state->cumul);
GetGrid(t, state_grid);
t->neval = 0;
}
/* main iteration loop */
for( ; ; ) {
number nsamples = state->nsamples;
creal jacobian = 1./nsamples;
FClear(margsum);
for( ; nsamples > 0; nsamples -= t->nbatch ) {
cnumber n = IMin(t->nbatch, nsamples);
real *w = t->frame;
real *x = w + n;
real *f = x + n*t->ndim;
real *lastf = f + n*t->ncomp;
bin_t *bin = bins;
while( x < f ) {
real weight = jacobian;
t->rng.getrandom(t, x);
for( dim = 0; dim < t->ndim; ++dim ) {
creal pos = *x*NBINS;
ccount ipos = (count)pos;
creal prev = (ipos == 0) ? 0 : state_grid[dim][ipos - 1];
creal diff = state_grid[dim][ipos] - prev;
*x++ = prev + (pos - ipos)*diff;
*bin++ = ipos;
weight *= diff*NBINS;
}
*w++ = weight;
}
DoSample(t, n, w, f, t->frame, state->niter + 1);
bin = bins;
w = t->frame;
while( f < lastf ) {
creal weight = *w++;
Grid *m = &margsum[0][0];
for( c = state->cumul; c < C; ++c ) {
real wfun = weight*(*f++);
if( wfun ) {
c->sum += wfun;
c->sqsum += wfun *= wfun;
for( dim = 0; dim < t->ndim; ++dim )
m[dim][bin[dim]] += wfun;
}
m += t->ndim;
}
bin += t->ndim;
}
}
fail = 0;
/* compute the integral and error values */
for( c = state->cumul; c < C; ++c ) {
real w = Weight(c->sum, c->sqsum, state->nsamples);
real sigsq = 1/(c->weightsum += w);
real avg = sigsq*(c->avgsum += w*c->sum);
c->avg = LAST ? (sigsq = 1/w, c->sum) : avg;
c->err = sqrt(sigsq);
fail |= (c->err > MaxErr(c->avg));
if( state->niter == 0 ) c->guess = c->sum;
else {
c->chisum += w *= c->sum - c->guess;
c->chisqsum += w*c->sum;
}
c->chisq = c->chisqsum - avg*c->chisum;
c->sum = c->sqsum = 0;
}
if( VERBOSE ) {
char *oe = out + sprintf(out, "\n"
"Iteration " COUNT ": " NUMBER " integrand evaluations so far",
state->niter + 1, t->neval);
for( c = state->cumul, comp = 0; c < C; ++c )
oe += sprintf(oe, "\n[" COUNT "] "
REAL " +- " REAL " \tchisq " REAL " (" COUNT " df)",
++comp, c->avg, c->err, c->chisq, state->niter);
Print(out);
}
if( fail == 0 && t->neval >= t->mineval ) break;
if( t->neval >= t->maxeval && !StateWriteTest(t) ) break;
if( t->ncomp == 1 )
for( dim = 0; dim < t->ndim; ++dim )
RefineGrid(t, state_grid[dim], margsum[0][dim]);
else {
for( dim = 0; dim < t->ndim; ++dim ) {
Grid wmargsum;
Zap(wmargsum);
for( comp = 0; comp < t->ncomp; ++comp ) {
real w = state->cumul[comp].avg;
if( w != 0 ) {
creal *m = margsum[comp][dim];
count bin;
w = 1/Sq(w);
for( bin = 0; bin < NBINS; ++bin )
wmargsum[bin] += w*m[bin];
}
}
RefineGrid(t, state_grid[dim], wmargsum);
}
}
++state->niter;
state->nsamples += t->nincrease;
if( StateWriteTest(t) ) {
state->signature = StateSignature(t, 1);
state->neval = t->neval;
StateWriteOpen(t, fd) {
StateWrite(fd, state, statesize);
} StateWriteClose(t, fd);
if( t->neval >= t->maxeval ) break;
}
}
static int Integrate(This *t, real *integral, real *error, real *prob)
{
TYPEDEFREGION;
typedef struct pool {
struct pool *next;
Region region[POOLSIZE];
} Pool;
count dim, comp, ncur, ipool, npool;
int fail;
Totals totals[NCOMP];
Pool *cur = NULL, *pool;
Region *region;
if( VERBOSE > 1 ) {
char s[256];
sprintf(s, "Cuhre input parameters:\n"
" ndim " COUNT "\n ncomp " COUNT "\n"
" epsrel " REAL "\n epsabs " REAL "\n"
" flags %d\n mineval " NUMBER "\n maxeval " NUMBER "\n"
" key " COUNT,
t->ndim, t->ncomp,
t->epsrel, t->epsabs,
t->flags, t->mineval, t->maxeval,
t->key);
Print(s);
}
if( BadComponent(t) ) return -2;
if( BadDimension(t) ) return -1;
t->epsabs = Max(t->epsabs, NOTZERO);
RuleAlloc(t);
t->mineval = IMax(t->mineval, t->rule.n + 1);
FrameAlloc(t, ShmRm(t));
ForkCores(t);
if( (fail = setjmp(t->abort)) ) goto abort;
Alloc(cur, 1);
cur->next = NULL;
ncur = 1;
region = cur->region;
region->div = 0;
for( dim = 0; dim < t->ndim; ++dim ) {
Bounds *b = ®ion->bounds[dim];
b->lower = 0;
b->upper = 1;
}
Sample(t, region);
for( comp = 0; comp < t->ncomp; ++comp ) {
Totals *tot = &totals[comp];
Result *r = ®ion->result[comp];
tot->avg = tot->lastavg = tot->guess = r->avg;
tot->err = tot->lasterr = r->err;
tot->weightsum = 1/Max(Sq(r->err), NOTZERO);
tot->avgsum = tot->weightsum*r->avg;
tot->chisq = tot->chisqsum = tot->chisum = 0;
}
for( t->nregions = 1; ; ++t->nregions ) {
count maxcomp, bisectdim;
real maxratio, maxerr;
Result result[NCOMP];
Region *regionL, *regionR;
Bounds *bL, *bR;
if( VERBOSE ) {
char s[128 + 128*NCOMP], *p = s;
p += sprintf(p, "\n"
"Iteration " COUNT ": " NUMBER " integrand evaluations so far",
t->nregions, t->neval);
for( comp = 0; comp < t->ncomp; ++comp ) {
cTotals *tot = &totals[comp];
p += sprintf(p, "\n[" COUNT "] "
REAL " +- " REAL " \tchisq " REAL " (" COUNT " df)",
comp + 1, tot->avg, tot->err, tot->chisq, t->nregions - 1);
}
Print(s);
}
maxratio = -INFTY;
maxcomp = 0;
for( comp = 0; comp < t->ncomp; ++comp ) {
creal ratio = totals[comp].err/MaxErr(totals[comp].avg);
if( ratio > maxratio ) {
maxratio = ratio;
maxcomp = comp;
}
}
if( maxratio <= 1 && t->neval >= t->mineval ) break;
if( t->neval >= t->maxeval ) {
fail = 1;
break;
}
maxerr = -INFTY;
regionL = cur->region;
npool = ncur;
for( pool = cur; pool; npool = POOLSIZE, pool = pool->next )
for( ipool = 0; ipool < npool; ++ipool ) {
Region *region = &pool->region[ipool];
creal err = region->result[maxcomp].err;
if( err > maxerr ) {
maxerr = err;
regionL = region;
}
}
if( ncur == POOLSIZE ) {
Pool *prev = cur;
Alloc(cur, 1);
cur->next = prev;
ncur = 0;
}
regionR = &cur->region[ncur++];
regionR->div = ++regionL->div;
FCopy(result, regionL->result);
XCopy(regionR->bounds, regionL->bounds);
bisectdim = result[maxcomp].bisectdim;
bL = ®ionL->bounds[bisectdim];
bR = ®ionR->bounds[bisectdim];
bL->upper = bR->lower = .5*(bL->upper + bL->lower);
Sample(t, regionL);
Sample(t, regionR);
for( comp = 0; comp < t->ncomp; ++comp ) {
cResult *r = &result[comp];
Result *rL = ®ionL->result[comp];
Result *rR = ®ionR->result[comp];
Totals *tot = &totals[comp];
real diff, err, w, avg, sigsq;
tot->lastavg += diff = rL->avg + rR->avg - r->avg;
diff = fabs(.25*diff);
err = rL->err + rR->err;
if( err > 0 ) {
creal c = 1 + 2*diff/err;
rL->err *= c;
rR->err *= c;
}
rL->err += diff;
rR->err += diff;
tot->lasterr += rL->err + rR->err - r->err;
tot->weightsum += w = 1/Max(Sq(tot->lasterr), NOTZERO);
sigsq = 1/tot->weightsum;
tot->avgsum += w*tot->lastavg;
avg = sigsq*tot->avgsum;
tot->chisum += w *= tot->lastavg - tot->guess;
tot->chisqsum += w*tot->lastavg;
tot->chisq = tot->chisqsum - avg*tot->chisum;
if( LAST ) {
tot->avg = tot->lastavg;
tot->err = tot->lasterr;
}
else {
tot->avg = avg;
tot->err = sqrt(sigsq);
}
}
}
for( comp = 0; comp < t->ncomp; ++comp ) {
cTotals *tot = &totals[comp];
integral[comp] = tot->avg;
error[comp] = tot->err;
prob[comp] = ChiSquare(tot->chisq, t->nregions - 1);
}
#ifdef MLVERSION
if( REGIONS ) {
MLPutFunction(stdlink, "List", 2);
MLPutFunction(stdlink, "List", t->nregions);
npool = ncur;
for( pool = cur; pool; npool = POOLSIZE, pool = pool->next )
for( ipool = 0; ipool < npool; ++ipool ) {
Region const *region = &pool->region[ipool];
real lower[NDIM], upper[NDIM];
for( dim = 0; dim < t->ndim; ++dim ) {
cBounds *b = ®ion->bounds[dim];
lower[dim] = b->lower;
upper[dim] = b->upper;
}
MLPutFunction(stdlink, "Cuba`Cuhre`region", 3);
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->err};
MLPutRealList(stdlink, res, Elements(res));
}
}
}
#endif
abort:
while( (pool = cur) ) {
cur = cur->next;
free(pool);
}
WaitCores(t);
FrameFree(t);
RuleFree(t);
return fail;
}
static int Integrate(This *t, real *integral, real *error, real *prob)
{
bin_t *bins;
count dim, comp;
int fail;
struct {
count niter;
number nsamples, neval;
Cumulants cumul[NCOMP];
Grid grid[NDIM];
} state;
int statemsg = VERBOSE;
struct stat st;
if( VERBOSE > 1 ) {
char s[512];
sprintf(s, "Vegas 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"
" nstart " NUMBER "\n nincrease " NUMBER "\n"
" nbatch " NUMBER "\n gridno %d\n"
" statefile \"%s\"",
t->ndim, t->ncomp,
t->epsrel, t->epsabs,
t->flags, t->seed,
t->mineval, t->maxeval,
t->nstart, t->nincrease, t->nbatch,
t->gridno, t->statefile);
Print(s);
}
if( BadComponent(t) ) return -2;
if( BadDimension(t) ) return -1;
FrameAlloc(t, ShmRm(t));
ForkCores(t);
Alloc(bins, t->nbatch*t->ndim);
if( (fail = setjmp(t->abort)) ) goto abort;
IniRandom(t);
if( t->statefile && *t->statefile == 0 ) t->statefile = NULL;
if( t->statefile &&
stat(t->statefile, &st) == 0 &&
st.st_size == sizeof state && (st.st_mode & 0400) ) {
cint h = open(t->statefile, O_RDONLY);
read(h, &state, sizeof state);
close(h);
t->rng.skiprandom(t, t->neval = state.neval);
if( VERBOSE ) {
char s[256];
sprintf(s, "\nRestoring state from %s.", t->statefile);
Print(s);
}
}
else {
state.niter = 0;
state.nsamples = t->nstart;
Zap(state.cumul);
GetGrid(t, state.grid);
}
/* main iteration loop */
for( ; ; ) {
number nsamples = state.nsamples;
creal jacobian = 1./nsamples;
Grid margsum[NCOMP][NDIM];
Zap(margsum);
for( ; nsamples > 0; nsamples -= t->nbatch ) {
cnumber n = IMin(t->nbatch, nsamples);
real *w = t->frame;
real *x = w + n;
real *f = x + n*t->ndim;
real *lastf = f + n*t->ncomp;
bin_t *bin = bins;
while( x < f ) {
real weight = jacobian;
t->rng.getrandom(t, x);
for( dim = 0; dim < t->ndim; ++dim ) {
creal pos = *x*NBINS;
ccount ipos = (count)pos;
creal prev = (ipos == 0) ? 0 : state.grid[dim][ipos - 1];
creal diff = state.grid[dim][ipos] - prev;
*x++ = prev + (pos - ipos)*diff;
*bin++ = ipos;
weight *= diff*NBINS;
}
*w++ = weight;
}
DoSample(t, n, w, f, t->frame, state.niter + 1);
bin = bins;
w = t->frame;
while( f < lastf ) {
creal weight = *w++;
for( comp = 0; comp < t->ncomp; ++comp ) {
real wfun = weight*(*f++);
if( wfun ) {
Cumulants *c = &state.cumul[comp];
Grid *m = margsum[comp];
c->sum += wfun;
c->sqsum += wfun *= wfun;
for( dim = 0; dim < t->ndim; ++dim )
m[dim][bin[dim]] += wfun;
}
}
bin += t->ndim;
}
}
fail = 0;
/* compute the integral and error values */
for( comp = 0; comp < t->ncomp; ++comp ) {
Cumulants *c = &state.cumul[comp];
real avg, sigsq;
real w = Weight(c->sum, c->sqsum, state.nsamples);
sigsq = 1/(c->weightsum += w);
avg = sigsq*(c->avgsum += w*c->sum);
c->avg = LAST ? (sigsq = 1/w, c->sum) : avg;
c->err = sqrt(sigsq);
fail |= (c->err > MaxErr(c->avg));
if( state.niter == 0 ) c->guess = c->sum;
else {
c->chisum += w *= c->sum - c->guess;
c->chisqsum += w*c->sum;
}
c->chisq = c->chisqsum - avg*c->chisum;
c->sum = c->sqsum = 0;
}
if( VERBOSE ) {
char s[128 + 128*NCOMP], *p = s;
p += sprintf(p, "\n"
"Iteration " COUNT ": " NUMBER " integrand evaluations so far",
state.niter + 1, t->neval);
for( comp = 0; comp < t->ncomp; ++comp ) {
cCumulants *c = &state.cumul[comp];
p += sprintf(p, "\n[" COUNT "] "
REAL " +- " REAL " \tchisq " REAL " (" COUNT " df)",
comp + 1, c->avg, c->err, c->chisq, state.niter);
}
Print(s);
}
if( fail == 0 && t->neval >= t->mineval ) {
if( t->statefile && KEEPFILE == 0 ) unlink(t->statefile);
break;
}
if( t->neval >= t->maxeval && t->statefile == NULL ) break;
if( t->ncomp == 1 )
for( dim = 0; dim < t->ndim; ++dim )
RefineGrid(t, state.grid[dim], margsum[0][dim]);
else {
for( dim = 0; dim < t->ndim; ++dim ) {
Grid wmargsum;
Zap(wmargsum);
for( comp = 0; comp < t->ncomp; ++comp ) {
real w = state.cumul[comp].avg;
if( w != 0 ) {
creal *m = margsum[comp][dim];
count bin;
w = 1/Sq(w);
for( bin = 0; bin < NBINS; ++bin )
wmargsum[bin] += w*m[bin];
}
}
RefineGrid(t, state.grid[dim], wmargsum);
}
}
++state.niter;
state.nsamples += t->nincrease;
if( t->statefile ) {
cint h = creat(t->statefile, 0666);
if( h != -1 ) {
state.neval = t->neval;
write(h, &state, sizeof state);
close(h);
if( statemsg ) {
char s[256];
sprintf(s, "\nSaving state to %s.", t->statefile);
Print(s);
statemsg = false;
}
}
if( t->neval >= t->maxeval ) break;
}
}
for( comp = 0; comp < t->ncomp; ++comp ) {
cCumulants *c = &state.cumul[comp];
integral[comp] = c->avg;
error[comp] = c->err;
prob[comp] = ChiSquare(c->chisq, state.niter);
}
abort:
PutGrid(t, state.grid);
free(bins);
WaitCores(t);
FrameFree(t);
return fail;
}
static int Integrate(This *t, real *integral, real *error, real *prob)
{
TYPEDEFREGION;
count dim, comp, df;
int fail;
Result totals[NCOMP];
Region *anchor = NULL, *region = NULL;
if( VERBOSE > 1 ) {
char s[256];
sprintf(s, "Suave 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"
" nnew " NUMBER "\n flatness " REAL,
t->ndim, t->ncomp,
t->epsrel, t->epsabs,
t->flags, t->seed,
t->mineval, t->maxeval,
t->nnew, t->flatness);
Print(s);
}
if( BadComponent(t) ) return -2;
if( BadDimension(t) ) return -1;
if( (fail = setjmp(t->abort)) ) goto abort;
t->epsabs = Max(t->epsabs, NOTZERO);
IniRandom(t);
RegionAlloc(t, anchor, t->nnew, t->nnew);
anchor->next = NULL;
anchor->div = 0;
for( dim = 0; dim < t->ndim; ++dim ) {
Bounds *b = &anchor->bounds[dim];
b->lower = 0;
b->upper = 1;
b->mid = .5;
if( dim == 0 ) {
count bin;
/* define the initial distribution of bins */
for( bin = 0; bin < NBINS; ++bin )
b->grid[bin] = (bin + 1)/(real)NBINS;
}
else Copy(b->grid, anchor->bounds[0].grid, NBINS);
}
Sample(t, t->nnew, anchor, anchor->w,
anchor->w + t->nnew,
anchor->w + t->nnew + t->ndim*t->nnew);
df = anchor->df;
ResCopy(totals, anchor->result);
for( t->nregions = 1; ; ++t->nregions ) {
Var var[NDIM][2], *vLR;
real maxratio, maxerr, minfluct, bias, mid;
Region *regionL, *regionR, *reg, **parent, **par;
Bounds *bounds, *boundsL, *boundsR;
count maxcomp, bisectdim;
number n, nL, nR, nnewL, nnewR;
real *w, *wL, *wR, *x, *xL, *xR, *f, *fL, *fR, *wlast, *flast;
if( VERBOSE ) {
char s[128 + 128*NCOMP], *p = s;
p += sprintf(p, "\n"
"Iteration " COUNT ": " NUMBER " integrand evaluations so far",
t->nregions, t->neval);
for( comp = 0; comp < t->ncomp; ++comp ) {
cResult *tot = &totals[comp];
p += sprintf(p, "\n[" COUNT "] "
REAL " +- " REAL " \tchisq " REAL " (" COUNT " df)",
comp + 1, tot->avg, tot->err, tot->chisq, df);
}
Print(s);
}
maxratio = -INFTY;
maxcomp = 0;
for( comp = 0; comp < t->ncomp; ++comp ) {
creal ratio = totals[comp].err/MaxErr(totals[comp].avg);
if( ratio > maxratio ) {
maxratio = ratio;
maxcomp = comp;
}
}
if( maxratio <= 1 && t->neval >= t->mineval ) {
fail = 0;
break;
}
if( t->neval >= t->maxeval ) break;
maxerr = -INFTY;
parent = &anchor;
region = anchor;
for( par = &anchor; (reg = *par); par = ®->next ) {
creal err = reg->result[maxcomp].err;
if( err > maxerr ) {
maxerr = err;
parent = par;
region = reg;
}
}
Fluct(t, var[0],
region->bounds, region->w, region->n, maxcomp,
region->result[maxcomp].avg, Max(maxerr, t->epsabs));
bias = (t->epsrel < 1e-50) ? 2 :
Max(pow(2., -(real)region->div/t->ndim)/t->epsrel, 2.);
minfluct = INFTY;
bisectdim = 0;
for( dim = 0; dim < t->ndim; ++dim ) {
cBounds *b = ®ion->bounds[dim];
creal fluct = (var[dim][0].fluct + var[dim][1].fluct)*
(bias - b->upper + b->lower);
if( fluct < minfluct ) {
minfluct = fluct;
bisectdim = dim;
}
}
vLR = var[bisectdim];
minfluct = vLR[0].fluct + vLR[1].fluct;
nnewL = IMax(
(minfluct == 0) ? t->nnew/2 : (count)(vLR[0].fluct/minfluct*t->nnew),
MINSAMPLES );
nL = vLR[0].n + nnewL;
nnewR = IMax(t->nnew - nnewL, MINSAMPLES);
nR = vLR[1].n + nnewR;
RegionAlloc(t, regionL, nL, nnewL);
RegionAlloc(t, regionR, nR, nnewR);
*parent = regionL;
regionL->next = regionR;
regionR->next = region->next;
regionL->div = regionR->div = region->div + 1;
bounds = ®ion->bounds[bisectdim];
mid = bounds->mid;
n = region->n;
w = wlast = region->w; x = w + n; f = flast = x + n*t->ndim;
wL = regionL->w; xL = wL + nL; fL = xL + nL*t->ndim;
wR = regionR->w; xR = wR + nR; fR = xR + nR*t->ndim;
while( n-- ) {
cbool final = (*w < 0);
if( x[bisectdim] < mid ) {
if( final && wR > regionR->w ) *(wR - 1) = -fabs(*(wR - 1));
*wL++ = *w++;
VecCopy(xL, x);
xL += t->ndim;
ResCopy(fL, f);
fL += t->ncomp;
}
else {
if( final && wL > regionL->w ) *(wL - 1) = -fabs(*(wL - 1));
*wR++ = *w++;
VecCopy(xR, x);
xR += t->ndim;
ResCopy(fR, f);
fR += t->ncomp;
}
x += t->ndim;
f += t->ncomp;
if( n && final ) wlast = w, flast = f;
}
Reweight(t, region->bounds, wlast, flast, f, totals);
VecCopy(regionL->bounds, region->bounds);
VecCopy(regionR->bounds, region->bounds);
boundsL = ®ionL->bounds[bisectdim];
boundsR = ®ionR->bounds[bisectdim];
boundsL->mid = .5*(boundsL->lower + (boundsL->upper = mid));
boundsR->mid = .5*((boundsR->lower = mid) + boundsR->upper);
StretchGrid(bounds->grid, boundsL->grid, boundsR->grid);
Sample(t, nnewL, regionL, wL, xL, fL);
Sample(t, nnewR, regionR, wR, xR, fR);
df += regionL->df + regionR->df - region->df;
for( comp = 0; comp < t->ncomp; ++comp ) {
cResult *r = ®ion->result[comp];
Result *rL = ®ionL->result[comp];
Result *rR = ®ionR->result[comp];
Result *tot = &totals[comp];
real diff, sigsq;
tot->avg += diff = rL->avg + rR->avg - r->avg;
diff = Sq(.25*diff);
sigsq = rL->sigsq + rR->sigsq;
if( sigsq > 0 ) {
creal c = Sq(1 + sqrt(diff/sigsq));
rL->sigsq *= c;
rR->sigsq *= c;
}
rL->err = sqrt(rL->sigsq += diff);
rR->err = sqrt(rR->sigsq += diff);
tot->sigsq += rL->sigsq + rR->sigsq - r->sigsq;
tot->err = sqrt(tot->sigsq);
tot->chisq += rL->chisq + rR->chisq - r->chisq;
}
free(region);
region = NULL;
}
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;
}