У меня есть функция 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_pdf, предназначенную для ее специализации для обобщенного бета-распределения второго типа.

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

Я потратил несколько часов на настройку этого, и мне удалось сгенерировать альтернативные сообщения об ошибках, но всегда в отношении отсутствующих x, X или params.

1
andrewH 17 Фев 2018 в 10:37

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; но когда вы вызываете x_pdf с integrate, вы не передаете аргументы dfun и params, что снова вызовет ошибку. Вы можете обойти это, передав dfun и params:

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

Но, возможно, более изящным решением было бы просто удалить дополнительные аргументы из определения 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)
}

Создано 17 февраля 2018 г. пакетом REPEX (v0.2.0).

Если вы дочитали до этого места, вам также может понравиться Advanced R от Hadley. Уикхэм.


Больше дополнительных бит

@andrewH Из вашего комментария я понял, что вы, возможно, ищете средства усеченных дистрибутивов, например найти среднее значение для части распределения выше среднего для всего распределения.

Для этого недостаточно просто интегрировать подынтегральное выражение первого момента вверх от среднего значения: вам также придется масштабировать PDF в подынтегральном выражении, чтобы снова сделать его правильным 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
2
Mikko Marttila 27 Фев 2018 в 10:26