Nothing
library(MGMM)
# -----------------------------------------------------------------------------
test_that("Density evaluation of incomplete obs.", {
means <- list(c(1, 0))
covs <- list(diag(2))
g <- function(y) {EvalDensIncompObs(y, means, covs, 1)}
# No elements missing.
y <- c(0, 0)
obs <- g(y)
exp <- prod(stats::dnorm(x = y, mean = c(1, 0)))
expect_equal(obs, exp)
# First element missing.
y <- c(NA, 0)
obs <- g(y)
exp <- stats::dnorm(x = 0, mean = 0, sd = 1)
expect_equal(obs, exp)
# Second element missing.
y <- c(0, NA)
obs <- g(y)
exp <- stats::dnorm(x = 0, mean = 1, sd = 1)
expect_equal(obs, exp)
})
# -----------------------------------------------------------------------------
test_that("Working response vector.", {
# Mean and covariance.
mu <- c(0, 0)
sigma <- matrix(c(1, 0.5, 0.5, 1), nrow = 2)
g <- function(y) {WorkRespIndiv(y, mu, sigma, 1)}
# No missing elements.
y <- c(0, 0)
obs <- g(y)
exp <- y
expect_equal(obs, exp)
# First element missing.
y <- c(NA, 2)
obs <- g(y)
exp <- c(mu[1] + sigma[1, 2] / sigma[2, 2] * (y[2] - mu[2]), y[2])
expect_equal(obs, exp)
# Second element missing.
y <- c(1, NA)
obs <- g(y)
exp <- c(y[1], mu[2] + sigma[2, 1] / sigma[1, 1] * (y[1] - mu[1]))
expect_equal(obs, exp)
})
# -----------------------------------------------------------------------------
test_that("Working residual outer product.", {
new_mean <- c(1, 1)
old_mean <- c(0, 0)
old_cov <- matrix(c(2, 0.5, 0.5, 2), nrow = 2)
g <- function(data) {
ExpResidOP(data, new_mean, old_mean, old_cov)
}
# First element missing.
data <- matrix(c(NA, 0), nrow = 1)
obs <- g(data)
res <- WorkRespIndiv(data, old_mean, old_cov, 1) - new_mean
correction <- old_cov[1, 1] - old_cov[1, 2] / old_cov[2, 2] * old_cov[2, 1]
exp <- res %*% t(res) + diag(c(correction, 0))
expect_equal(obs, exp)
# Second element missing.
data <- matrix(c(1, NA), nrow = 1)
obs <- g(data)
res <- WorkRespIndiv(data, old_mean, old_cov, 1) - new_mean
correction <- old_cov[2, 2] - old_cov[2, 1] / old_cov[1, 1] * old_cov[1, 2]
exp <- res %*% t(res) + diag(c(0, correction))
expect_equal(obs, exp)
})
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.