Question

我有一个Ax = b型线性系统 - 其中A是一个上三角矩阵。 A的结构定义如下：

    comp.Amat <- function(i,j,prob) ifelse(i > j, 0, dbinom(x=i, size=j, prob=prob))

    prob <- 1/4
    A <- outer(1:50, 1:50 , FUN=function(r,c) comp.Amat(r,c,prob) )

A中的条目是二项式概率 - 问题是当A的大小增加时，对角线条目快速接近0。

如果我们也按如下方式定义向量b：

    b <- seq(1,50,1);

然后求解（a = A，b = b） - 给出错误：

    "  system is computationally singular: reciprocal condition number = 1.07584e-64"

这是有道理的，因为对角线条目几乎为0，所以矩阵变得不可逆。

作为解决方法，我编写了以下递归函数 - 它开始计算最后一个对角线条目的值，然后替换前一行中的值。由于矩阵中的每个条目都是 dbinom（j，i，prob），因为j =＆gt; i：我可以通过这种方式获得解决方案。

    solve.for.x.custom <- function(A, b, prob)
    {

      n =length(A[1,])
      m =length(A[,1])

      x = seq(1,n, 1);
      x[x> 0] = -1000;

      calc.inv.Aii <- function(i,j, prob)
      {
        res = (1 / (prob*(1-prob)))^i;
        return(res);


      }

      for (i in m:1 )
      {

        if(i ==m)
        {
  rhs =0;

        }else
        {
          rhs=0;
          for(j in m:(i+1))
          {
            rhs =  dbinom(x=i,size=j,prob=prob)*x[j] + rhs;
          }

        }

        x[i] = (b[i] - rhs)*calc.inv.Aii(i,i);

      }
      print(x)
      return(x)

    }

我的问题是 - 当我用矩阵A乘以这个解 x'时，错误（Ax'-b）是巨大的。由于我有一个解析解（x_i中的每个条目都可以用二项式概率乘以先前的值来描述） - 我应该得到的错误是每行0-。

我看到（1 /（1 / a））可能因为这些问题而不等于a。但是，目前的错误确实很大（-1.13817489781529e + 168）。

    x_prime=solve.for.x.custom(A, b, prob)
    A%*%x_prime - b
    #output
                    [,1]
     [1,] -1.13817489781529e+168
     [2,]  2.11872209742428e+167
     [3,] -1.58403954589004e+166
     [4,]  6.52328959209082e+164
     [5,] -1.69562573261261e+163
     [6,]  3.00614551450976e+161
    ***
    [49,]  -7.58010305220250e+08
    [50,]   9.65162608741321e+03

我真的很感激你推荐任何建议或有效的方法。我给A和B的大小为50但是我打算也增长它们，因此在这种情况下，错误也会增加。

Answer 1

如果您的矩阵A是上三角形，您可能希望使用backsolve(A, b)而不是solve(A, b)。

您可以使用Rmpfr在R中执行任意精度，这需要编写backsolve的兼容版本。使用下面的代码，我们可以得到

> print(max(abs(b - .b)), digits=5)
1 'mpfr' number of precision  1024   bits 
[1] 2.9686e-267

但有一个重要的警告：A中的值可能不够准确，因为它们来自dbinom而非使用mpfr目标。根据您的最终目标，您可能需要使用dbinom编写自己的Rmpfr版本。

library(Rmpfr)

logcomp.Amat <- function(i,j,prob) ifelse(i > j, -Inf, dbinom(x=i, size=j, prob=prob, log=TRUE))

nbits <- 1024

.backsolve <- function(A, b) {

    n <- length(b)
    x <- mpfr(numeric(n), nbits)

    for(i in rev(seq_len(n))) {

        known <- i + seq_len(n - i)
        z <- if(length(known) > 0) sum(A[i,known] * x[known]) else 0

        x[i] <- (b[i] - z) / A[i,i]
    }

    return(x)
}

logA <- outer(1:50, 1:50, logcomp.Amat, prob=1/4)
b <- 1:50

A <- exp(mpfr(logA, nbits))
b <- mpfr(b, nbits)

x <- .backsolve(A, b)

.b <- as.vector(A %*% x)

递归反转线性系统 - 获得巨大的错误（精度）

1 个答案: