tensor_predictors/tensorPredictors/tests/testthat/test-MatrixCalculus.R

51 lines
1.7 KiB
R
Raw Normal View History

# 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)
}
})