Question

我不是程序员（这是我的第一篇文章），并且对浮点运算没有太多经验。如果错过明显的事情，我深表歉意。

我一直在尝试使用示例here描述的通用方法，使用自定义权重函数查找高斯求积的参数。当可以手动找到参数时，该方法适用于检查少量点的情况。

但是，对于大量的正交点，以数字方式计算参数是有意义的。这些力矩可以通过超几何函数表示，该函数由我在这里使用的快速收敛序列给出。

我用于计算必要参数an和bn的算法涉及显式地找到多项式的系数，并使用参考文献中提供的公式。最后，我们有一个复杂的循环，其中涉及许多加法，减法，乘法和除法。

问题是：我可以肯定的是，就我而言，所有an=0.5都正确。但是我在R中制定的算法很快就失去了数字，在第5步取而代之的是0.4999999981034791707302。为避免此问题，我该如何更改算法？

代码如下：

#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

我为an获得的输出是：

[1] 0.5000000000000000000000 0.5000000000000004440892 0.4999999999999593103261
[4] 0.4999999999963960495286 0.4999999998869631423482 0.4999999981034791707302

一个明显的问题可能是矩的计算，如此处所做的那样，但是增加项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;

使用R是我个人的偏爱（也是学习的机会），因此，如果您认为我需要使用另一种语言，我想我会在Mathematica中做到这一点，因为精度可以设置为任意高。

Answer 1

在您引用的论文中：

但是，这组代数的解就μ_k矩而言，系数a _j和b _j的方程式的条件极其恶劣：“即使在双精度下，在n = 12” [1]时失去所有精度的情况并不少见。

在给定µ _k的情况下求解a _j和b _j的问题极度ill-conditioned，并且随着指数的增加而恶化点数。换句话说，μ_k的微小变化（由于浮点数的精度有限）导致相应的a _j和b _{j < / sub>。}

要使用此方法获得准确的结果，必须显着更准确地计算µ _k。例如，您所访问的论文发现有必要计算n <64的µ _k到几千位数的精度。

与高斯正交有关的R的复杂重复中的重要性丧失

1 个答案: