内部调用 `maply(FUN=FUN, ...)` 时如何获取函数的代码；特别是函数“distributionsrd::qdoubleparetolognormal”

Question

tldr；我想要用于计算

distributionsrd

包中的双帕累托对数正态分位数的数学表达式，函数

qdoubleparetolognormal

。在内部

mapply(FUN=FUN,...)

被调用，我没有看到任何数学或

FUN

的定义。

我已成功使用 copula 包来拟合具有双帕累托对数正态边际的正态 copula（使用

dparetolognormal

包中的

pparetolognormal

和

distributionsrd

函数；注意，我必须稍微重新安排这些函数中的计算，以防止数值溢出[组合指数]）。在尝试使用函数

rMvdc

生成随机数时，我收到错误

Error in uniroot(function(q, shape1, shape2, meanlog, sdlog, p) { :    no sign change found in 1000 iterations

我在内部看到

rMvdc

正在呼叫

qdoubleparetolognormal

。我想看看

qdoubleparetolognormal

在哪里调用了

uniroot

，所以我打印了函数代码并得到

> qdoubleparetolognormal
function (p, shape1 = 1.5, shape2 = 1.5, meanlog = -0.5, sdlog = 0.5, 
    lower.tail = TRUE, log.p = FALSE) 
{
    args <- lapply(as.list(match.call())[-1L], eval, parent.frame())
    names <- if (is.null(names(args))) 
        character(length(args))
    else names(args)
    dovec <- names %in% vectorize.args
    do.call("mapply", c(FUN = FUN, args[dovec], MoreArgs = list(args[!dovec]), 
        SIMPLIFY = SIMPLIFY, USE.NAMES = USE.NAMES))
}
<bytecode: 0x00000224fdf267f0>
<environment: 0x00000224fdf1f460>

我想知道

FUN=FUN

在做什么，因为工作区中没有名为

FUN

的变量。所以查看了

mapply

文档：

FUN     function to apply, found via match.fun.

我的猜测是

FUN=FUN

再次使用

match.fun()

来调用

qdoubleparetolognormal

？但我对如何获取

qdoubleparetolognormal

在最后一步中使用的内部代码（在调用

match.fun()

后）感到困惑。如何获得实际进行数学运算的函数定义？

Answer 1

我不知道你想实现什么目标。

mapply

函数仅用于矢量化。这与解决问题无关。这是一个可以完成您想要的功能：

my_qdoubleparetolognormal1 <- function (p, shape1 = 1.5, shape2 = 1.5, meanlog = -0.5, sdlog = 0.5, 
          lower.tail = TRUE, log.p = FALSE){
  p <- if(log.p) exp(p) else p
  p <- if (lower.tail) p else  1 - p
  fn <- \(q) pdoubleparetolognormal(q, shape1, shape2, meanlog, sdlog) - p
  uniroot(fn, interval = c(1e-06, 1), extendInt = "yes")$root
}

---

请注意，上面的函数有时会发出警告，因为扩展 = 是。

my_qdoubleparetolognormal1(0.1)
[1] 0.1723352
qdoubleparetolognormal(0.1) # one from the package
[1] 0.1723352

该函数未矢量化。这就是为什么他们使用

mapply

来完成矢量化。我们将使用

mapply

my_qdoubleparetolognormal_vec <- function (p, shape1 = 1.5, shape2 = 1.5, meanlog = -0.5, sdlog = 0.5, 
                                           lower.tail = TRUE, log.p = FALSE){
  
  mapply(my_qdoubleparetolognormal1, p, shape1, shape2, meanlog, sdlog, lower.tail, log.p)
}

---

将该功能与内置功能进行比较：

x <- seq(0.1,0.9,0.1)
my_qdoubleparetolognormal_vec(x)
[1] 0.1723352 0.2783234 0.3781708 0.4841963 0.6065086 0.7598161 0.9727864 1.3217682 2.1345231

qdoubleparetolognormal(x)
[1] 0.1723352 0.2783234 0.3781708 0.4841963 0.6065086 0.7598161 0.9727864 1.3217682 2.1345231