如何在 R 中找到关于向量化变量的导数
How to find derivative with respect to vectorized variable in R
我在 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]")
考虑到函数的两个参数的 m[1]*exp(x[1]) + m[2]*exp(x[2]) + m[3]*exp(x[3])
范围从 1 到 3,有没有办法用 sum()
重写函数?
您可以围绕 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
的变量。这可能应该作为参数包含在内。
我在 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]")
考虑到函数的两个参数的 m[1]*exp(x[1]) + m[2]*exp(x[2]) + m[3]*exp(x[3])
范围从 1 到 3,有没有办法用 sum()
重写函数?
您可以围绕 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
的变量。这可能应该作为参数包含在内。