tests/testthat/test-intData_utils.R

In AIDA: Analysis of Interval DAta

library(testthat)

test_that("get_latent_var computes expected U and handles bounds", {
  macro <- data.frame(L1 = 1, U1 = 3, L2 = 0, U2 = 2)
  rownames(macro) <- "G1"
  micro <- matrix(c(2,1,
                    3,2,
                    1,0), ncol = 2, byrow = TRUE)
  agrby <- rep("G1", nrow(micro))

  U <- get_latent_var(microdata = micro,
                      macrodata = macro,
                      agrby = agrby,
                      agrlevels = rownames(macro),
                      Seq = "LbUb_VarbyVar")

  centers <- c((macro[1,1] + macro[1,2]) / 2, (macro[1,3] + macro[1,4]) / 2)
  ranges <- c(macro[1,2] - macro[1,1], macro[1,4] - macro[1,3])

  expected <- matrix(NA_real_, nrow = nrow(micro), ncol = ncol(micro))
  for (i in seq_len(nrow(micro))){
    for (j in seq_len(ncol(micro))){
      val <- 2 * (micro[i,j] - centers[j]) / ranges[j]
      if (val == 1 || val == -1) expected[i,j] <- NA_real_ else expected[i,j] <- val
    }
  }

  expect_equal(U, expected)
})

test_that("get_latent_param returns expected values and errors", {
  res1 <- get_latent_param(LatentCase = "U_id_symmetric", LatentDist = "Unif", p = 2)
  expect_equal(res1$LatentParam[[1]], 1/12)
  expect_equal(res1$LatentCase, "U_id_symmetric")
  expect_equal(res1$LatentDist, "Unif")
  expect_equal(res1$TriangParam, 0)
  expect_equal(res1$BetaParam.a, 1)
  expect_equal(res1$BetaParam.b, 1)

  res2 <- get_latent_param(LatentCase = "U_id", LatentDist = "Triang", TriangParam = 0, p = 2)
  expect_equal(res2$LatentParam[[1]], 1/24)
  expect_equal(res2$LatentParam[[2]], 0)
  expect_equal(res2$LatentCase, "U_id")
  expect_equal(res2$LatentDist, "Triang")

  expect_error(get_latent_param(LatentCase = "General", LatentDist = "KDE", p = 2), "microdata must be provided")
  expect_error(get_latent_param(LatentCase = "U_id", LatentDist = "Unif", estimate.DistParam = TRUE, p = 2), "LatentCase to 'General'")
})

test_that("get_latent_param defaults LatentDist to Unif for symmetric case", {
  res <- get_latent_param(LatentCase = "U_id_symmetric", p = 3)
  expect_equal(res$LatentDist, "Unif")
  expect_equal(res$LatentParam[[1]], 1/12)
})

test_that("get_latent_param general case returns covariance matrix and mean matrix", {
  Umicro <- matrix(c(-0.5, 0.5, 0.1, -0.1, 0, 0), ncol = 2)
  res <- get_latent_param(LatentCase = "General", LatentDist = "Triang", TriangParam = c(0, 0.5), Umicro = Umicro)

  expect_equal(res$LatentCase, "General")
  expect_equal(res$LatentDist, "Triang")
  expect_length(res$LatentParam, 2)
  expect_true(is.matrix(res$LatentParam[[1]]))
  expect_equal(dim(res$LatentParam[[1]]), c(2, 2))
  expect_true(is.matrix(res$LatentParam[[2]]))
  expect_equal(dim(res$LatentParam[[2]]), c(2, 2))
  expect_equal(res$TriangParam, c(0, 0.5))
  expect_equal(res$BetaParam.a, 1)
  expect_equal(res$BetaParam.b, 1)
})

test_that("get_latent_param supports degenerated latent distribution", {
  expect_message(
    res <- get_latent_param(LatentCase = "U_id_symmetric", LatentDist = "Degenerated", p = 1),
    regexp="The latent variable, U, is a degenerated random variable"
  )
  
  expect_equal(res$LatentParam[[1]], 0)
  expect_equal(res$LatentDist, "Degenerated")
})

test_that("get_latent_param estimate.DistParam works for General case", {
  Umicro <- matrix(c(-0.4, 0.4, 0.2, -0.2), ncol = 2)
  res <- get_latent_param(LatentCase = "General", LatentDist = "KDE", Umicro = Umicro, estimate.DistParam = TRUE)

  expect_equal(res$LatentCase, "General")
  expect_equal(res$LatentDist, "KDE")
  expect_equal(res$TriangParam, c(NA, NA))
  expect_equal(res$BetaParam.a, c(NA, NA))
  expect_equal(res$BetaParam.b, c(NA, NA))
  expect_true(is.matrix(res$LatentParam[[1]]))
  expect_equal(dim(res$LatentParam[[1]]), c(2, 2))
})
 
test_that("get_latent_param requires microdata or p when needed", {
  expect_error(get_latent_param(LatentCase = "U_id", LatentDist = "Triang"), "The number of variables or the microdata must be provided")
  expect_error(get_latent_param(LatentCase = "General", LatentDist = "Triang", Umicro = NULL), "a distribution type must be provided|microdata must be provided")
})

test_that("get_latent_param rejects per-variable parameters outside General", {
  expect_error(get_latent_param(LatentCase = "U_id", LatentDist = "Triang", TriangParam = c(0, 0.5), p = 2), "LatentCase must be 'General'")
  expect_error(get_latent_param(LatentCase = "U_id", LatentDist = "Beta", BetaParam.a = c(1, 2), p = 2), "LatentCase must be 'General'")
})

test_that("get_latent_var handles different Seq formats correctly", {
  macro_LbUb <- data.frame(L1 = 1, U1 = 3, L2 = 0, U2 = 2)
  macro_AllLbAllUb <- data.frame(L1 = 1, L2 = 0, U1 = 3, U2 = 2)
  macro_CenRng <- data.frame(C1 = 2, R1 = 2, C2 = 1, R2 = 2)
  macro_AllCenAllRng <- data.frame(C1 = 2, C2 = 1, R1 = 2, R2 = 2)
  
  rownames(macro_LbUb) <- "G1"
  rownames(macro_AllLbAllUb) <- "G1"
  rownames(macro_CenRng) <- "G1"
  rownames(macro_AllCenAllRng) <- "G1"
  
  micro <- matrix(c(2, 1, 3, 2, 1, 0), ncol = 2, byrow = TRUE)
  agrby <- rep("G1", nrow(micro))

  U_LbUb <- get_latent_var(micro, macro_LbUb, agrby, "G1", Seq = "LbUb_VarbyVar")
  U_AllLbAllUb <- get_latent_var(micro, macro_AllLbAllUb, agrby, "G1", Seq = "AllLb_AllUb")
  U_CenRng <- get_latent_var(micro, macro_CenRng, agrby, "G1", Seq = "CenRng_VarbyVar")
  U_AllCenAllRng <- get_latent_var(micro, macro_AllCenAllRng, agrby, "G1", Seq = "AllCen_AllRng")

  # All formats should produce equivalent results
  expect_equal(U_LbUb, U_AllLbAllUb, tolerance = 1e-10)
  expect_equal(U_LbUb, U_CenRng, tolerance = 1e-10)
  expect_equal(U_LbUb, U_AllCenAllRng, tolerance = 1e-10)
})

test_that("get_latent_var handles multiple groups correctly", {
  macro <- data.frame(L1 = c(1, 5), U1 = c(3, 7), L2 = c(0, 2), U2 = c(2, 4))
  rownames(macro) <- c("G1", "G2")
  
  micro <- matrix(c(2, 1, 3, 2, 6, 3, 5, 2.5), ncol = 2, byrow = TRUE)
  agrby <- c("G1", "G1", "G2", "G2")

  U <- get_latent_var(micro, macro, agrby, rownames(macro), Seq = "LbUb_VarbyVar")

  expect_equal(nrow(U), nrow(micro))
  expect_equal(ncol(U), ncol(micro))
})

test_that("get_latent_var rejects invalid macrodata", {
  micro <- matrix(c(2, 1), ncol = 2)
  agrby <- "G1"
  
  expect_error(get_latent_var(micro, "invalid", agrby, "G1"), "macrodata must be a data.frame, matrix, or intData object")
})

test_that("get_latent_var handles edge values at boundaries", {
  # Test with micro values exactly at boundaries
  macro <- data.frame(L1 = 0, U1 = 2, L2 = 0, U2 = 2)
  rownames(macro) <- "G1"
  
  micro <- matrix(c(0, 0, 2, 2, 1, 1), ncol = 2, byrow = TRUE)
  agrby <- c("G1", "G1", "G1")

  U <- get_latent_var(micro, macro, agrby, "G1", Seq = "LbUb_VarbyVar")

  # Values at exact boundaries should be NA
  expect_true(is.na(U[1, 1]))  # U = -1
  expect_true(is.na(U[1, 2]))  # U = -1
  expect_true(is.na(U[2, 1]))  # U = 1
  expect_true(is.na(U[2, 2]))  # U = 1
  expect_false(is.na(U[3, 1])) # U = 0
})

test_that("get_latent_param with InvTri distribution", {
  res <- get_latent_param(LatentCase = "U_id_symmetric", LatentDist = "InvTri", p = 2)
  expect_equal(res$LatentParam[[1]], 1/8)
  expect_equal(res$LatentDist, "InvTri")
})

test_that("get_latent_param with TNorm distribution", {
  res <- get_latent_param(LatentCase = "U_id_symmetric", LatentDist = "TNorm", p = 1)
  expect_true(is.numeric(res$LatentParam[[1]]))
  expect_true(res$LatentParam[[1]] > 0 && res$LatentParam[[1]] < 0.1)
  expect_equal(res$LatentDist, "TNorm")
})

test_that("get_latent_param with U_id case and Beta distribution", {
  res_beta <- get_latent_param(LatentCase = "U_id", LatentDist = "Beta", BetaParam.a = 2, BetaParam.b = 3, p = 1)
  expect_true(is.numeric(res_beta$LatentParam[[1]]))
  expect_true(is.numeric(res_beta$LatentParam[[2]]))
})

test_that("get_latent_param with multidimensional General case", {
  Umicro <- matrix(c(-0.5, 0.5, 0.2, 0.1, -0.2, 0, 0.3, 0.1, -0.1), ncol = 3)
  res <- get_latent_param(LatentCase = "General", LatentDist = "KDE", Umicro = Umicro)
  
  expect_equal(res$LatentCase, "General")
  expect_equal(dim(res$LatentParam[[1]]), c(3, 3))  # E_UU matrix
  expect_equal(dim(res$LatentParam[[2]]), c(3, 3))  # Psi matrix
})

test_that("get_latent_param General case with mixed distributions", {
  Umicro <- matrix(c(-0.5, 0.5, 0.2, 0.1, -0.2, 0), ncol = 2)
  res <- get_latent_param(LatentCase = "General", 
                         LatentDist = c("Beta", "KDE"),
                         BetaParam.a = c(1.5, NA),
                         BetaParam.b = c(2, NA),
                         Umicro = Umicro)
  
  expect_equal(res$LatentDist, c("Beta", "KDE"))
  expect_equal(res$BetaParam.a[1], 1.5)
})

test_that("get_latent_param with Triang distribution different modes", {
  res0 <- get_latent_param(LatentCase = "U_id", LatentDist = "Triang", TriangParam = 0, p = 1)
  res_pos <- get_latent_param(LatentCase = "U_id", LatentDist = "Triang", TriangParam = 0.5, p = 1)
  res_neg <- get_latent_param(LatentCase = "U_id", LatentDist = "Triang", TriangParam = -0.5, p = 1)
  
  expect_equal(res0$LatentParam[[2]], 0)  # mean should be 0 for mode=0
  expect_equal(res_pos$LatentParam[[2]], 0.5/3)  # mean = mode/3
  expect_equal(res_neg$LatentParam[[2]], -0.5/3)
})

test_that("get_latent_param General case with per-variable Beta parameters", {
  Umicro <- matrix(c(-0.4, 0.4, 0.2, -0.2, 0.1, 0.3), ncol = 3)
  res <- get_latent_param(LatentCase = "General",
                         LatentDist = c("Beta", "Beta", "KDE"),
                         BetaParam.a = c(1.5, 2, NA),
                         BetaParam.b = c(2, 3, NA),
                         Umicro = Umicro)
  
  expect_equal(res$BetaParam.a[1], 1.5)
  expect_equal(res$BetaParam.a[2], 2)
  expect_equal(dim(res$LatentParam[[1]]), c(3, 3))
})

test_that("get_latent_param with per-variable Triang parameters", {
  Umicro <- matrix(c(-0.5, 0.5, 0.1, -0.1), ncol = 2)
  res <- get_latent_param(LatentCase = "General",
                         LatentDist = "Triang",
                         TriangParam = c(0, 0.3),
                         Umicro = Umicro)
  
  expect_equal(res$TriangParam, c(0, 0.3))
  expect_equal(dim(res$LatentParam[[1]]), c(2, 2))
})

test_that("meanU returns scalar for single distribution", {
  m_unif <- AIDA:::meanU(LatentDist = "Unif", p = 1)
  expect_equal(m_unif, 0)
  
  m_triang <- AIDA:::meanU(LatentDist = "Triang", TriangParam = 0.5, p = 1)
  expect_equal(m_triang, 0.5/3)
})

test_that("meanU returns matrix for multiple distributions", {
  m_multi <- AIDA:::meanU(LatentDist = c("Unif", "Triang", "Beta"),
                   TriangParam = c(NA, 0.2, NA),
                   BetaParam.a = c(NA, NA, 2),
                   BetaParam.b = c(NA, NA, 3),
                   p = 3)
  
  expect_true(is.matrix(m_multi))
  expect_equal(dim(m_multi), c(3, 3))
  expect_equal(diag(m_multi)[1], 0)  # Unif mean
  expect_equal(diag(m_multi)[2], 0.2/3)  # Triang mean
})

test_that("meanU with KDE distribution", {
  Umicro <- matrix(c(-0.5, 0.5, 0.1, -0.1, 0, 0.2), ncol = 2)
  m_kde <- AIDA:::meanU(LatentDist = c("KDE", "Unif"), Umicro = Umicro, p = 2)
  
  expect_true(is.matrix(m_kde))
  expect_equal(m_kde[1, 1], mean(Umicro[, 1], na.rm = TRUE))
  expect_equal(m_kde[2, 2], 0)
})

test_that("meanU2 returns scalar for single distribution", {
  m2_unif <- AIDA:::meanU2(LatentDist = "Unif", p = 1)
  expect_equal(m2_unif, 1/3)
  
  m2_triang <- AIDA:::meanU2(LatentDist = "Triang", TriangParam = 0, p = 1)
  expect_equal(m2_triang, 1/6)
})

test_that("meanU2 returns matrix for multiple distributions", {
  m2_multi <- AIDA:::meanU2(LatentDist = c("Unif", "Triang", "Beta"),
                     TriangParam = c(NA, 0, NA),
                     BetaParam.a = c(NA, NA, 2),
                     BetaParam.b = c(NA, NA, 3),
                     p = 3)
  
  expect_true(is.matrix(m2_multi))
  expect_equal(dim(m2_multi), c(3, 3))
  expect_equal(diag(m2_multi)[1], 1/3)  # Unif
  expect_equal(diag(m2_multi)[2], 1/6)  # Triang with mode=0
})

test_that("meanU2 with KDE distribution", {
  Umicro <- matrix(c(-0.5, 0.5, 0.1, -0.1, 0, 0.2), ncol = 2)
  m2_kde <- AIDA:::meanU2(LatentDist = c("KDE", "Unif"), Umicro = Umicro, p = 2)
  
  expect_true(is.matrix(m2_kde))
  expect_equal(m2_kde[1, 1], mean(Umicro[, 1]^2, na.rm = TRUE))
  expect_equal(m2_kde[2, 2], 1/3)
})

test_that("cal.E.UU with Beta-Beta distributions", {
  e_uu <- AIDA:::cal.E.UU(LatentDist = "Beta",
                   BetaParam.a = c(1, 2),
                   BetaParam.b = c(1, 2),
                   p = 2)
  
  expect_true(is.matrix(e_uu))
  expect_equal(dim(e_uu), c(2, 2))
  expect_equal(e_uu[1, 2], e_uu[2, 1])  # Symmetry
})

test_that("cal.E.UU with Triang-Triang distributions", {
  e_uu <- AIDA:::cal.E.UU(LatentDist = "Triang",
                   TriangParam = c(0, 0.2),
                   p = 2)
  
  expect_true(is.matrix(e_uu))
  expect_equal(dim(e_uu), c(2, 2))
  expect_equal(e_uu[1, 2], e_uu[2, 1])
})

test_that("cal.E.UU with KDE distributions", {
  Umicro <- matrix(c(-0.5, 0.5, 0.1, -0.1, 0, 0.2), ncol = 2)
  e_uu <- AIDA:::cal.E.UU(LatentDist = "KDE", Umicro = Umicro, p = 2)
  
  expect_true(is.matrix(e_uu))
  expect_equal(dim(e_uu), c(2, 2))
  expect_equal(e_uu[1, 2], e_uu[2, 1])  # Symmetry
  expect_true(all(is.finite(e_uu)))
})

test_that("CalE.beta.beta computes correctly", {
  calE <- AIDA:::CalE.beta.beta(a1 = 1, b1 = 1, a2 = 1, b2 = 1)
  
  expect_true(is.numeric(calE))
  expect_true(is.finite(calE))
  expect_true(calE >= 0)
})

test_that("CalE.beta.kde computes correctly", {
  micro <- c(-0.5, -0.3, -0.1, 0.1, 0.3, 0.5)
  calE <- AIDA:::CalE.beta.kde(micro, a1 = 1, b1 = 1)
  
  expect_true(is.numeric(calE))
  expect_true(is.finite(calE))
})

test_that("CalE.beta.kde handles a degenerate KDE distribution", {
  calE <- AIDA:::CalE.beta.kde(rep(0.25, 3), a1 = 2, b1 = 1)

  expect_equal(calE, 0.25 * (2 * 2 / 3 - 1))
})

test_that("CalE.kde.kde computes correctly", {
  micro1 <- c(-0.5, -0.3, -0.1, 0.1, 0.3, 0.5)
  micro2 <- c(-0.4, -0.2, 0, 0.2, 0.4, 0.6)
  calE <- AIDA:::CalE.kde.kde(micro1, micro2)
  
  expect_true(is.numeric(calE))
  expect_true(is.finite(calE))
  expect_true(calE >= 0)
})

test_that("CalE.kde.kde handles degenerate KDE distributions", {
  expect_equal(AIDA:::CalE.kde.kde(rep(0, 3), rep(0, 3)), 0)
  expect_equal(AIDA:::CalE.kde.kde(rep(0.25, 3), rep(-0.5, 3)), -0.125)
  expect_equal(AIDA:::CalE.kde.kde(rep(0.25, 3), c(-0.5, 0, 0.5)), 0)
})

test_that("CalE.triang.triang computes correctly", {
  calE_00 <- AIDA:::CalE.triang.triang(mo1 = 0, mo2 = 0)
  expect_equal(calE_00, 1/6)
  
  calE_diff <- AIDA:::CalE.triang.triang(mo1 = 0.3, mo2 = -0.2)
  expect_true(is.numeric(calE_diff))
  expect_true(is.finite(calE_diff))
})

test_that("get_latent_param with estimate.DistParam for Triang", {
  Umicro <- matrix(c(-0.3, 0.3, 0.2, 0.3, -0.2, 0.4), ncol = 2)
  res <- get_latent_param(LatentCase = "General",
                         LatentDist = c("Triang", "Triang"),
                         Umicro = Umicro,
                         estimate.DistParam = TRUE)
  
  expect_equal(res$LatentCase, "General")
  expect_true(is.numeric(res$TriangParam))
  expect_equal(length(res$TriangParam), 2)
})

test_that("get_latent_param with estimate.DistParam for Beta", {
  Umicro <- matrix(c(-0.3, 0.3, 0.2, 0.3, -0.2, 0.4), ncol = 2)
  res <- get_latent_param(LatentCase = "General",
                         LatentDist = c("Beta","Beta"),
                         Umicro = Umicro,
                         estimate.DistParam = TRUE)
  
  expect_equal(res$LatentCase, "General")
  expect_true(all(is.numeric(res$BetaParam.a)))
  expect_true(all(is.numeric(res$BetaParam.b)))
  expect_equal(length(res$BetaParam.a), 2)
  expect_equal(length(res$BetaParam.b), 2)
})

test_that("get_latent_param error when estimate.DistParam=TRUE without Umicro", {
  expect_error(get_latent_param(LatentCase = "General",
                               LatentDist = "Beta",
                               estimate.DistParam = TRUE,
                               p = 2),
              "microdata must be provided")
})

test_that("get_latent_param error for invalid Seq format in get_latent_var", {
  macro <- data.frame(L1 = 1, U1 = 3, L2 = 0, U2 = 2)
  rownames(macro) <- "G1"
  micro <- matrix(c(2, 1), ncol = 2)
  
  expect_error(get_latent_var(micro, macro, "G1", "G1", Seq = "Invalid"),
              "should be one of")
})

test_that("get_latent_var preserves data types and dimensions", {
  macro <- data.frame(L1 = 1, U1 = 3, L2 = 0, U2 = 2)
  rownames(macro) <- "G1"
  micro <- matrix(c(2, 1, 3, 2, 1, 0.5), ncol = 2, byrow = TRUE)
  agrby <- rep("G1", nrow(micro))

  U <- get_latent_var(micro, macro, agrby, "G1", Seq = "LbUb_VarbyVar")

  expect_equal(class(U), c("matrix","array"))
  expect_equal(nrow(U), nrow(micro))
  expect_equal(ncol(U), ncol(micro))
  expect_true(is.numeric(U))
})

test_that("get_latent_var with single variable", {
  macro <- data.frame(L = 0, U = 10)
  rownames(macro) <- "G1"
  micro <- matrix(c(2, 5, 8), ncol = 1)
  agrby <- c("G1", "G1", "G1")

  U <- get_latent_var(micro, macro, agrby, "G1", Seq = "LbUb_VarbyVar")

  expect_equal(nrow(U), 3)
  expect_equal(ncol(U), 1)
  expected <- 2 * (micro - 5) / 10
  expect_equal(U, expected)
})

test_that("get_latent_var with many variables", {
  macro <- data.frame(L1 = 1, U1 = 3, L2 = 0, U2 = 2, L3 = -1, U3 = 1, L4 = 10, U4 = 20)
  rownames(macro) <- "G1"
  micro <- matrix(runif(20, 0, 20), ncol = 4)
  agrby <- rep("G1", nrow(micro))

  U <- get_latent_var(micro, macro, agrby, "G1", Seq = "LbUb_VarbyVar")

  expect_equal(nrow(U), nrow(micro))
  expect_equal(ncol(U), 4)
})