在嵌套函数中传递参数和默认参数

时间:2018-02-17 07:37:02

标签: r scope nested parameter-passing evaluation

我有一个函数x_pdf,它应该计算x * dfun(x | params),其中dfun是概率密度函数,params是命名参数列表。它在另一个函数int_pdf内定义,该函数应该在指定的边界之间集成x_pdf

int_pdf <- function(lb = 0, ub = Inf, dfun, params){
  x_pdf <- function(X, dfun, params){X * do.call(function(X){dfun(x=X)}, params)}
    out <- integrate(f = x_pdf, lower=lb, upper=ub, subdivisions = 100L)
  out
}

请注意,鉴于我对集成的下限和上限的默认值,我希望当函数运行时只指定了params,它将返回x的平均值。

我有第二个函数int_gb2,它是int_pdf的包装器,旨在将其专门化为第二类的广义beta分布。

library(GB2)

int_gb2 <- function(lb = 0, ub = Inf, params){
  int_pdf(lb, ub, dfun = dgb2, params = get("params"))
}

当我按如下方式运行该功能时:

GB2_params   <-  list(shape1 = 3.652, scale = 65797, shape2 = 0.3, shape3 = 0.8356)
int_gb2(params = GB2_params)

我明白了:

 Error in do.call(what = function(X) { : 
  argument "params" is missing, with no default

我花了几个小时来调整这个,并且我已经使用nanaged来生成大部分替代错误消息,但总是针对丢失的x,X或params。

1 个答案:

答案 0 :(得分:2)

这里似乎存在两个问题,两者都与传递参数有关:第一个传递的参数太多,而第二个传递的参数太少。

首先,在x_pdf定义中,您使用一个带有单个参数(function(X){dfun(x=X)})的匿名函数,但您也尝试传递其他参数(params列表)使用do.call表示匿名函数,这会抛出错误。那部分应该看起来像这样:

do.call(dfun, c(list(x = X), params))

现在,您已将x_pdf定义为需要 3个参数:Xdfunparams;但是当您使用x_pdf致电integrate时,您没有传递dfunparams个参数,这又会引发错误。您也可以通过传递dfunparams来解决这个问题:

integrate(f = x_pdf, lower=lb, upper=ub, subdivisions = 100L, dfun, params)

但也许一个更简洁的解决方案就是从x_pdf的定义中删除其他参数(因为dfunparams已在封闭环境中定义),以获得更多结果紧凑:

int_pdf <- function(lb = 0, ub = Inf, dfun, params){
  x_pdf <- function(X) X * do.call(dfun, c(list(x = X), params))
  integrate(f = x_pdf, lower = lb, upper = ub, subdivisions = 100L)
}

使用int_pdf的定义,一切都应该按预期工作:

GB2_params <- list(shape1 = 3.652, scale = 65797, shape2 = 0.3, shape3 = 0.8356)
int_gb2(params = GB2_params)
#> Error in integrate(f = x_pdf, lower = lb, upper = ub, subdivisions = 100L):
#>   the integral is probably divergent

喔。示例参数是否缺少scale参数的小数点?

GB2_params$scale <- 6.5797
int_gb2(params = GB2_params)
#> 4.800761 with absolute error < 0.00015

额外位

我们还可以使用一些函数式编程来创建一个函数工厂,以便轻松创建函数来查找第一个以外的时刻:

moment_finder <- function(n, c = 0) {
  function(f, lb = -Inf, ub = Inf, params = NULL, ...) {
    integrand <- function(x) {
      (x - c) ^ n * do.call(f, c(list(x = x), params))
    }
    integrate(f = integrand, lower = lb, upper = ub, ...)
  }
}

要找到平均值,您只需创建一个函数来查找第一个时刻:

find_mean <- moment_finder(1)

find_mean(dnorm, params = list(mean = 2))
#> 2 with absolute error < 1.2e-05
find_mean(dgb2, lb = 0, params = GB2_params)
#> 4.800761 with absolute error < 0.00015

对于差异,您必须找到第二个中心时刻:

find_variance <- function(f, ...) {
  mean <- find_mean(f, ...)$value
  moment_finder(2, c = mean)(f, ...)
}

find_variance(dnorm, params = list(mean = 2, sd = 4))
#> 16 with absolute error < 3.1e-07
find_variance(dgb2, lb = 0, params = GB2_params)
#> 21.67902 with absolute error < 9.2e-05

或者我们可以进一步概括,并找到预期的值 任何转变,而不仅仅是片刻:

ev_finder <- function(transform = identity) {
  function(f, lb = -Inf, ub = Inf, params = NULL, ...) {
    integrand <- function(x) {
      transform(x) * do.call(f, c(list(x = x), params))
    }
    integrate(f = integrand, lower = lb, upper = ub, ...)
  }
}

现在moment_finder将是一个特例:

moment_finder <- function(n, c = 0) {
  ev_finder(transform = function(x) (x - c) ^ n)
}

reprex package(v0.2.0)创建于2018-02-17。

如果你已经读过这篇文章,你可能也会喜欢Hadley Wickham的Advanced R

更多额外位

@andrewH我从你的评论中了解到你可能正在寻找截断分布的方法,例如:找到分布部分的均值高于整个分布的均值。

要做到这一点,仅仅将第一时刻的积分从平均值中整合起来是不够的:您还必须在被积函数中重新缩放PDF,使其成为在截断之后再次使用适当的PDF(弥补丢失的概率质量,如果你愿意的话,在&#34;手持波浪&#34;语言中)。您可以通过在截断的PDF的支持下除以原始PDF的积分来实现。

以下是更好地传达我的意思的代码:

library(purrr)
library(GB2)

find_mass <- moment_finder(0)
find_mean <- moment_finder(1)

GB2_params <- list(shape1 = 3.652, scale = 6.5797, shape2 = 0.3, shape3 = 0.8356)
dgb2p <- invoke(partial, GB2_params, ...f = dgb2)  # pre-apply parameters

# Mean value
(mu <- find_mean(dgb2p, lb = 0)$value)
#> [1] 4.800761

# Mean for the truncated distribution below the mean
(lower_mass <- find_mass(dgb2p, lb = 0, ub = mu)$value)
#> [1] 0.6108409
(lower_mean <- find_mean(dgb2p, lb = 0, ub = mu)$value / lower_mass)
#> [1] 2.40446

# Mean for the truncated distribution above the mean
(upper_mass <- find_mass(dgb2p, lb = mu)$value)
#> [1] 0.3891591
(upper_mean <- find_mean(dgb2p, lb = mu)$value / upper_mass)
#> [1] 8.562099

lower_mean * lower_mass + upper_mean * upper_mass
#> [1] 4.800761