/// Set the weight function
void CustomPolynomial::setWeightFunction(IFunction_const_sptr wgtFun, const double& tol)
{
m_weightFunction = wgtFun;
auto cheb = dynamic_cast<const ChebFunction*>( wgtFun.get() );
if ( cheb && cheb->nfuns() == 1 && !cheb->cfun(0).hasScaling() )
{
m_fun = cheb->cfun(0).getUnscaled();
}
else
{
m_fun.bestFit( *wgtFun, tol );
}
}
void MultiThreadedSplitter<Heuristic,PrimRefBlockList>::task_split_parallel_reduce(size_t threadIndex, size_t threadCount, TaskScheduler::Event* event)
{
Heuristic lheuristic; Heuristic::reduce(lheuristics,numTasks,lheuristic); linfo = split.linfo; lheuristic.best(lsplit);
Heuristic rheuristic; Heuristic::reduce(rheuristics,numTasks,rheuristic); rinfo = split.rinfo; rheuristic.best(rsplit);
assert(linfo.size());
assert(rinfo.size());
cfun(cptr,threadIndex,threadCount,event);
}
/*
* -----------------------------------------------------------------
* cpDlsDenseProjDQJac
* -----------------------------------------------------------------
* This routine generates a dense difference quotient approximation
* to the transpose of the Jacobian of c(t,y). It loads it into a
* dense matrix of type DlsMat stored column-wise with elements
* within each column contiguous. The address of the jth column of
* J is obtained via the macro DENSE_COL and this pointer is
* associated with an N_Vector using the N_VGetArrayPointer and
* N_VSetArrayPointer functions.
* Finally, the actual computation of the jth column of the Jacobian
* transposed is done with a call to N_VLinearSum.
* -----------------------------------------------------------------
*/
int cpDlsDenseProjDQJac(int Nc, int Ny, realtype t,
N_Vector y, N_Vector cy,
DlsMat Jac, void *jac_data,
N_Vector c_tmp1, N_Vector c_tmp2)
{
realtype inc, inc_inv, yj, srur;
realtype *y_data, *ewt_data, *jthCol_data;
N_Vector ctemp, jthCol;
int i, j;
int retval = 0;
CPodeMem cp_mem;
CPDlsProjMem cpdlsP_mem;
/* jac_data points to cpode_mem */
cp_mem = (CPodeMem) jac_data;
cpdlsP_mem = (CPDlsProjMem) lmemP;
/* Rename work vectors for readibility */
ctemp = c_tmp1;
jthCol = c_tmp2;
/* Obtain pointers to the data for ewt and y */
ewt_data = N_VGetArrayPointer(ewt);
y_data = N_VGetArrayPointer(y);
/* Obtain pointer to the data for jthCol */
jthCol_data = N_VGetArrayPointer(jthCol);
/* Set minimum increment based on uround and norm of f */
srur = RSqrt(uround);
/* Generate each column of the Jacobian G = dc/dy as delta(c)/delta(y_j). */
for (j = 0; j < Ny; j++) {
/* Save the y_j values. */
yj = y_data[j];
/* Set increment inc to y_j based on sqrt(uround)*abs(y_j),
with an adjustment using ewt_j if this is small */
inc = MAX( srur * ABS(yj) , ONE/ewt_data[j] );
inc = (yj + inc) - yj;
/* Increment y_j, call cfun, and break on error return. */
y_data[j] += inc;
retval = cfun(t, y, ctemp, c_data);
nceDQ++;
if (retval != 0) break;
/* Generate the jth col of G(tn,y) */
inc_inv = ONE/inc;
N_VLinearSum(inc_inv, ctemp, -inc_inv, cy, jthCol);
/* Copy the j-th column of G into the j-th row of Jac */
for (i = 0; i < Nc ; i++) {
DENSE_ELEM(Jac,j,i) = jthCol_data[i];
}
/* Reset y_j */
y_data[j] = yj;
}
return(retval);
}
static float_quad Corrboot( int n , float *x , float *y ,
float xsig , float ysig ,
float (*cfun)(int,float *,float *) )
{
float *xar , *yar , *cbb , corst ;
float_quad res = {0.0f,-1.0f,0.0f,1.0f} ;
float_triple bci ;
int ii,jj,kk , nn=n ;
ENTRY("Corrboot") ;
if( nn < 3 || x == NULL || y == NULL || cfun == NULL ) RETURN(res) ;
if( xsig < 0.0f ) xsig = 0.0f ;
if( ysig < 0.0f ) ysig = 0.0f ;
/* workspaces */
xar = (float *)malloc(sizeof(float)*nn) ; /* resampled x vector */
yar = (float *)malloc(sizeof(float)*nn) ; /* resampled y vector */
cbb = (float *)malloc(sizeof(float)*nboot) ; /* saved correlations */
/* compute the un-resampled result */
for( ii=0 ; ii < nn ; ii++ ){ xar[ii] = x[ii] ; yar[ii] = y[ii] ; }
corst = cfun(nn,xar,yar) ; /* standard result */
/* compute bootstrap results */
for( kk=0 ; kk < nboot ; kk++ ){
if( !doblk ){ /* simple resampling */
for( ii=0 ; ii < nn ; ii++ ){
jj = lrand48() % nn ; xar[ii] = x[jj] ; yar[ii] = y[jj] ;
}
} else { /* block resampling */
int jold = lrand48() % nn ;
xar[0] = x[jold] ; yar[0] = y[jold] ;
for( ii=1 ; ii < nn ; ii++ ){
if( lrand48()%8 == 0 ){ /* 12.5% chance of random jump */
jj = lrand48() % nn ;
} else {
jj = jold+1 ; if( jj == nn ) jj = 0 ;
}
xar[ii] = x[jj] ; yar[ii] = y[jj] ; jold = jj ;
}
}
if( xsig > 0.0f || ysig > 0.0f ){
for( ii=0; ii < nn; ii++ ){
xar[ii] += zgaussian()*xsig; yar[ii] += zgaussian()*ysig;
}
}
cbb[kk] = cfun(nn,xar,yar) ; /* bootstrap result */
}
/* get the actual bias-corrected results [cf. thd_correlate.c] */
bci = THD_bootstrap_confinv( corst , alpha , nboot , cbb ) ;
/* empty the dustbin */
free(cbb) ; free(yar) ; free(xar) ;
/* this is bad */
if( bci.a == 0.0f && bci.b == 0.0f && bci.c == 0.0f ) RETURN(res) ;
/* this is good */
res.a = corst ; res.b = bci.a ; res.c = bci.b ; res.d = bci.c ;
RETURN(res) ;
}
static int cpProjNonlinearIteration(CPodeMem cp_mem)
{
int m, retval;
realtype del, delp, dcon;
N_Vector corP;
/* Initialize counter */
m = 0;
/* Initialize delp to avoid compiler warning message */
del = delp = ZERO;
/* Rename ftemp as corP */
corP = ftemp;
/* Set acorP to zero */
N_VConst(ZERO, acorP);
/* Set errP to acor */
if (project_err) N_VScale(ONE, acor, errP);
/* Looping point for iterations */
loop {
#ifdef CPODES_DEBUG
printf(" Iteration # %d\n",m);
#endif
/* Call lsolveP (rhs is ctemp; solution in corP) */
retval = lsolveP(cp_mem, ctemp, corP, y, ctemp, tempvP1, tempv);
#ifdef CPODES_DEBUG
printf(" Linear solver solve return value = %d\n",retval);
#endif
if (retval < 0) return(CP_PLSOLVE_FAIL);
if (retval > 0) return(CONV_FAIL);
/* Add correction to acorP and y and get its WRMS norm */
N_VLinearSum(ONE, acorP, -ONE, corP, acorP);
N_VLinearSum(ONE, y, -ONE, corP, y);
del = N_VWrmsNorm(corP, ewt);
#ifdef CPODES_DEBUG
printf(" Norm of correction: del = %lg\n", del);
#endif
/* If activated, find correction to the error estimate */
if (project_err) {
/* Compute rhs as G*errP and load it in tempvP2 */
lmultP(cp_mem, errP, tempvP2);
/* Call lsolveP (rhs is tempvP2; solution in corP) */
retval = lsolveP(cp_mem, tempvP2, corP, y, ctemp, tempvP1, tempv);
if (retval < 0) return(CP_PLSOLVE_FAIL);
if (retval > 0) return(CONV_FAIL);
/* Add correction to errP */
N_VLinearSum(ONE, errP, -ONE, corP, errP);
}
/* Test for convergence. If m > 0, an estimate of the convergence
rate constant is stored in crateP, and used in the test. */
if (m > 0) crateP = MAX(PRJ_CRDOWN * crateP, del/delp);
dcon = del * MIN(ONE, crateP) / prjcoef;
#ifdef CPODES_DEBUG
printf(" Convergence test dcon = %lg\n", dcon);
#endif
if (dcon <= ONE) {
if (project_err) acnrm = N_VWrmsNorm(errP, ewt);
return(CP_SUCCESS);
}
m++;
/* Stop at maxcorP iterations or if iter. seems to be diverging. */
if ((m == maxcorP) || ((m >= 2) && (del > PRJ_RDIV*delp))) return(CONV_FAIL);
/* Save norm of correction, evaluate cfun, and loop again */
delp = del;
retval = cfun(tn, y, ctemp, c_data);
nce++;
if (retval < 0) return(CP_CNSTRFUNC_FAIL);
if (retval > 0) return(CNSTRFUNC_RECVR);
}
}
static int cpProjNonlinear(CPodeMem cp_mem)
{
booleantype callSetup;
int retval;
#ifdef CPODES_DEBUG
printf(" Internal nonlinear projection\n");
#endif
/* If the linear solver provides a setup function, call it if:
* - it was never called before (first_proj = TRUE), or
* - enough steps passed from last evaluation */
if (lsetupP_exists) {
callSetup = (first_proj) || (nst >= nstlsetP + lsetupP_freq);
} else {
callSetup = FALSE;
crateP = ONE;
}
/* Save the corrected y, in case we need a second pass through the loop */
N_VScale(ONE, y, yC);
/* Begin the main loop. This loop is traversed at most twice.
* The second pass only occurs when the first pass had a recoverable
* failure with old Jacobian data. */
loop {
/* If needed, call setup function */
if (callSetup) {
retval = lsetupP(cp_mem, y, ctemp, tempvP1, tempvP2, tempv);
#ifdef CPODES_DEBUG
printf(" Linear solver setup return value = %d\n",retval);
#endif
nsetupsP++;
nstlsetP = nst;
crateP = ONE;
if (retval < 0) return(CP_PLSETUP_FAIL);
if (retval > 0) return(CONV_FAIL);
}
/* Do the iteration */
#ifdef CPODES_DEBUG
printf(" NonlinearIteration\n");
#endif
retval = cpProjNonlinearIteration(cp_mem);
#ifdef CPODES_DEBUG
printf(" NonlinearIteration return value = %d\n",retval);
#endif
/* On a recoverable failure, if setup was not called,
* reload the corrected y, recompute constraints, and reattempt loop */
if ( (retval > 0) && lsetupP_exists && !callSetup ) {
N_VScale(ONE, yC, y);
retval = cfun(tn, y, ctemp, c_data);
nce++;
if (retval < 0) return(CP_CNSTRFUNC_FAIL);
if (retval > 0) return(CNSTRFUNC_RECVR);
callSetup = TRUE;
continue;
}
/* Break from loop */
break;
}
return(retval);
}
int cpDoProjection(CPodeMem cp_mem, realtype saved_t, int *npfPtr)
{
int flag, retval;
realtype cnorm;
switch (proj_type) {
case CP_PROJ_INTERNAL:
/* Evaluate constraints at current time and with the corrected y */
retval = cfun(tn, y, ctemp, c_data);
nce++;
if (retval < 0) {flag = CP_CNSTRFUNC_FAIL; break;}
if (retval > 0) {flag = CNSTRFUNC_RECVR; break;}
/*
* If activated, evaluate WL2 norm of constraint violation.
* If the constraint violation is small enough, return.
*/
if (test_cnstr) {
cnorm = N_VWL2Norm(ctemp, ctol);
cnorm /= prjcoef;
#ifdef CPODES_DEBUG
printf(" Constraint violation norm = %lg\n",cnorm);
#endif
if (cnorm <= ONE) {
applyProj = FALSE;
return(CP_SUCCESS);
}
}
#ifdef CPODES_DEBUG
else {
printf(" No constraint testing\n");
}
#endif
/* Perform projection step
* On a successful return, the projection correction is available in acorP.
* Also, if projection of the error estimate was enabled, the new error
* estimate is available in errP and acnrm contains ||errP||_WRMS.
*/
nproj++;
if (cnstr_type == CP_CNSTR_NONLIN) flag = cpProjNonlinear(cp_mem);
else flag = cpProjLinear(cp_mem);
break;
case CP_PROJ_USER:
#ifdef CPODES_DEBUG
printf(" User-defined projection\n");
#endif
/* Use ftemp to store errP and tempv to store acorP
* (recall that in this case we did not allocate memory
* errP and acorP).
*/
errP = ftemp;
acorP = tempv;
/* Copy acor into errP */
N_VScale(ONE, acor, errP);
/* Call the user projection function */
retval = pfun(tn, y, acorP, prjcoef, errP, p_data);
nproj++;
if (retval < 0) {flag = CP_PROJFUNC_FAIL; break;}
if (retval > 0) {flag = PROJFUNC_RECVR; break;}
/* Recompute acnrm to be used in error test */
acnrm = N_VWrmsNorm(errP, ewt);
flag = CP_SUCCESS;
break;
}
#ifdef CPODES_DEBUG
printf(" acnrm = %lg\n",acnrm);
#endif
/* This is not the first projection anymore */
first_proj = FALSE;
/* If the projection was successful, return now. */
if (flag == CP_SUCCESS) {
applyProj = TRUE;
return(CP_SUCCESS);
}
/* The projection failed. Increment nprf and restore zn */
nprf++;
cpRestore(cp_mem, saved_t);
/* Return if lsetupP, lsolveP, cfun, or pfun failed unrecoverably */
if (flag == CP_PLSETUP_FAIL) return(CP_PLSETUP_FAIL);
if (flag == CP_PLSOLVE_FAIL) return(CP_PLSOLVE_FAIL);
if (flag == CP_CNSTRFUNC_FAIL) return(CP_CNSTRFUNC_FAIL);
if (flag == CP_PROJFUNC_FAIL) return(CP_PROJFUNC_FAIL);
/* At this point, flag = CONV_FAIL or CNSTRFUNC_RECVR or PRJFUNC_RECVR; increment npf */
(*npfPtr)++;
etamax = ONE;
/* If we had maxnpf failures or |h| = hmin,
return CP_PROJ_FAILURE or CP_REPTD_CNSTRFUNC_ERR or CP_REPTD_PROJFUNC_ERR. */
if ((ABS(h) <= hmin*ONEPSM) || (*npfPtr == maxnpf)) {
if (flag == CONV_FAIL) return(CP_PROJ_FAILURE);
if (flag == CNSTRFUNC_RECVR) return(CP_REPTD_CNSTRFUNC_ERR);
if (flag == PROJFUNC_RECVR) return(CP_REPTD_PROJFUNC_ERR);
}
/* Reduce step size; return to reattempt the step */
eta = MAX(ETAPR, hmin / ABS(h));
cpRescale(cp_mem);
return(PREDICT_AGAIN);
}
