与高斯求积相关的R中复杂复发的显著性损失

我不是程序员（这是我在这里的第一篇文章），也没有太多的浮点运算经验。如果我错过了一些明显的东西，我道歉

我一直在尝试用自定义权重函数来寻找高斯求积的参数，例如使用所描述的通用方法。当可以手动找到参数时，该方法在检查少量点时有效

然而，对于大量的正交点，数值计算参数是有意义的。这些矩可以通过超几何函数来表示，这是由快速收敛的级数给出的，我在这里使用

我计算必要参数

an

和

bn

的算法涉及明确地找到多项式的系数，并使用参考文献中提供的公式。最后我们有一个复杂的循环，它涉及到相当多的加法、减法、乘法和除法

问题是：我非常确定在我的例子中，所有的

an=0.5

都是正确的。但是我在

R

中所做的算法很快丢失了数字，在第5步中给出了

0.499999981034791707302

。我可以在算法中做些什么来避免这个问题

代码如下：

#Moments of sin(pi x) on [0,1] (hypergeometric function)
FIm <- function(n,N){   z <- -pi^2/4;
            f <- 1;
            k <- 0;
            a <- (n+2)/2;
            b <- 3/2;
            c <- (n+4)/2;
            while(k < N){f <- 1+f*z*(N-1-k+a)/(N-k)/(N-1-k+b)/(N-1-k+c);
                    k <- k+1}
            return(f*pi/(n+2))};
#Number of quadrature points
Nq <- 5;
n <- 0:(2*Nq+1);
#Moments
mu <- FIm(n,35);
#Recurrence parameters
an <- rep(0,Nq+1);
bn <- rep(0,Nq+1);
sn <- rep(0,Nq+1);
#Initial values
sn[1] <- mu[1];
an[1] <- mu[2]/sn[1];
#Coefficients of the orthogonal polynomials
Ank <- matrix(rep(0,(Nq+1)^2), nrow = Nq+1, ncol = Nq+1, byrow=TRUE);
#Initial values
Ank[1,1] <- 1;
Ank[2,1] <- - an[1];
Ank[2,2] <- 1;
#Starting recurrence
nn <- 2;
while(nn <= Nq){#Computing the coefficients of the squared polynomial
        Blj <- outer(Ank[nn,], Ank[nn,], FUN = "*");
        Cj <- rep(0,2*nn-1);
        j <- 1;
        while(j <= nn){l <- j;
                       while(l <= nn){if(j==l){Cj[j+l-1] <- Cj[j+l-1]+Blj[j,l]} else{Cj[j+l-1] <- Cj[j+l-1]+2*Blj[j,l]};
                l <- l+1};
        j <- j+1};
        #Computing the inner products and applying the recurrence relations
        sn[nn] <- sum(Cj*mu[1:(2*nn-1)]);
        an[nn] <- sum(Cj*mu[2:(2*nn)])/sn[nn];
        bn[nn] <- sn[nn]/sn[nn-1];
        k <- 1;
        while(k <= nn+1){if(k>1){Ank[nn+1,k] <- Ank[nn+1,k]+Ank[nn,k-1]};
                Ank[nn+1,k] <- Ank[nn+1,k]-an[nn]*Ank[nn,k]-bn[nn]*Ank[nn-1,k];
        k <- k+1};
nn <- nn+1};
#Computing the coefficients of the squared polynomial
Blj <- outer(Ank[nn,], Ank[nn,], FUN = "*");
Cj <- rep(0,2*nn-1);
j <- 1;
while(j <= nn){l <- j;
    while(l <= nn){if(j==l){Cj[j+l-1] <- Cj[j+l-1]+Blj[j,l]} else{Cj[j+l-1] <- Cj[j+l-1]+2*Blj[j,l]};
    l <- l+1};
j <- j+1};
#Computing the inner products and applying the recurrence relations
sn[nn] <- sum(Cj*mu[1:(2*nn-1)]);
an[nn] <- sum(Cj*mu[2:(2*nn)])/sn[nn];
bn[nn] <- sn[nn]/sn[nn-1];
an

一个明显的问题可能是力矩的计算，正如这里所做的那样，但是增加项的数量

N

没有帮助，更重要的是，使用力矩的精确值根本不会改变输出：

mu[1] <- 2/pi;
mu[2] <- 1/pi;
mu[3] <- 1/pi-4/pi^3;
mu[4] <- 1/pi-6/pi^3;
mu[5] <- (48 - 12 pi^2 + pi^4)/pi^5;
mu[6] <- (120 - 20 pi^2 + pi^4)/pi^5;
mu[7] <- (-1440 + 360 pi^2 - 30 pi^4 + pi^6)/pi^7;
mu[8] <- (-5040 + 840 pi^2 - 42 pi^4 + pi^6)/pi^7;
mu[9] <- (80640 - 20160 pi^2 + 1680 pi^4 - 56 pi^6 + pi^8)/pi^9;
mu[10] <- (362880 - 60480 pi^2 + 3024 pi^4 - 72 pi^6 + pi^8)/pi^9;
mu[11] <- (-7257600 + 1814400 pi^2 - 151200 pi^4 + 5040 pi^6 - 90 pi^8 + pi^10)/pi^11;
mu[12] <- (-39916800 + 6652800 pi^2 - 332640 pi^4 + 7920 pi^6 - 110 pi^8 + pi^10)/pi^11;

---

mu[1]在您引用的论文中：

然而，代数方程组的解
关于力矩µk的系数aj和bj的方程极为病态：“即使在双精度情况下，在n=12时失去所有精度也不罕见”[1]

求解给定µk的aj和bj的问题非常严重，并且随着点数的增加，问题会呈指数级恶化。换句话说，µk的微小变化（由于浮点数的精度有限）会导致相应的aj和bj发生较大变化

为了使用该方法获得准确的结果，有必要更准确地计算µk。
例如，您所在的论文发现，对于n=64，有必要将µk计算到数千位的精度
 在你引用的论文中：

然而，代数方程组的解
关于力矩µk的系数aj和bj的方程极为病态：“即使在双精度情况下，在n=12时失去所有精度也不罕见”[1]

求解给定µk的aj和bj的问题非常严重，并且随着点数的增加，问题会呈指数级恶化。换句话说，µk的微小变化（由于浮点数的精度有限）会导致相应的aj和bj发生较大变化

为了使用该方法获得准确的结果，有必要更准确地计算µk。
例如，您所在的论文发现，对于n=64，有必要将µk计算到数千位的精度
 浮点数算术通常不会在您使用它时提供精确的答案。因此，除非你采取特殊措施确保结果准确，否则你应该期望得到近似的答案。有什么原因让你期望得到准确的答案吗？@EricPostpischil，我不期望得到准确的答案，但我想知道数字的丢失是否不那么明显，仅此而已。我知道有一些步骤可以确保这一点（如Kahan的求和算法），但在这种情况下，它似乎没有帮助。浮点算法通常不会像您使用它时那样提供准确的答案。因此，除非你采取特殊措施确保结果准确，否则你应该期望得到近似的答案。有什么原因让你期望得到准确的答案吗？@EricPostpischil，我不期望得到准确的答案，但我想知道数字的丢失是否不那么明显，仅此而已。我知道有一些步骤可以确保这一点（比如Kahan的求和算法），但在这种情况下似乎没有帮助
mu[1] <- 2/pi;
mu[2] <- 1/pi;
mu[3] <- 1/pi-4/pi^3;
mu[4] <- 1/pi-6/pi^3;
mu[5] <- (48 - 12 pi^2 + pi^4)/pi^5;
mu[6] <- (120 - 20 pi^2 + pi^4)/pi^5;
mu[7] <- (-1440 + 360 pi^2 - 30 pi^4 + pi^6)/pi^7;
mu[8] <- (-5040 + 840 pi^2 - 42 pi^4 + pi^6)/pi^7;
mu[9] <- (80640 - 20160 pi^2 + 1680 pi^4 - 56 pi^6 + pi^8)/pi^9;
mu[10] <- (362880 - 60480 pi^2 + 3024 pi^4 - 72 pi^6 + pi^8)/pi^9;
mu[11] <- (-7257600 + 1814400 pi^2 - 151200 pi^4 + 5040 pi^6 - 90 pi^8 + pi^10)/pi^11;
mu[12] <- (-39916800 + 6652800 pi^2 - 332640 pi^4 + 7920 pi^6 - 110 pi^8 + pi^10)/pi^11;