R函数使用函数作为参数，每个函数都带有可变参数

Question

In answer to a question on Cross Validated , I wrote a simple function that used arbitrary quantile functions as its arguments

etacor=function(rho=0,nsim=1e4,fx=qnorm,fy=qnorm){
  #generate a bivariate correlated normal sample
  x1=rnorm(nsim);x2=rnorm(nsim)
  if (length(rho)==1){
    y=pnorm(cbind(x1,rho*x1+sqrt((1-rho^2))*x2))
    return(cor(fx(y[,1]),fy(y[,2])))
    }
  coeur=rho
  rho2=sqrt(1-rho^2)
  for (t in 1:length(rho)){
     y=pnorm(cbind(x1,rho[t]*x1+rho2[t]*x2))
     coeur[t]=cor(fx(y[,1]),fy(y[,2]))}
  return(coeur)
  }

However, both fx and fy may require their own parameters. For instance, when fx=qchisq or when fy=qgamma . As a default solution, in my implementation, I used

fx=function(x) qchisq(x,df=3)

and

fy=function(x) qgamma(x,scale=.2)

but this is quite time consuming.

For instance,

> rhos=seq(-1,1,.01)
> system.time(trancor<-etacor(rho=rhos,fx=qlnorm,fy=qexp))
utilisateur     système      écoulé 
      0.834       0.001       0.834 

versus

> system.time(trancor<-etacor(rho=rhos,fx=qlnorm,fy=function(x) qchisq(x,df=3)))
utilisateur     système      écoulé 
      8.673       0.006       8.675 

Answer 1

An illustration of my comment above:

etacor1 <- function(rho = 0,
                    nsim = 1e4,
                    fx = qnorm,
                    fy = qnorm,
                    fx.args = formals(fx),
                    fy.args = formals(fy)){
    #generate a bivariate correlated normal sample
    x1 <- rnorm(nsim)
    x2 <- rnorm(nsim)

    fx.arg1 <- names(formals(fx))[1]
    fy.arg1 <- names(formals(fy))[1]

    if (length(rho) == 1){
        y <- pnorm(cbind(x1, rho * x1 + sqrt((1 - rho^2)) * x2))
        fx.args[[fx.arg1]] <- y[,1]
        fy.args[[fy.arg1]] <- y[,2]
        return(cor(do.call(fx,as.list(fx.args)),
                   do.call(fy,as.list(fy.args))))
    }

    coeur <- rho
    rho2 <- sqrt(1 - rho^2)

    for (t in 1:length(rho)){
        y <- pnorm(cbind(x1,rho[t]*x1+rho2[t]*x2))
        fx.args[[fx.arg1]] <- y[,1]
        fy.args[[fy.arg1]] <- y[,2]
        coeur[t] <- cor(do.call(fx,as.list(fx.args)),
                        do.call(fy,as.list(fy.args)))
    }

    return(coeur)
}

I am displeased with the apparent necessity of as.list . I feel like I should know why that is, but it is escaping me at the moment.

In using this function, it should not be necessary to pass in all arguments, but you do need to make sure any list you pass to fx.args or fy.args is named.

Answer 2

Thanks for the comments and answer! I fear the core issue is that, as pointed out by joran and Mr Flick , some quantile functions are much slower to execute than others:

> system.time(etacor(rhos,fx=function(x) qexp(x)))
utilisateur     système      écoulé 
      1.182       0.000       1.182 
> system.time(etacor(rhos,fx=qexp))
utilisateur     système      écoulé 
      1.238       0.000       1.239 

versus

> system.time(etacor(rhos,fx=function(x) qchisq(x,df=3)))
utilisateur     système      écoulé 
      4.955       0.000       4.951 
> system.time(etacor(rhos,fx=function(x) qgamma(x,sha=.3)))
utilisateur     système      écoulé 
      4.316       0.000       4.314 

So in the end using the definition of the function when it requires parameters does seem as a straightforward and easy solution. Thanks for all of your inputs.