R beta分布的特征函数

我试图用R来计算很多不同alpha和beta的beta分布的特征函数；不幸的是，我遇到了数值问题

首先，我使用的是包

CharFun

和函数

cfX_-Beta（t，alpha，Beta）

，这在大多数情况下似乎都能正常工作，但例如

alpha=121.3618

和

Beta=5041.483

它完全失败（参见下面的例子，

Re（cfX_-Beta（t，alpha，Beta））

和

Im（cfX)）（t，alpha，beta））

应始终在区间[-1,1]内，但实际情况并非如此）

然后我决定通过积分获得特征函数。这种方法为

alpha=121.3618

和

beta=5041.483

提供了可信的结果，但对于其他组合，积分失败。（错误：“积分可能是发散的”）增加积分的

rel.tol

也没有帮助。相反，对于alpha和beta的其他值，我会得到错误：“检测到舍入错误”

所以我的问题是： 对于α和β的所有可能组合，是否有其他方法获得β分布特征函数的可靠结果

我犯了什么明显的错误吗

library(CharFun)
abc<-function(x,t,a,b) {
   return( dbeta(x,a,b)*cos(t*x))
}
dfg<-function(x,t,a,b) {
   return( dbeta(x,a,b)*sin(t*x))
}
hij<-function(t,a,b) {
  intRe=rep(0,length(t))
  intIm=rep(0,length(t))
  i<-complex(1,0,1)
  for (j in 1:length(t)) {
    intRe[j]<-integrate(abc,lower=0,upper=1,t[j],a,b)$value
    intIm[j]<-integrate(dfg,lower=0,upper=1,t[j],a,b)$value
  }
  return(intRe+intIm*i)
}

alpha<-1
beta<-1

t <- seq(-100, 100, length.out = 501)
par(mfrow=c(3,2))
alpha<-1
beta<-1
plotGraf(function(t)
   hij(t, alpha, beta), t, title = "CF alpha=1
beta=1")
plotGraf(function(t)
   cfX_Beta(t, alpha, beta), t, title = "CF Charfun alpha=1
beta=1")

alpha<-121.3618
beta<-5041.483
plotGraf(function(t)
  hij(t, alpha, beta), t, title = "CF alpha=121.3618 beta=5041.483")
plotGraf(function(t)
  cfX_Beta(t, alpha, beta), t, title = "CF Charfun alpha=121.3618 beta=5041.483")

alpha<-1
beta<-1/2
plotGraf(function(t)
  hij(t, alpha, beta), t, title = "CF alpha=1
beta=1/2")
plotGraf(function(t)
  cfX_Beta(t, alpha, beta), t, title = "CF Charfun alpha=1
beta=1/2")

库（CharFun）
abc它似乎与
RCPPnumeric
一起工作，条件是使用的公差不太小（
1e-4
如下）

/[[Rcpp:：depends（RcppEigen）]]
//[[Rcpp:：dependens（rcppnumeric）]]
#包括
使用名称空间编号；
类BetaCDF_Re:公共函数
{
私人：
双a；
双b；
双t；
公众：
BetaCDF_Re（双a_，双b_，双t_）：a（a_），b（b_），t（t_）{
双运算符（）
{
返回R：：dbeta（x，a，b，0）*cos（t*x）；
}
};
类BetaCDF_Im:public Func
{
私人：
双a；
双b；
双t；
公众：
BetaCDF_Im（双a_，双b_，双t_）：a（a_），b（b_），t（t_）{
双运算符（）
{
返回R：：dbeta（x，a，b，0）*sin（t*x）；
}
};
//[[Rcpp:：导出]]
Rcpp:：列表集成测试（双a、双b、双t）
{
BetaCDF_Re f1（a，b，t）；
双重错误1；
内部错误代码1；
const double res1=积分（f1，0，1，err_est1，err_code1，
100、1e-4、1e-4、，
积分器：GaussKronrod201）；
BetaCDF_Im f2（a，b，t）；
双重错误2；
内部错误代码2；
const double res2=积分（f2，0，1，err_est2，err_code2，
100、1e-4、1e-4、，
积分器：GaussKronrod201）；
返回Rcpp:：List:：create(
Rcpp:：命名的（“realPart”）=
Rcpp:：列表：：创建(
Rcpp:：Named（“value”）=res1，
Rcpp:：Named（“error_estimate”）=err_est1，
Rcpp:：Named（“错误代码”）=错误代码1
),
Rcpp:：命名的（“传授”）=
Rcpp:：列表：：创建(
Rcpp:：Named（“value”）=res2，
Rcpp:：Named（“error_estimate”）=err_est2，
Rcpp:：Named（“错误代码”）=错误代码2
)
);
}
>积分检验（1,0.5,1）
$realPart
$realPart$value
[1] 0.7497983
$realPart$error\u估算
[1] 7.110548e-07
$realPart$error\u代码
[1] 0
$INPUT
$INPUT$value
[1] 0.5934922
$INPUT$error\u估算
[1] 5.54721e-07
$INPUT$错误代码
[1] 0

绘图：

t这是一个合理的问题，但可能很难找到答案，因为这需要回答者花一段时间来深入了解细节（不过，我看不到一种简单的方法可以将其归结为一个更小/更简单的问题……）
// [[Rcpp::depends(RcppEigen)]]
// [[Rcpp::depends(RcppNumerical)]]
#include <RcppNumerical.h>
using namespace Numer;

class BetaCDF_Re: public Func
{
private:
  double a;
  double b;
  double t;
public:
  BetaCDF_Re(double a_, double b_, double t_) : a(a_), b(b_), t(t_){}

  double operator()(const double& x) const
  {
    return R::dbeta(x, a, b, 0) * cos(t*x);
  }
};

class BetaCDF_Im: public Func
{
private:
  double a;
  double b;
  double t;
public:
  BetaCDF_Im(double a_, double b_, double t_) : a(a_), b(b_), t(t_) {}

  double operator()(const double& x) const
  {
    return R::dbeta(x, a, b, 0) * sin(t*x);
  }
};

// [[Rcpp::export]]
Rcpp::List integrate_test(double a, double b, double t)
{
  BetaCDF_Re f1(a, b, t);
  double err_est1;
  int err_code1;
  const double res1 = integrate(f1, 0, 1, err_est1, err_code1, 
                                100, 1e-4, 1e-4,
                                Integrator<double>::GaussKronrod201);
  BetaCDF_Im f2(a, b, t);
  double err_est2;
  int err_code2;
  const double res2 = integrate(f2, 0, 1, err_est2, err_code2, 
                                100, 1e-4, 1e-4,
                                Integrator<double>::GaussKronrod201);
  return Rcpp::List::create(
    Rcpp::Named("realPart") = 
      Rcpp::List::create(
        Rcpp::Named("value") = res1,
        Rcpp::Named("error_estimate") = err_est1,
        Rcpp::Named("error_code") = err_code1
    ),
    Rcpp::Named("imPart") = 
      Rcpp::List::create(
        Rcpp::Named("value") = res2,
        Rcpp::Named("error_estimate") = err_est2,
        Rcpp::Named("error_code") = err_code2
    )
  );
}

> integrate_test(1, 0.5, 1)
$realPart
$realPart$value
[1] 0.7497983

$realPart$error_estimate
[1] 7.110548e-07

$realPart$error_code
[1] 0


$imPart
$imPart$value
[1] 0.5934922

$imPart$error_estimate
[1] 5.54721e-07

$imPart$error_code
[1] 0

t <- seq(-100, 100, length.out = 501)
x <- lapply(t, function(t) integrate_test(1,0.5,t))
realparts <- unlist(purrr::transpose(purrr::transpose(x)$realPart)$value)
imparts <- unlist(purrr::transpose(purrr::transpose(x)$imPart)$value)
plot(t, realparts, type="l", col="blue", ylim=c(-1,1))
lines(t, imparts, type="l", col="red")