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() */