if (FALSE) f <- function(x) x^2
if (FALSE) Deriv(f)
# function (x)
# 2 * x
if (FALSE) f <- function(x, y) sin(x) * cos(y)
if (FALSE) Deriv(f)
# function (x, y)
# c(x = cos(x) * cos(y), y = -(sin(x) * sin(y)))
if (FALSE) f_ <- Deriv(f)
if (FALSE) f_(3, 4)
# x y
# [1,] 0.6471023 0.1068000
if (FALSE) Deriv(~ f(x, y^2), "y")
# -(2 * (y * sin(x) * sin(y^2)))
if (FALSE) Deriv(quote(f(x, y^2)), c("x", "y"), cache.exp=FALSE)
# c(x = cos(x) * cos(y^2), y = -(2 * (y * sin(x) * sin(y^2))))
if (FALSE) Deriv(expression(sin(x^2) * y), "x")
# expression(2*(x*y*cos(x^2)))
Deriv("sin(x^2) * y", "x") # differentiate only by x
"2 * (x * y * cos(x^2))"
Deriv("sin(x^2) * y", cache.exp=FALSE) # differentiate by all variables (here by x and y)
"c(x = 2 * (x * y * cos(x^2)), y = sin(x^2))"
# Compound function example (here abs(x) smoothed near 0)
fc <- function(x, h=0.1) if (abs(x) < h) 0.5*h*(x/h)**2 else abs(x)-0.5*h
Deriv("fc(x)", "x", cache.exp=FALSE)
"if (abs(x) < h) x/h else sign(x)"
# Example of a first argument that cannot be evaluated in the current environment:
if (FALSE) {
suppressWarnings(rm("xx", "yy"))
Deriv(xx^2+yy^2)
}
# c(xx = 2 * xx, yy = 2 * yy)
# Automatic differentiation (AD), note intermediate variable 'd' assignment
if (FALSE) Deriv(~{d <- ((x-m)/s)^2; exp(-0.5*d)}, "x", cache.exp=FALSE)
#{
# d <- ((x - m)/s)^2
# .d_x <- 2 * ((x - m)/s^2)
# -(0.5 * (.d_x * exp(-(0.5 * d))))
#}
# Custom differentiation rule
if (FALSE) {
myfun <- function(x, y=TRUE) NULL # do something useful
dmyfun <- function(x, y=TRUE) NULL # myfun derivative by x.
drule[["myfun"]] <- alist(x=dmyfun(x, y), y=NULL) # y is just a logical => no derivate
Deriv(~myfun(z^2, FALSE), "z", drule=drule)
# 2 * (z * dmyfun(z^2, FALSE))
}
# Differentiation by list components
if (FALSE) {
theta <- list(m=0.1, sd=2.)
x <- names(theta)
names(x)=rep("theta", length(theta))
Deriv(~exp(-(x-theta$m)**2/(2*theta$sd)), x, cache.exp=FALSE)
# c(theta_m = exp(-((x - theta$m)^2/(2 * theta$sd))) *
# (x - theta$m)/theta$sd, theta_sd = 2 * (exp(-((x - theta$m)^2/
# (2 * theta$sd))) * (x - theta$m)^2/(2 * theta$sd)^2))
}
# Differentiation in matrix calculus
if (FALSE) {
Deriv(~solve(matrix(c(1, x, x**2, x**3), nrow=2, ncol=2)))
}
# Two component Gaussian mixture model (GMM) example
if (FALSE) {
# define GMM probability density function -> p(x, ...)
ncomp=2
a=runif(ncomp)
a=a/sum(a) # amplitude or weight of each component
m=rnorm(ncomp) # mean
s=runif(ncomp) # sd
# two column matrix of probabilities: one row per x value, one column per component
pn=function(x, a, m, s, log=FALSE) {
n=length(a)
structure(vapply(seq(n), function(i) a[i]*dnorm(x, m[i], s[i], log),
double(length(x))), dim=c(length(x), n))
}
p=function(x, a, m, s) rowSums(pn(x, a, m, s)) # overall probability
dp=Deriv(p, "x")
# plot density and its derivative
xp=seq(min(m-2*s), max(m+2*s), length.out=200)
matplot(xp, cbind(p(xp, a, m, s), dp(xp, a, m, s)),
xlab="x", ylab="p, dp/dx", type="l", main="Two component GMM")
}
Run the code above in your browser using DataLab