void LpProjector::proj_lpball_newton_normalized(const double *y, double *xout,
double p,int &numiter){
double normF,normz0,mu,chi;
double tol=1e-15;
numiter=0;
// special case p=2, p=Inf
if(p==2.0){
radial_lp_project(y,xout,N,p);
return;
}
if (p==Inf){
l_infinity_project(y,xout,N);
return;
}
//////////////////////////////////////////////////
// Initialization
// xn1 : radial projection onto Lp ball
// xn2 : L\infty projection followed by radial projection
// pick the one closest to y
//////////////////////////////////////////////////
radial_lp_project(y,xn1,N,p);
l_infinity_project(y,xn2,N);
radial_lp_project(xn2,xn2,N,p);
if (dpnorm(xn1,y,N,2.0) < dpnorm(xn2,y,N,2.0)) {
vcopy(xn1,z,N); // initialize with xn1
}
else {
vcopy(xn2,z,N); // initialize with xn2
}
// initialize lagrange multiplier coordinate with least squares fit
z[N]=lsq_lambda_init(z,y,p);
// we are initialized!
normz0=pnorm(z,N+1,2.0);
normF=tol*normz0+1;
while ( (normF/normz0) > tol ) {
// build residual F
for (int k=0;k<N;k++){
zpm1[k]=pow(z[k],p-1);
F[k]=z[k]+z[N]*zpm1[k]-y[k];
}
double szp=0;
for (int k=0;k<N;k++)
szp+=pow(z[k],p);
F[N]=(szp-1)/p;
normF=pnorm(F,N+1,2.0);
// build Jacobian matrix J
for (int k=0;k<N;k++)
d[k]=1+z[N]*(p-1)*pow(z[k],p-2);
vdiv(zpm1,d,btwid,N);
mu=dotp(zpm1,btwid,N);
chi=-dotp(btwid,F,N); // uses only first N entries of F
for (int k=0;k<N;k++)
dz[k]=-F[k]/d[k] + btwid[k]*(-F[N]-chi)/mu;
dz[N]=(chi+F[N])/mu;
for (int k=0;k<N+1;k++)
z[k]=z[k]+dz[k];
if (verbose){
vprint(F,N+1);
mexPrintf("nF %e\n",normF); }
numiter++;
if (numiter>max_numiter)
mexErrMsgTxt("maximum # of iterations exceeded in proj_lpball_newton\n");
}
// answer is first N coordinates of z.
vcopy(z,xout,N);
}
/*
* Asymptotic expansion to calculate the probability that Poisson variate
* has value <= x.
* Various assertions about this are made (without proof) at
* http://members.aol.com/iandjmsmith/PoissonApprox.htm
*/
static double
ppois_asymp (double x, double lambda, int lower_tail, int log_p)
{
static const double coefs_a[8] = {
-1e99, /* placeholder used for 1-indexing */
2/3.,
-4/135.,
8/2835.,
16/8505.,
-8992/12629925.,
-334144/492567075.,
698752/1477701225.
};
static const double coefs_b[8] = {
-1e99, /* placeholder */
1/12.,
1/288.,
-139/51840.,
-571/2488320.,
163879/209018880.,
5246819/75246796800.,
-534703531/902961561600.
};
double elfb, elfb_term;
double res12, res1_term, res1_ig, res2_term, res2_ig;
double dfm, pt_, s2pt, f, np;
int i;
dfm = lambda - x;
/* If lambda is large, the distribution is highly concentrated
about lambda. So representation error in x or lambda can lead
to arbitrarily large values of pt_ and hence divergence of the
coefficients of this approximation.
*/
pt_ = - log1pmx (dfm / x);
s2pt = sqrt (2 * x * pt_);
if (dfm < 0) s2pt = -s2pt;
res12 = 0;
res1_ig = res1_term = sqrt (x);
res2_ig = res2_term = s2pt;
for (i = 1; i < 8; i++) {
res12 += res1_ig * coefs_a[i];
res12 += res2_ig * coefs_b[i];
res1_term *= pt_ / i ;
res2_term *= 2 * pt_ / (2 * i + 1);
res1_ig = res1_ig / x + res1_term;
res2_ig = res2_ig / x + res2_term;
}
elfb = x;
elfb_term = 1;
for (i = 1; i < 8; i++) {
elfb += elfb_term * coefs_b[i];
elfb_term /= x;
}
if (!lower_tail) elfb = -elfb;
#ifdef DEBUG_p
REprintf ("res12 = %.14g elfb=%.14g\n", elfb, res12);
#endif
f = res12 / elfb;
np = pnorm (s2pt, 0.0, 1.0, !lower_tail, log_p);
if (log_p) {
double n_d_over_p = dpnorm (s2pt, !lower_tail, np);
#ifdef DEBUG_p
REprintf ("pp*_asymp(): f=%.14g np=e^%.14g nd/np=%.14g f*nd/np=%.14g\n",
f, np, n_d_over_p, f * n_d_over_p);
#endif
return np + log1p (f * n_d_over_p);
} else {
double nd = dnorm (s2pt, 0., 1., log_p);
#ifdef DEBUG_p
REprintf ("pp*_asymp(): f=%.14g np=%.14g nd=%.14g f*nd=%.14g\n",
f, np, nd, f * nd);
#endif
return np + f * nd;
}
} /* ppois_asymp() */
