如何将 Rmpfr 值放入 R 中的函数中？答案

【问题标题】：How to put Rmpfr values into a function in R?如何将 Rmpfr 值放入 R 中的函数中？
【发布时间】：2018-08-09 17:37:07
【问题描述】：

我正在计算 Vandermonde 矩阵的逆矩阵。我已经编写了代码来通过其公式显式计算逆：

library(gtools)

#input is the generation vector of terms of Vandermonde matrix.
FMinv <- function(base){
  n=length(base)
  inv=matrix(nrow=n,ncol=n)
  for (i in 1:n){
    for (j in 1:n){
      if(j<n){
        a=as.matrix(combinations(n,n-j,repeats.allowed = F))
        arow.tmp=nrow(a) #this is in fact a[,1]
        b=which(a==i)%%length(a[,1])
        nrowdel=length(b)
        b=replace(b,b==0,length(a[,1]))
        a=a[-b,]
        if(arow.tmp-nrowdel>1){
          a=as.matrix(a)
          nrowa=nrow(a)
          prod=vector()
          for(k in 1:nrowa){
            prod[k]=prod(base[a[k,]])
          }
          num=sum(prod)
        }
        if(arow.tmp-nrowdel==1){
          num=prod(base[a])
        }
        den=base[i]*prod(base[-i]-base[i])
        inv[i,j]=(-1)^(j-1)*num/den
      }
      if(j==n){
        inv[i,j]=1/(base[i]*prod(base[i]-base[-i]))
      }
    }
  }
  return(inv)
}

我定义一个基数如下：

> library(Rmpfr)
> a=mpfr(c(10:1),1000)/Rmpfr::mpfr(sum(1:10),1000)
> a
10 'mpfr' numbers of precision  1000   bits 
 [1]  0.18181818181818181818181818181818181818181818181818181818181818181818181818181818181818181818181818181818181818181818181818181818181818181818181818181818181818181818181818181818181818181818181818181818181818181818181818181818181818181818181818181818181818181818181818181818181818181818181818181818181819
 [2]  0.16363636363636363636363636363636363636363636363636363636363636363636363636363636363636363636363636363636363636363636363636363636363636363636363636363636363636363636363636363636363636363636363636363636363636363636363636363636363636363636363636363636363636363636363636363636363636363636363636363636363637
 [3]  0.14545454545454545454545454545454545454545454545454545454545454545454545454545454545454545454545454545454545454545454545454545454545454545454545454545454545454545454545454545454545454545454545454545454545454545454545454545454545454545454545454545454545454545454545454545454545454545454545454545454545456
 [4]  0.12727272727272727272727272727272727272727272727272727272727272727272727272727272727272727272727272727272727272727272727272727272727272727272727272727272727272727272727272727272727272727272727272727272727272727272727272727272727272727272727272727272727272727272727272727272727272727272727272727272727274
 [5]  0.10909090909090909090909090909090909090909090909090909090909090909090909090909090909090909090909090909090909090909090909090909090909090909090909090909090909090909090909090909090909090909090909090909090909090909090909090909090909090909090909090909090909090909090909090909090909090909090909090909090909091
 [6] 0.090909090909090909090909090909090909090909090909090909090909090909090909090909090909090909090909090909090909090909090909090909090909090909090909090909090909090909090909090909090909090909090909090909090909090909090909090909090909090909090909090909090909090909090909090909090909090909090909090909090909094
 [7] 0.072727272727272727272727272727272727272727272727272727272727272727272727272727272727272727272727272727272727272727272727272727272727272727272727272727272727272727272727272727272727272727272727272727272727272727272727272727272727272727272727272727272727272727272727272727272727272727272727272727272727278
 [8] 0.054545454545454545454545454545454545454545454545454545454545454545454545454545454545454545454545454545454545454545454545454545454545454545454545454545454545454545454545454545454545454545454545454545454545454545454545454545454545454545454545454545454545454545454545454545454545454545454545454545454545455
[9] 0.036363636363636363636363636363636363636363636363636363636363636363636363636363636363636363636363636363636363636363636363636363636363636363636363636363636363636363636363636363636363636363636363636363636363636363636363636363636363636363636363636363636363636363636363636363636363636363636363636363636363639
[10] 0.018181818181818181818181818181818181818181818181818181818181818181818181818181818181818181818181818181818181818181818181818181818181818181818181818181818181818181818181818181818181818181818181818181818181818181818181818181818181818181818181818181818181818181818181818181818181818181818181818181818181819

但是，当我尝试将“a”放入函数时，我得到了：

> FMinv(a)
Error in sum(prod) : invalid 'type' (list) of argument

通过检查其类型，

> typeof(a)
[1] "list"

我知道将其转换为值的唯一方法是 Rmpfr 中的 asNumeric()。然而，

> asNumeric(a)
 [1] 0.18181818 0.16363636 0.14545455 0.12727273 0.10909091 0.09090909 0.07272727 0.05454545 0.03636364 0.01818182

它丢失了剩余的数字。

有没有办法将“a”放入我的函数而不丢失小数？

谢谢！

【问题讨论】：

标签： r precision

【解决方案1】：

诀窍是使用 S3 方法。
定义一个通用的默认方法，用你的“正常”数字调用，意思是 "numeric" 类的对象和问题所要求的函数。

这是问题之一。花了一些时间，但我相信下面的代码是正确的。

library(OBsMD)

FMinv <- function(...) UseMethod("FMinv")

FMinv.default <- function(base) {
    # Your function
    # unchanged
}



FMinv.mpfr <- function(base, precBits = getPrec(base)) {
    n <- length(base)
    inv <- mpfr(rep(0, n*n), precBits = precBits)
    inv <- matrix(inv, nrow = n, ncol = n)
    for (i in 1:n) {
        for (j in 1:n) {
            if (j < n) {
                a <- combinations(n, n - j, repeats.allowed = F)
                a <- as.matrix(a)
                arow.tmp <- nrow(a)  # this is in fact a[, 1]
                b <- which(a == i) %% length(a[, 1])
                nrowdel <- length(b)
                b <- replace(b, b == 0, length(a[, 1]))
                a <- a[-b, ]
                num <- mpfr(0, precBits[1])
                if (arow.tmp - nrowdel > 1) {
                  a <- as.matrix(a)
                  nrowa <- nrow(a)
                  for (k in 1:nrowa) {
                    num <- num + prod(base[a[k, ]])
                  }
                }
                if (arow.tmp - nrowdel == 1) {
                  num <- num + prod(base[a])
                }
                den <- base[i] * prod(base[-i] - base[i])
                inv[i, j] <- (-1)^(j - 1) * num/den
            }
            if (j == n) {
                inv[i, j] <- 1/(base[i] * prod(base[i] - base[-i]))
            }
        }
    }
    return(inv)
}

现在测试这两种方法并比较一些结果的值。

library(Rmpfr)

a <- mpfr(c(10:1),1000)/Rmpfr::mpfr(sum(1:10),1000)

inv1 <- FMinv(asNumeric(a))
inv2 <- FMinv(a)

inv1[10, 10]
#[1] -6.98014e+11

inv2[10, 10]
#1 'mpfr' number of precision  1000   bits 
#[1] -698013564040.84166942239858906525573192239858906525573192239858906525573192239858906525573192239858906525573192239858906525573192239858906525573192239858906525573192239858906525573192239858906525573192239858906525573192239858906525573192239858906525573192239858906525573192239858906525573192239858906474

【讨论】：