如何在R中找到關於向量化變量的導數

Question

我在 R 中有以下函數，我可以很容易地找到它關於 x1 或 x2 或 x3 的偏導數：

ppp <- function(x1,x2, x3, m)  { 
n*log(m[1]*exp(x1) + m[2]*exp(x2) + m[3]*exp(x3) + m[4]) 
}
Deriv(ppp, "x3")

如何使函數自動化，以便找到導數為Deriv(ppp, "x[3]") ？

我試過這樣的事情，但它不起作用：

ppp <- function(x, m)  { 
n*log(m[1]*exp(x[1]) + m[2]*exp(x[2]) + m[3]*exp(x[3]) + m[4]) 
}
Deriv(ppp, "x[1]")

是有辦法我可以重寫與功能sum()考慮到m[1]*exp(x[1]) + m[2]*exp(x[2]) + m[3]*exp(x[3])函數的兩個參數的范圍從 1 到 3？

Answer 1

您可以圍繞Deriv編寫一個包裝器，它將下標轉換為變量並再次返回：

library(Deriv)

Deriv_vec <- function(f, var, ...)
{
  bod <- c(gsub(var, "new_var", as.character(body(f)), fixed = TRUE), "}")
  body(f) <- parse(text = bod)
  formals(f) <- c(alist(new_var=), formals(f))
  result <- Deriv(f, "new_var", ...)

  bod <- c(gsub("new_var", var, as.character(body(result)), fixed = TRUE), "}")
  body(result) <- parse(text = bod)
  formals(result) <- formals(result)[-1]
  result
}

這允許：

ppp <- function(x, m)  { 
   n*log(m[1] * exp(x[1]) + m[2] * exp(x[2]) + m[3] * exp(x[3]) + m[4]) 
}

Deriv_vec(ppp, "x[1]")
#> function (x, m) 
#> {
#>     .e1 <- exp(x[1])
#>     n * .e1 * m[1]/(.e1 * m[1] + exp(x[2]) * m[2] + exp(x[3]) * 
#>         m[3] + m[4])
#> }

Deriv_vec(ppp, "x[3]")
#> function (x, m) 
#> {
#>     .e1 <- exp(x[3])
#>     n * .e1 * m[3]/(.e1 * m[3] + exp(x[1]) * m[1] + exp(x[2]) * 
#>         m[2] + m[4])
#> }

如果您需要一個接受多個變量的版本，這會更復雜，但可以這樣實現：

Deriv_vec <- function(f, var, ...)
{
  for(i in seq_along(var)) {
    bod <- c(gsub(var[i], 
                  paste0("new_var", i),
                  as.character(body(f)), fixed = TRUE), "}")
    body(f) <- parse(text = bod)
  }
  
  new_vars <- paste0("new_var", seq_along(var))
  new_args <- setNames(lapply(seq_along(new_vars), 
                              function(x) alist(a=)$a), new_vars)
  formals(f) <- c(new_args, formals(f))
  
  result <- Deriv(f, new_vars, ...)
  
  for(i in seq_along(var))
  {
    bod <- c(gsub(new_vars[i], var[i], 
                  as.character(body(result)), fixed = TRUE), "}")
    if(substr(bod[length(bod) - 1], 1, 2) == "c(")
    {
      bod[length(bod) - 1] <- 
        gsub(var[i], paste0("`", var[i], "`"), bod[length(bod) - 1],
             fixed = TRUE)
    }
    body(result) <- parse(text = bod)
  }
  formals(result) <- formals(result)[-seq_along(var)]
  result
}

這允許：

Deriv_vec(ppp, c("x[1]", "x[2]", "x[3]"))
#> function (x, m) 
#> {
#>     .e1 <- exp(x[1])
#>     .e2 <- exp(x[2])
#>     .e3 <- exp(x[3])
#>     .e7 <- .e1 * m[1] + .e2 * m[2] + .e3 * m[3] + m[4]
#>     c(`x[1]` = n * .e1 * m[1]/.e7, `x[2]` = n * .e2 * 
#>         m[2]/.e7, `x[3]` = n * .e3 * m[3]/.e7)
#> }

請注意您的具體示例。 函數ppp包含一個名為n的變量。 這可能應該作為參數包含在內。