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