R 如何创建返回具有不同参数的函数的函数？

我试图在R中编写一个函数，它接受两个函数（用一个可以被视为相同的参数定义），将它们相乘，并返回在某个新点上求值的乘积的积分。现在，乘函数并不是那么难，这里的问题在于，我不想计算参数

x

中的一个函数，而是想在

w/x

中计算它，其中

w

是新的参数（但我只想在函数乘积中这样做）。这是我的密码：

    "%*f%" <- function(a,b) {
        force(a)
        force(b)
        function(x){a(x) * b(x)}
    }

    pdf_product <- function(pdf1, pdf2) {
        pdf3 <- function(x,w) {pdf2(w/x)}

        myfun <- function(x,w) {
            (1/abs(x)) %*f% pdf1(x) %*f% pdf3(x,w)
        }

        function(w) {
           sapply(w, function(w) {
               integrate(function(x) myfun(x,w), llim, ulim)$value
           })
        }
    }

    pdf1 <- function(x) {1/(2-1)} #simple function example1
    pdf2 <- function(x) {1/(6-3)} #simple function example2
    llim <- 1 #lower limit integral
    ulim <- 2 #upper limit integral

    prod <- pdf_product(pdf1, pdf2)
    prod(4) #should evaluate to 0.09589402

---

我感觉这个错误与我通过定义

pdf2

中的

pdf3

引入的“变量更改”有关，但我找不到修复它的方法。我曾尝试在函数中使用著名的R三点原理，该函数返回

%*f%

，但也不起作用。

因此，您的问题是您想要组合两个函数，但这些函数可以有两个以上的参数。这可能有用：

"%*f%" <- function(a,b, ...) {
  force(a)
  force(b)
  if (length(formals(args(a))) > 1L && 
      length(formals(args(b))) > 1L)
    stop("Only one function with additional parameters allowed.")
  if (length(formals(args(a))) == 1L && 
      length(formals(args(b))) > 1L)
    return(function(x, ...){a(x) * b(x, ...)})
  if (length(formals(args(a))) > 1L && 
      length(formals(args(b))) == 1L)
    return(function(x, ...){a(x, ...) * b(x)})
  if (length(formals(args(a))) == 1L && 
      length(formals(args(b))) == 1L)
    return(function(x){a(x) * b(x)})
  stop("Function without parameters passed")
}

(sign %*f% abs)(-5)
#[1] -5
(sign %*f% `+`)(-5, 1)
#[1] 4

“%*f%”1L&&
长度（形式（参数（b））>1L）
停止（“仅允许一个具有附加参数的函数。”）
如果（长度（形式参数（a））==1L&&
长度（形式（参数（b））>1L）
返回（函数（x，…{a（x）*b（x，…）}）
如果（长度（形式参数（a））>1L&&
长度（形式（参数（b））==1L）
返回（函数（x，…{a（x，…）*b（x）}）
如果（长度（形式参数（a））==1L&&
长度（形式（参数（b））==1L）
返回（函数（x）{a（x）*b（x）}）
停止（“未传递参数的函数”）
}
（符号%*f%abs）（-5）
#[1] -5
（符号%*f%`+`（-5,1）
#[1] 4

请注意，如果两个函数都可以有多个参数，则需要设计不同的传递方式：

"%*f%" <- function(a,b, args1 = NULL, args2 = NULL) {
  stopifnot(is.list(args1) | is.null(args1))
  stopifnot(is.list(args2) | is.null(args2))
  force(a)
  force(b)
  if (length(formals(args(a))) > 1L && 
      length(formals(args(b))) > 1L)
    return(function(x, args1, args2) do.call(a, c(x, args1)) * do.call(b, c(x, args2)))
  #code for the other cases
}

(`^` %*f% `+`)(-5, list(2), list(1))
#[1] -100

“%*f%”1L&&
长度（形式（参数（b））>1L）
返回（函数（x，args1，args2）do.call（a，c（x，args1））*do.call（b，c（x，args2）））
#其他案例的代码
}
（`^`%*f%`+`）（-5，列表（2），列表（1））
#[1] -100

---

如果您是管道迷，最好研究一下使用package magrittr。

我很困惑。您的

“%*f%”

由函数组成，但在

（1/abs（x））%*f%pdf1（x）%*f%pdf3（x，w）

中，您不会向其传递函数

1/abs（x）

返回一个值。啊，我明白你的意思了，谢谢。但是如果我更改它，错误消息将从上面更改为

未使用的参数w

。

"%*f%" <- function(a,b, args1 = NULL, args2 = NULL) {
  stopifnot(is.list(args1) | is.null(args1))
  stopifnot(is.list(args2) | is.null(args2))
  force(a)
  force(b)
  if (length(formals(args(a))) > 1L && 
      length(formals(args(b))) > 1L)
    return(function(x, args1, args2) do.call(a, c(x, args1)) * do.call(b, c(x, args2)))
  #code for the other cases
}

(`^` %*f% `+`)(-5, list(2), list(1))
#[1] -100