コード例 #1
0
ファイル: densRad.c プロジェクト: cran/overlap
void densRad(double *x, int *n, double *xpts, int *nxpts,
  double *h, double *result)
{
  int i, j;
  double d, ksum, cons;
  cons = 2 * M_PI * bessel_i(*h, 0, 2);
  for(i=0; i < *nxpts; i++) {
    ksum = 0;
    for(j=0; j < *n; j++) {
      d = xpts[i] - x[j];
      ksum += pow(exp(cos(d) - 1), *h);
    }
    result[i] = ksum / *n / cons;
  }
}
コード例 #2
0
ファイル: struve.c プロジェクト: 317070/scipy
/*
 * Bessel series
 * http://dlmf.nist.gov/11.4.19
 */
double struve_bessel_series(double v, double z, int is_h, double *err)
{
    int n, sgn;
    double term, cterm, sum, maxterm;

    if (is_h && v < 0) {
        /* Works less reliably in this region */
        *err = NPY_INFINITY;
        return NPY_NAN;
    }

    sum = 0;
    maxterm = 0;

    cterm = sqrt(z / (2*M_PI));

    for (n = 0; n < MAXITER; ++n) {
        if (is_h) {
            term = cterm * bessel_j(n + v + 0.5, z) / (n + 0.5);
            cterm *= z/2 / (n + 1);
        }
        else {
            term = cterm * bessel_i(n + v + 0.5, z) / (n + 0.5);
            cterm *= -z/2 / (n + 1);
        }
        sum += term;
        if (fabs(term) > maxterm) {
            maxterm = fabs(term);
        }
        if (fabs(term) < SUM_EPS * fabs(sum) || term == 0 || !npy_isfinite(sum)) {
            break;
        }
    }

    *err = fabs(term) + fabs(maxterm) * 1e-16;

    /* Account for potential underflow of the Bessel functions */
    *err += 1e-300 * fabs(cterm);

    return sum;
}
コード例 #3
0
ファイル: struve.c プロジェクト: 317070/scipy
/*
 * Large-z expansion for Struve H and L
 * http://dlmf.nist.gov/11.6.1
 */
double struve_asymp_large_z(double v, double z, int is_h, double *err)
{
    int n, sgn, maxiter;
    double term, sum, maxterm;
    double m;

    if (is_h) {
        sgn = -1;
    }
    else {
        sgn = 1;
    }

    /* Asymptotic expansion divergenge point */
    m = z/2;
    if (m <= 0) {
        maxiter = 0;
    }
    else if (m > MAXITER) {
        maxiter = MAXITER;
    }
    else {
        maxiter = (int)m;
    }
    if (maxiter == 0) {
        *err = NPY_INFINITY;
        return NPY_NAN;
    }

    if (z < v) {
        /* Exclude regions where our error estimation fails */
        *err = NPY_INFINITY;
        return NPY_NAN;
    }

    /* Evaluate sum */
    term = -sgn / sqrt(M_PI) * exp(-lgam(v + 0.5) + (v - 1) * log(z/2)) * gammasgn(v + 0.5);
    sum = term;
    maxterm = 0;

    for (n = 0; n < maxiter; ++n) {
        term *= sgn * (1 + 2*n) * (1 + 2*n - 2*v) / (z*z);
        sum += term;
        if (fabs(term) > maxterm) {
            maxterm = fabs(term);
        }
        if (fabs(term) < SUM_EPS * fabs(sum) || term == 0 || !npy_isfinite(sum)) {
            break;
        }
    }

    if (is_h) {
        sum += bessel_y(v, z);
    }
    else {
        sum += bessel_i(v, z);
    }

    /*
     * This error estimate is strictly speaking valid only for
     * n > v - 0.5, but numerical results indicate that it works
     * reasonably.
     */
    *err = fabs(term) + fabs(maxterm) * 1e-16;

    return sum;
}
コード例 #4
0
ファイル: struve.c プロジェクト: 317070/scipy
static double struve_hl(double v, double z, int is_h)
{
    double value[4], err[4], tmp;
    int n;

    if (z < 0) {
        n = v;
        if (v == n) {
            tmp = (n % 2 == 0) ? -1 : 1;
            return tmp * struve_hl(v, -z, is_h);
        }
        else {
            return NPY_NAN;
        }
    }
    else if (z == 0) {
        if (v < -1) {
            return gammasgn(v + 1.5) * NPY_INFINITY;
        }
        else if (v == -1) {
            return 2 / sqrt(M_PI) / Gamma(0.5);
        }
        else {
            return 0;
        }
    }

    n = -v - 0.5;
    if (n == -v - 0.5 && n > 0) {
        if (is_h) {
            return (n % 2 == 0 ? 1 : -1) * bessel_j(n + 0.5, z);
        }
        else {
            return bessel_i(n + 0.5, z);
        }
    }

    /* Try the asymptotic expansion */
    if (z >= 0.7*v + 12) {
        value[0] = struve_asymp_large_z(v, z, is_h, &err[0]);
        if (err[0] < GOOD_EPS * fabs(value[0])) {
            return value[0];
        }
    }
    else {
        err[0] = NPY_INFINITY;
    }

    /* Try power series */
    value[1] = struve_power_series(v, z, is_h, &err[1]);
    if (err[1] < GOOD_EPS * fabs(value[1])) {
        return value[1];
    }

    /* Try bessel series */
    if (fabs(z) < fabs(v) + 20) {
        value[2] = struve_bessel_series(v, z, is_h, &err[2]);
        if (err[2] < GOOD_EPS * fabs(value[2])) {
            return value[2];
        }
    }
    else {
        err[2] = NPY_INFINITY;
    }

    /* Return the best of the three, if it is acceptable */
    n = 0;
    if (err[1] < err[n]) n = 1;
    if (err[2] < err[n]) n = 2;
    if (err[n] < ACCEPTABLE_EPS * fabs(value[n]) || err[n] < ACCEPTABLE_ATOL) {
        return value[n];
    }

    /* Maybe it really is an overflow? */
    tmp = -lgam(v + 1.5) + (v + 1)*log(z/2);
    if (!is_h) {
        tmp = fabs(tmp);
    }
    if (tmp > 700) {
        sf_error("struve", SF_ERROR_OVERFLOW, "overflow in series");
        return NPY_INFINITY * gammasgn(v + 1.5);
    }

    /* Failure */
    sf_error("struve", SF_ERROR_NO_RESULT, "total loss of precision");
    return NPY_NAN;
}
コード例 #5
0
ファイル: binarizeBASCB.c プロジェクト: cran/BiTrinA
void mgs(mgs_result* result, dbl_array* vect, dbl_array* sigma)
{
    int i, j, k, is_zerocrossing, **zerocrossing;
    double deriv_tot, s_times_two, e_pow_mstt, sum, **smoothed, bessel, *deriv;

    int oldStatus = enableWarnings(-1);

    smoothed = result->smoothed->values;
    deriv = result->deriv->values;
    zerocrossing = result->zerocrossing->values;

    for(i = 0, deriv_tot = 0.0; i < result->deriv->length; i++)
    {
        deriv[i] = vect->values[i+1] - vect->values[i];
        deriv_tot += deriv[i];
    }

    for(i = 0; i < sigma->length; i++)
    {
        s_times_two = 2.0 * sigma->values[i];
        e_pow_mstt = exp(-s_times_two);
        for(k = 0; k < result->deriv->length; k++)
        {
            for(j = 0, sum = 0.0; j < result->deriv->length; j++)
            {
                if(b && b_returned)
                {
                    if(b_returned->values[i][abs(k-j)])
                    {
                        bessel = b->values[i][abs(k-j)];
                        b_returned->values[i][abs(k-j)]++;
                    }
                    else
                    {
                        bessel = bessel_i(s_times_two, (double)(k-j), 1.0);
                        b->values[i][abs(k-j)] = bessel;
                        b_returned->values[i][abs(k-j)]++;
                    }
                }
                else
                {
                    bessel = bessel_i(s_times_two, (double)(k-j), 1.0);
                }

                sum += deriv[j] * e_pow_mstt * bessel;
            }
            smoothed[i][k] = sum / deriv_tot;
        }

        for(j = 0, k = 0; j < result->smoothed->cols; j++)
        {
            is_zerocrossing = 0;
            is_zerocrossing += (int)(j == 0 && smoothed[i][j] > smoothed[i][j+1]);
            is_zerocrossing += (int)(j == result->smoothed->cols - 1 && smoothed[i][j-1] < smoothed[i][j]);
            is_zerocrossing += (int)(j > 0 && j < result->smoothed->cols - 1 && smoothed[i][j-1] < smoothed[i][j] && smoothed[i][j] > smoothed[i][j+1]);
            if(is_zerocrossing)
                zerocrossing[i][k++] = j + 1;
        }
        
        if (k == 0)
        // fix for linear functions (no maxima in slope):
        // all positions are considered as maxima
        {
          for(j = 0; j < result->zerocrossing->cols; j++)
          {
            zerocrossing[i][j] = j + 1;
          }
        }

    }
    enableWarnings(oldStatus);
}
コード例 #6
0
ファイル: M2M_L2L_init.c プロジェクト: HaraldHofstaetter/FMMV
static void init_L2L_Yukawa(FmmvHandle *FMMV, int level)
{
      int pL = FMMV->pL;
      _FLOAT_ **Tz_L2L = FMMV->Tz_L2L;

#if (FMM_PRECISION==0)
      double II[4*FMM_P_MAX+4];
#else
      _FLOAT_ II[4*FMM_P_MAX+4];
#endif
      _FLOAT_ RR[2*FMM_P_MAX+3];
      int m,n,nn,k, ii;
      _FLOAT_ r, h, hh;
      
      r = ldexp(0.4330127018922193233818615/FMMV->scale, -level);  /* sqrt(3)/4 */
#if 0
      RR[0] = 1.0;
      RR[1] = 1.0/(r*FMMV->beta);
      bessel_i(r*FMMV->beta, II, 2*pL+2, 4*pL+4);
      for (k=2;k<=pL;k++) {
          RR[k] = RR[k-1]*RR[1];
      }

      for (m=0; m<=pL; m++) {
          ii=0;
	  for (nn=m; nn<=pL; nn++) {
	      for (n=m; n<=pL; n++) {
	         h = 0.0;
	         for (k=m; k<=(n<nn?n:nn); k++) {
		     hh = ldexp( (F[2*k]*II[nn+n-k]*RR[k]) /
	                         (F[k+m]*F[k-m]*F[nn-k]*F[n-k]*F[k]),
   	                         -k + level*(n-nn) -nn );
		     h += hh;
	         }
	         Tz_L2L[m][ii] = ((n+nn)%2?-1:1)*((_FLOAT_) (2*nn+1))
                                 * sqrt(F[nn-m]*F[n+m]*F[nn+m]*F[n-m])*h
			         * YUKSCALE_INV[nn]*YUKSCALE[n];
	 	 ii++;
		 
	      }
	  }
      }	 
#endif

#if (FMM_PRECISION==0)
      bessel_i_scaled_double(r*FMMV->beta, II, 2*pL+2, 4*pL+4);
#else
      bessel_i_scaled(r*FMMV->beta, II, 2*pL+2, 4*pL+4);
#endif
      RR[0] = 1.0;
      RR[1] = r*FMMV->beta;
      for (k=2;k<=2*pL+1;k++) {
          RR[k] = RR[k-1]*RR[1];
      }

      for (m=0; m<=pL; m++) {
          ii=0;
	  for (nn=m; nn<=pL; nn++) {
	      for (n=m; n<=pL; n++) {
	         h = 0.0;
	         for (k=m; k<=(n<nn?n:nn); k++) {
		     hh = ldexp( (F[2*k]*II[nn+n-k]*RR[nn+n-2*k+1]) /
	                         (F[k+m]*F[k-m]*F[nn-k]*F[n-k]*F[k]),
   	                         -k + level*(n-nn) -nn );
		     h += hh;
	         }
	         Tz_L2L[m][ii] = ((n+nn)%2?-1:1)*((_FLOAT_) (2*nn+1))
                                 * sqrt(F[nn-m]*F[n+m]*F[nn+m]*F[n-m])*h
			         * YUKSCALE_INV[nn]*YUKSCALE[n];
	 	 ii++;
		 
	      }
	  }
      }	  



}