51 lines
1.7 KiB
R
51 lines
1.7 KiB
R
|
# F(X) = log(det(X)) if det(X) > 0
|
||
|
|
# dF(X) = tr(X^-1 dX)
|
||
|
|
# DF(X) = vec((X^-1)')'
|
||
|
|
test_that("Matrix Calculus 1", {
|
||
|
|
# test data
|
||
|
|
X <- tcrossprod(diag(5) + matrix(runif(5^2, -.1, .1), 5))
|
||
|
|
|
||
|
|
num.grad <- num.deriv(function(X) log(det(X)), X)
|
||
|
|
ana.grad <- c(solve(X))
|
||
|
|
|
||
|
|
expect_equal(num.grad, ana.grad)
|
||
|
|
})
|
||
|
|
|
||
|
|
# F(mu) = <X - mu, (X - mu) x_{k in [r]} Delta_K^-1> for Delta_k = Delta_k'
|
||
|
|
# DF(mu) = -2 vec((X - mu) x_{k in [r]} Delta_K^-1)'
|
||
|
|
test_that("Matrix Calculus 2", {
|
||
|
|
p <- c(2, 3, 5)
|
||
|
|
|
||
|
|
X <- array(rnorm(prod(p)), dim = p)
|
||
|
|
mu <- array(rnorm(prod(p)), dim = p)
|
||
|
|
Deltas <- Map(function(pj) tcrossprod(diag(pj) + runif(pj^2, -0.1, 0.1)), p)
|
||
|
|
|
||
|
|
ana.grad <- -2 * c(mlm(X - mu, Map(solve, Deltas)))
|
||
|
|
num.grad <- num.deriv(function(mu) sum((X - mu) * mlm(X - mu, Map(solve, Deltas))), mu)
|
||
|
|
|
||
|
|
expect_equal(num.grad, ana.grad)
|
||
|
|
})
|
||
|
|
|
||
|
|
# F(Delta_j) = <X - mu, (X - mu) x_{k in [r]} Delta_K^-1> for Delta_k = Delta_k'
|
||
|
|
# DF(Delta_j) = -((X - mu) x_{k in [r]} Delta_K^-1)_(j) (X - mu)_(j)' Delta_j^-1
|
||
|
|
test_that("Matrix Calculus 3", {
|
||
|
|
# config
|
||
|
|
p <- c(2, 3, 5)
|
||
|
|
|
||
|
|
# generate test data
|
||
|
|
X <- array(rnorm(prod(p)), dim = p)
|
||
|
|
mu <- array(rnorm(prod(p)), dim = p)
|
||
|
|
Deltas <- Map(function(pj) tcrossprod(diag(pj) + runif(pj^2, -0.1, 0.1)), p)
|
||
|
|
|
||
|
|
# check analytic to numeric derivatives
|
||
|
|
for (j in seq_along(Deltas)) {
|
||
|
|
num.grad <- matrix(num.deriv(function(Delta_j) {
|
||
|
|
Deltas[[j]] <- Delta_j
|
||
|
|
sum((X - mu) * mlm(X - mu, Map(solve, Deltas)))
|
||
|
|
}, Deltas[[j]]), p[j])
|
||
|
|
ana.grad <- -mcrossprod(mlm(X - mu, Map(solve, Deltas)), X - mu, j) %*% solve(Deltas[[j]])
|
||
|
|
|
||
|
|
expect_equal(num.grad, ana.grad)
|
||
|
|
}
|
||
|
|
})
|