test-int_cov.R
In AIDA: Analysis of Interval DAta

test_that("int_mean returns the barycenter and preserves latent parameters", {
  Data <- matrix(c(
    1, 0.2, 5, 0.4,
    3, 0.4, 7, 0.6,
    5, 0.6, 9, 0.8
  ), nrow = 3, byrow = TRUE)
  latent <- list(0.25)
  obj <- intData(Data, Seq = "CenRng_VarbyVar", VarNames = c("A", "B"),
                 LatentParam = latent, LatentCase = "U_id_symmetric",
                 LatentDist = "Unif")

  result <- int_mean(obj)

  expect_s4_class(result, "intData")
  expect_equal(as.numeric(result@Centers[1, ]), c(3, 7))
  expect_equal(as.numeric(result@Ranges[1, ]), c(0.4, 0.6))
  expect_equal(colnames(result), c("A", "B"))
  expect_equal(rownames(result), "Barycenter")
  expect_equal(result@LatentParam, latent)
  expect_equal(result@LatentCase, obj@LatentCase)
  expect_equal(result@LatentDist, obj@LatentDist)
})

test_that("int_mean errors for non-intData inputs", {
  expect_error(int_mean(data.frame(x = 1:2)),
               "Argument data is not an object of class intData")
})

test_that("int_mean_z works", {
  n <- 100
  p <- 4
  X <- matrix(rnorm(n * p), ncol = p)
  z <- c(rep(1, n))
  
  expect_equal(int_mean_z(z, X), colMeans(X))
})

test_that("int_cov computes U_id_symmetric from explicit covariance matrices", {
  sigma_cc <- matrix(c(1, 0, 0, 2), nrow = 2)
  sigma_rr <- matrix(c(2, 0, 0, 3), nrow = 2)
  result <- int_cov(sigma_cc = sigma_cc, sigma_rr = sigma_rr, LatentParam = list(0.25), LatentCase = "U_id_symmetric")
  expect_equal(result, sigma_cc + 0.25 * sigma_rr)
})

test_that("int_cov computes U_id from explicit matrices and sigma_cr", {
  sigma_cc <- matrix(c(1, 1, 1, 2), nrow = 2)
  sigma_rr <- matrix(c(2, 0, 0, 1), nrow = 2)
  sigma_cr <- matrix(c(0.5, -0.5, 0.2, 0.3), nrow = 2)
  latent <- list(0.5, 0.2)
  result <- int_cov(sigma_cc = sigma_cc, sigma_rr = sigma_rr, sigma_cr = sigma_cr, LatentParam = latent, LatentCase = "U_id")
  expected <- sigma_cc + 0.5 * sigma_rr + 0.1 * (sigma_cr + t(sigma_cr))
  expect_equal(result, expected)
})

test_that("int_cov computes General case from explicit matrices", {
  sigma_cc <- matrix(c(1, 2, 2, 3), nrow = 2)
  sigma_rr <- matrix(c(1, 0, 0, 1), nrow = 2)
  sigma_cr <- matrix(c(0.1, 0.2, 0.3, 0.4), nrow = 2)
  e_UU <- matrix(c(1, 0.1, 0.1, 2), nrow = 2)
  psi <- diag(c(0.1, -0.2))
  latent <- list(e_UU, psi)
  result <- int_cov(sigma_cc = sigma_cc, sigma_rr = sigma_rr, sigma_cr = sigma_cr, LatentParam = latent, LatentCase = "General")
  expected <- sigma_cc + 1/4 * (e_UU * sigma_rr) + 1/2 * sigma_cr %*% psi + 1/2 * psi %*% t(sigma_cr)
  expect_equal(result, expected)
})

test_that("int_cov uses intData object and returns named covariance matrix", {
  Data <- data.frame(L1 = c(1, 2), U1 = c(3, 4), L2 = c(0, 1), U2 = c(2, 3))
  VarNames <- c("A", "B")
  obj <- intData(Data, Seq = "LbUb_VarbyVar", VarNames = VarNames, LatentParam = list(0.25), LatentCase = "U_id_symmetric", LatentDist = "Unif")
  result <- int_cov(data = obj)
  expected <- cov(as.matrix(obj@Centers)) + 0.25 * cov(as.matrix(obj@Ranges))
  colnames(expected) <- rownames(expected) <- VarNames
  expect_equal(result, expected)
  expect_equal(colnames(result), VarNames)
  expect_equal(rownames(result), VarNames)
})

test_that("int_cov errors when required arguments are missing", {
  expect_error(int_cov(sigma_cc = matrix(1,1,1), sigma_rr = matrix(1,1,1), LatentParam = list(0.1), LatentCase = "U_id"), "sigma_cr is missing")
  expect_error(int_cov(data = 1:3), "Argument data is not an object of class intData")
})

test_that("int_cov errors when neitheir data nor the covariance matrices are provided", {
  expect_error(int_cov(), "Must provide either an intData object or the covariance matrices and the latent variables parameters and case.")
})

test_that("int_cov_z computes sample covariance for U_id_symmetric", {
  C <- matrix(c(1, 2, 3, 4), nrow = 2)
  R <- matrix(c(1, 1, 2, 2), nrow = 2)
  data_obj <- intData(cbind(C, C + R), Seq = "LbUb_VarbyVar", VarNames = c("X", "Y"), LatentParam = list(0.25), LatentCase = "U_id_symmetric", LatentDist = "Unif")
  z <- c(1, 0)
  result <- int_cov_z(z, data_obj)
  m <- sum(z)
  C_t <- as.matrix(t(data_obj@Centers))
  R_t <- as.matrix(t(data_obj@Ranges))
  zC <- as.matrix(z * data_obj@Centers)
  zR <- as.matrix(z * data_obj@Ranges)
  sum_c <- C_t %*% zC
  sum_r <- R_t %*% zR
  C_z <- as.matrix(C_t %*% (z %*% t(z)))
  R_z <- as.matrix(R_t %*% (z %*% t(z)))
  expected <- 1/m * sum_c - 1/m^2 * C_z %*% as.matrix(data_obj@Centers) + 0.25/m * sum_r - 0.25/m^2 * R_z %*% as.matrix(data_obj@Ranges)
  colnames(expected) <- rownames(expected) <- c("X", "Y")
  expect_equal(result, expected)
})

test_that("int_cov_z errors for non-intData inputs", {
  expect_error(int_cov_z(c(1, 0), data.frame(x = 1:2)), "Argument data is not an object of class intData")
})

test_that("int_cov_z computes U_id case correctly", {
  # construct small intData with Seq = CenRng_VarbyVar (C1,R1,C2,R2)
  Data <- matrix(c(
    1, 0.5, 2, 0.2,
    3, 0.3, 4, 0.1
  ), nrow = 2, byrow = TRUE)
  obj <- intData(Data, Seq = "CenRng_VarbyVar", VarNames = c("X", "Y"), LatentParam = list(0.25, 0.6), LatentCase = "U_id", LatentDist = "Triang")
  z <- c(1, 1)
  res <- int_cov_z(z, obj)

  # manual computation following the implementation
  param <- obj@LatentParam
  delta <- param[[1]]
  U_mean <- param[[2]]
  C <- as.matrix(obj@Centers)
  R <- as.matrix(obj@Ranges)
  m <- sum(z)
  C_t <- t(C); R_t <- t(R)
  zC <- z * C; zR <- z * R
  sum_c <- C_t %*% zC; sum_r <- R_t %*% zR
  sum_cr <- C_t %*% zR; sum_rc <- R_t %*% zC
  zz_t <- z %*% t(z)
  C_z <- C_t %*% zz_t; R_z <- R_t %*% zz_t

  expected <- 1/m * sum_c - (1/m^2) * C_z %*% C + delta/m * sum_r - (delta/m^2) * R_z %*% R +
    U_mean/(2*m) * sum_cr - U_mean/(2*m^2) * C_z %*% R + U_mean/(2*m) * sum_rc - U_mean/(2*m^2) * R_z %*% C
  colnames(expected) <- rownames(expected) <- c("X", "Y")
  expect_equal(res, expected)
})

test_that("int_cov_z computes General case correctly", {
  Data <- matrix(c(
    1, 0.2, 2, 0.1,
    4, 0.3, 5, 0.4
  ), nrow = 2, byrow = TRUE)
  e_UU <- matrix(c(1, 0.1, 0.1, 2), nrow = 2)
  psi <- diag(c(0.5, -0.2))
  obj <- intData(Data, Seq = "CenRng_VarbyVar", VarNames = c("A", "B"), LatentParam = list(e_UU, psi), LatentCase = "General", LatentDist = "KDE")
  z <- c(1, 0)
  res <- int_cov_z(z, obj)

  # manual computation
  param <- obj@LatentParam
  e_UU_p <- param[[1]]; psi_p <- param[[2]]
  C <- as.matrix(obj@Centers); R <- as.matrix(obj@Ranges); m <- sum(z)
  C_t <- t(C); R_t <- t(R)
  zC <- z * C; zR <- z * R
  sum_c <- C_t %*% zC; sum_r <- R_t %*% zR
  sum_cr <- C_t %*% zR; sum_rc <- R_t %*% zC
  zz_t <- z %*% t(z)
  C_z <- C_t %*% zz_t; R_z <- R_t %*% zz_t

  expected <- 1/m * sum_c - (1/m^2) * C_z %*% C + 1/(4*m) * e_UU_p * sum_r - 1/(4*m^2) * e_UU_p * R_z %*% R +
    1/(2*m) * sum_cr %*% psi_p - 1/(2*m^2) * C_z %*% R %*% psi_p + 1/(2*m) * psi_p %*% sum_rc - 1/(2*m^2) * psi_p %*% R_z %*% C
  colnames(expected) <- rownames(expected) <- c("A", "B")
  expect_equal(res, expected)
})

test_that("safe_solve_cov handles errors, invertible and singular matrices", {
  # non-matrix
  expect_error(safe_solve_cov(1:3), "must be a matrix")
  # non-square
  expect_error(safe_solve_cov(matrix(1:6, nrow = 2)), "must be square")

  # invertible
  cov <- diag(c(2, 3))
  inv_expected <- solve(cov)
  inv_res <- safe_solve_cov(cov, verbose = FALSE)
  expect_equal(inv_res, inv_expected)

  # singular -> fallback to MASS::ginv
  sing <- matrix(c(1, 2, 1, 2), nrow = 2)
  expect_warning(inv_sing <- safe_solve_cov(sing, verbose = TRUE), "Moore-Penrose")
  expect_equal(inv_sing, MASS::ginv(sing))
})

test_that("int_cor computes correlation from intData", {
  Data <- matrix(c(
    1, 0.2, 5, 0.4,
    3, 0.4, 7, 0.6,
    5, 0.6, 9, 0.8
  ), nrow = 3, byrow = TRUE)
  obj <- intData(Data, Seq = "CenRng_VarbyVar", VarNames = c("A", "B"),
                 LatentParam = list(0.25), LatentCase = "U_id_symmetric",
                 LatentDist = "Unif")
  expected <- cov2cor(int_cov(data = obj))

  expect_equal(int_cor(data = obj), expected)
  expect_equal(rownames(int_cor(data = obj)), c("A", "B"))
  expect_equal(colnames(int_cor(data = obj)), c("A", "B"))
})

test_that("int_cor uses a supplied covariance matrix", {
  covariance <- matrix(c(4, 3, 3, 9), nrow = 2,
                       dimnames = list(c("A", "B"), c("A", "B")))

  expect_equal(int_cor(cov = covariance), matrix(
    c(1, 0.5, 0.5, 1), nrow = 2,
    dimnames = list(c("A", "B"), c("A", "B"))
  ))
})

test_that("int_cor computes correlation from explicit covariance components", {
  sigma_cc <- matrix(c(1, 0.2, 0.2, 2), nrow = 2)
  sigma_rr <- matrix(c(2, 0.1, 0.1, 1), nrow = 2)
  covariance <- sigma_cc + 0.25 * sigma_rr

  expect_equal(
    int_cor(sigma_cc = sigma_cc, sigma_rr = sigma_rr,
            LatentParam = list(0.25), LatentCase = "U_id_symmetric"),
    cov2cor(covariance)
  )
})