Passing arguments and default arguments in nested functions - r

Question

I have a function, x_pdf, that is supposed to calculate x*dfun(x|params) where dfun is a probability density function and params is a list of named parameters. It is defined inside of another function, int_pdf, that is supposed to integrate x_pdf between specified bounds:
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
}
Note that, given my defaults for the lower and upper bound of integration, I expect that when the function is run with only the params specified it will return the mean of x.
I have a second function, int_gb2, that is a wrapper for int_pdf intended to specialize it to the generalized beta disttribution of the second kind.
library(GB2)
int_gb2 <- function(lb = 0, ub = Inf, params){
int_pdf(lb, ub, dfun = dgb2, params = get("params"))
}
When I run the function as follows:
GB2_params <- list(shape1 = 3.652, scale = 65797, shape2 = 0.3, shape3 = 0.8356)
int_gb2(params = GB2_params)
I get:
Error in do.call(what = function(X) { :
argument "params" is missing, with no default
I have spent multiple hours tweaking this, and I have nanaged to generate tome alternative error messages, but always with respect to a missing x, X, or params.

Answer 1

There seems to be two problems here, both related to passing arguments: in the first one there are too many arguments being passed, and in the second one, too few.
First off, in your x_pdf definition, you use an anonymous function that takes a single argument (function(X){dfun(x=X)}), but you also try to pass additional arguments (the params list) to said anonymous function with do.call, which will throw an error. That part should instead look something like this:
do.call(dfun, c(list(x = X), params))
Now, you've defined x_pdf to require 3 arguments: X, dfun, and params; but when you call x_pdf with integrate you're not passing the dfun and params arguments, which again will throw an error. You could get around that by passing dfun and params, too:
integrate(f = x_pdf, lower=lb, upper=ub, subdivisions = 100L, dfun, params)
But perhaps a neater solution would be to just remove the additional arguments from the definition of x_pdf (since dfun and params are already defined in the enclosing environment), for a more compact result:
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)
}
With this definition of int_pdf, everything should work as you expect:
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
Oh. Are the example parameters missing a decimal point from the scale argument?
GB2_params$scale <- 6.5797
int_gb2(params = GB2_params)
#> 4.800761 with absolute error < 0.00015
Extra bits
We could also use some functional programming to create a function factory to make it easy to create functions for finding moments other than the first one:
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, ...)
}
}
To find the mean, you would just create a function to find the first moment:
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
For variance, you'd have to find the second central moment:
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
Alternatively we could just generalise further, and find the expected value
of any transformation, rather than just moments:
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, ...)
}
}
Now moment_finder would be a special case:
moment_finder <- function(n, c = 0) {
ev_finder(transform = function(x) (x - c) ^ n)
}
Created on 2018-02-17 by the reprex package (v0.2.0).
If you've read this far, you might also enjoy Advanced R by Hadley Wickham.
More extra bits
#andrewH I understood from your comment that you might be looking to find means of truncated distributions, e.g. find the mean for the part of the distribution above the mean of the entire distribution.
To do that, it's not enough to just integrate the first moment's integrand up from the mean value: you'll also have to rescale the PDF in the integrand, to make it a proper PDF again, after the truncation (make up for the lost probability mass, if you will, in a "hand wave-y" figure of speech). You can do that by dividing with the integral of the original PDF over the support of the truncated one.
Here's the code to better convey what I mean:
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