在嵌套函數中傳遞參數和默認參數

Question

我有一個函數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
}

請注意，給定默認的積分上下限，我希望僅在指定參數的情況下運行函數時，它將返回x的均值。

我有第二個函數int_gb2 ，它是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

我花了多個小時來調整它，並且我一直想生成tome替代錯誤消息，但總是針對丟失的x，X或參數。

Answer 1

這里似乎有兩個問題，都與傳遞參數有關：在第一個傳遞的參數太多，在第二個傳遞的參數太少。

首先，在x_pdf定義中，您使用一個帶有單個參數的匿名函數（ function(X){dfun(x=X)} ），但是您還嘗試將其他參數（ params列表）傳遞給該匿名函數與do.call ，這將引發錯誤。 該部分應該看起來像這樣：

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

現在，您已經定義了x_pdf以要求 3個參數： X ， dfun和params ； 但是，當您使用integrate調用x_pdf ，您沒有傳遞dfun和params參數，這將再次引發錯誤。 您也可以通過傳遞dfun和params來解決此問題：

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

但是也許更x_pdf解決方案是從x_pdf的定義中刪除其他參數（因為dfun和params已經在封閉環境中定義了），以獲得更緊湊的結果：

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軟件包 （v0.2.0）於2018-02-17創建。

如果您已經閱讀了本文，那么您可能還會喜歡Hadley Wickham的AdvancedR 。

---

更多額外的位

@andrewH我從您的評論中了解到，您可能正在尋找截斷分布的均值，例如，找到部分分布的均值高於整個分布的均值。

要做到這一點，僅將第一時刻的被積分數從平均值上積分是不夠的：您還必須在被積分數之后重新縮放被積分數中的PDF，以使其再次成為合適的PDF（彌補丟失的部分）概率質量（如果可以的話）為“手波-Y”形。 您可以通過將原始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