tests/testthat/test-genomic_varcov.R

In selection.index: Analysis of Selection Index in Plant Breeding

# ==============================================================================
# Tests for Genomic Variance-Covariance Functions (R/genomic.R)
# ==============================================================================

# ==============================================================================
# TEST: genomic_varcov() - Genomic Variance-Covariance Matrix (Γ)
# ==============================================================================

test_that("genomic_varcov returns correct dimensions", {
  set.seed(123)
  n_genotypes <- 100
  n_traits <- 5
  gebv_mat <- matrix(rnorm(n_genotypes * n_traits),
    nrow = n_genotypes, ncol = n_traits
  )
  colnames(gebv_mat) <- paste0("Trait", 1:n_traits)

  Gamma <- genomic_varcov(gebv_mat)

  expect_equal(nrow(Gamma), n_traits)
  expect_equal(ncol(Gamma), n_traits)
  expect_equal(dim(Gamma), c(n_traits, n_traits))
})

test_that("genomic_varcov returns symmetric matrix", {
  set.seed(456)
  gebv_mat <- matrix(rnorm(500), nrow = 100, ncol = 5)

  Gamma <- genomic_varcov(gebv_mat)

  expect_true(isSymmetric(Gamma))
  expect_true(isSymmetric(unname(Gamma)))
})

test_that("genomic_varcov preserves trait names", {
  set.seed(789)
  gebv_mat <- matrix(rnorm(400), nrow = 80, ncol = 5)
  trait_names <- c("Yield", "Height", "Maturity", "Quality", "Biomass")
  colnames(gebv_mat) <- trait_names

  Gamma <- genomic_varcov(gebv_mat)

  expect_equal(colnames(Gamma), trait_names)
  expect_equal(rownames(Gamma), trait_names)
})

test_that("genomic_varcov works with different correlation methods", {
  set.seed(111)
  gebv_mat <- matrix(rnorm(300), nrow = 60, ncol = 5)

  Gamma_pearson <- genomic_varcov(gebv_mat, method = "pearson")
  Gamma_kendall <- genomic_varcov(gebv_mat, method = "kendall")
  Gamma_spearman <- genomic_varcov(gebv_mat, method = "spearman")

  expect_equal(dim(Gamma_pearson), c(5, 5))
  expect_equal(dim(Gamma_kendall), c(5, 5))
  expect_equal(dim(Gamma_spearman), c(5, 5))

  # Methods should give different results
  expect_false(identical(Gamma_pearson, Gamma_kendall))
})

test_that("genomic_varcov handles missing values with complete.obs", {
  set.seed(222)
  gebv_mat <- matrix(rnorm(300), nrow = 60, ncol = 5)
  gebv_mat[c(1, 5, 10), 1] <- NA
  gebv_mat[c(3, 7), 3] <- NA

  Gamma <- genomic_varcov(gebv_mat, use = "complete.obs")

  expect_equal(dim(Gamma), c(5, 5))
  expect_true(all(is.finite(Gamma)))
  expect_true(isSymmetric(Gamma))
})

test_that("genomic_varcov warns with pairwise.complete.obs and missing values", {
  set.seed(333)
  gebv_mat <- matrix(rnorm(300), nrow = 60, ncol = 5)
  gebv_mat[c(1, 5, 10), 1] <- NA

  expect_warning(
    Gamma <- genomic_varcov(gebv_mat, use = "pairwise.complete.obs"),
    "Missing values detected"
  )

  expect_equal(dim(Gamma), c(5, 5))
})

test_that("genomic_varcov errors with everything and missing values", {
  skip_on_cran() # error handling test or warning test
  set.seed(444)
  gebv_mat <- matrix(rnorm(300), nrow = 60, ncol = 5)
  gebv_mat[1, 1] <- NA

  expect_error(
    genomic_varcov(gebv_mat, use = "everything"),
    "Missing values detected"
  )
})

test_that("genomic_varcov errors with non-numeric data", {
  skip_on_cran() # error handling test or warning test
  gebv_mat <- matrix(letters[1:20], nrow = 4, ncol = 5)

  expect_error(
    genomic_varcov(gebv_mat),
    "numeric"
  )
})

test_that("genomic_varcov errors with too few observations", {
  skip_on_cran() # error handling test or warning test
  gebv_mat <- matrix(rnorm(5), nrow = 1, ncol = 5)

  expect_error(
    genomic_varcov(gebv_mat),
    "at least 2 observations"
  )
})

test_that("genomic_varcov returns all finite values", {
  set.seed(555)
  gebv_mat <- matrix(rnorm(500), nrow = 100, ncol = 5)

  Gamma <- genomic_varcov(gebv_mat)

  expect_true(all(is.finite(Gamma)))
  expect_false(any(is.na(Gamma)))
  expect_false(any(is.infinite(Gamma)))
})

# ==============================================================================
# TEST: phenomic_genomic_varcov() - Phenomic-Genomic Covariance Matrix (Φ)
# ==============================================================================

test_that("phenomic_genomic_varcov returns correct dimensions from raw data", {
  set.seed(666)
  n_genotypes <- 100
  n_traits <- 7

  phen_mat <- matrix(rnorm(n_genotypes * n_traits, mean = 15, sd = 3),
    nrow = n_genotypes, ncol = n_traits
  )
  gebv_mat <- matrix(rnorm(n_genotypes * n_traits, mean = 10, sd = 2),
    nrow = n_genotypes, ncol = n_traits
  )

  Phi <- phenomic_genomic_varcov(phen_mat, gebv_mat)

  # Should be 2*n_traits x 2*n_traits
  expect_equal(dim(Phi), c(2 * n_traits, 2 * n_traits))
  expect_equal(nrow(Phi), 14)
  expect_equal(ncol(Phi), 14)
})

test_that("phenomic_genomic_varcov returns symmetric matrix", {
  set.seed(777)
  phen_mat <- matrix(rnorm(400), nrow = 80, ncol = 5)
  gebv_mat <- matrix(rnorm(400), nrow = 80, ncol = 5)

  Phi <- phenomic_genomic_varcov(phen_mat, gebv_mat)

  expect_true(isSymmetric(unname(Phi), tol = 1e-10))
})

test_that("phenomic_genomic_varcov works with pre-computed matrices", {
  set.seed(888)
  n_traits <- 5

  P <- matrix(rnorm(n_traits^2), nrow = n_traits, ncol = n_traits)
  P <- (P + t(P)) / 2 # Make symmetric

  Gamma <- matrix(rnorm(n_traits^2), nrow = n_traits, ncol = n_traits)
  Gamma <- (Gamma + t(Gamma)) / 2 # Make symmetric

  P_yg <- matrix(rnorm(n_traits^2), nrow = n_traits, ncol = n_traits)

  Phi <- phenomic_genomic_varcov(P = P, Gamma = Gamma, P_yg = P_yg)

  expect_equal(dim(Phi), c(2 * n_traits, 2 * n_traits))
  expect_true(isSymmetric(unname(Phi), tol = 1e-10))
})

test_that("phenomic_genomic_varcov adds dimension names", {
  set.seed(999)
  phen_mat <- matrix(rnorm(400), nrow = 80, ncol = 5)
  gebv_mat <- matrix(rnorm(400), nrow = 80, ncol = 5)
  colnames(phen_mat) <- paste0("T", 1:5)
  colnames(gebv_mat) <- paste0("T", 1:5)

  Phi <- phenomic_genomic_varcov(phen_mat, gebv_mat)

  expect_false(is.null(colnames(Phi)))
  expect_false(is.null(rownames(Phi)))
  expect_true(any(grepl("_phen", colnames(Phi), fixed = TRUE)))
  expect_true(any(grepl("_gebv", colnames(Phi), fixed = TRUE)))
})

test_that("phenomic_genomic_varcov errors without necessary inputs", {
  skip_on_cran() # error handling test or warning test
  expect_error(
    phenomic_genomic_varcov(),
    "Must provide either"
  )
})

test_that("phenomic_genomic_varcov errors with dimension mismatch", {
  skip_on_cran() # error handling test or warning test
  phen_mat <- matrix(rnorm(400), nrow = 80, ncol = 5)
  gebv_mat <- matrix(rnorm(300), nrow = 60, ncol = 5) # Different rows

  expect_error(
    phenomic_genomic_varcov(phen_mat, gebv_mat),
    "same number of rows"
  )

  gebv_mat2 <- matrix(rnorm(400), nrow = 80, ncol = 5)
  phen_mat2 <- matrix(rnorm(320), nrow = 80, ncol = 4) # Different cols

  expect_error(
    phenomic_genomic_varcov(phen_mat2, gebv_mat2),
    "same number of columns"
  )
})

test_that("phenomic_genomic_varcov errors with non-symmetric P or Gamma", {
  skip_on_cran() # error handling test or warning test
  n_traits <- 5

  P <- matrix(rnorm(n_traits^2), nrow = n_traits, ncol = n_traits)
  # P is not symmetric

  Gamma <- matrix(rnorm(n_traits^2), nrow = n_traits, ncol = n_traits)
  Gamma <- (Gamma + t(Gamma)) / 2

  P_yg <- matrix(rnorm(n_traits^2), nrow = n_traits, ncol = n_traits)

  expect_error(
    phenomic_genomic_varcov(P = P, Gamma = Gamma, P_yg = P_yg),
    "symmetric"
  )
})

test_that("phenomic_genomic_varcov works with different covariance methods", {
  set.seed(1010)
  phen_mat <- matrix(rnorm(400), nrow = 80, ncol = 5)
  gebv_mat <- matrix(rnorm(400), nrow = 80, ncol = 5)

  Phi_pearson <- phenomic_genomic_varcov(phen_mat, gebv_mat, method = "pearson")
  Phi_kendall <- phenomic_genomic_varcov(phen_mat, gebv_mat, method = "kendall")

  expect_equal(dim(Phi_pearson), dim(Phi_kendall))
  expect_false(identical(Phi_pearson, Phi_kendall))
})

# ==============================================================================
# TEST: genetic_genomic_varcov() - Genetic-Genomic Covariance Matrix (A)
# ==============================================================================

test_that("genetic_genomic_varcov returns correct dimensions", {
  set.seed(1111)
  n_traits <- 7

  gmat <- matrix(rnorm(n_traits^2), nrow = n_traits, ncol = n_traits)
  gmat <- (gmat + t(gmat)) / 2 # Make symmetric

  A <- genetic_genomic_varcov(gmat)

  # Should be 2*n_traits x 2*n_traits
  expect_equal(dim(A), c(2 * n_traits, 2 * n_traits))
  expect_equal(nrow(A), 14)
})

test_that("genetic_genomic_varcov returns symmetric matrix", {
  set.seed(1212)
  gmat <- gen_varcov(seldata[, 3:9], seldata[, 2], seldata[, 1])

  A <- genetic_genomic_varcov(gmat)

  expect_true(isSymmetric(unname(A), tol = 1e-10))
})

test_that("genetic_genomic_varcov works with reliability parameter", {
  set.seed(1313)
  gmat <- gen_varcov(seldata[, 3:9], seldata[, 2], seldata[, 1])

  # Single reliability value
  A1 <- genetic_genomic_varcov(gmat, reliability = 0.8)
  expect_equal(nrow(A1), 2 * ncol(gmat))

  # Vector of reliabilities
  rel_vec <- seq(0.6, 0.9, length.out = ncol(gmat))
  A2 <- genetic_genomic_varcov(gmat, reliability = rel_vec)
  expect_equal(nrow(A2), 2 * ncol(gmat))
})

test_that("genetic_genomic_varcov works with Gamma parameter", {
  set.seed(1414)
  gmat <- gen_varcov(seldata[, 3:9], seldata[, 2], seldata[, 1])
  Gamma <- gmat * 0.8 # Simulate genomic variance

  A <- genetic_genomic_varcov(gmat, Gamma = Gamma)

  expect_equal(nrow(A), 2 * ncol(gmat))
  expect_true(isSymmetric(unname(A), tol = 1e-10))
})

test_that("genetic_genomic_varcov works with C_gebv_g parameter", {
  set.seed(1515)
  n_traits <- 5
  gmat <- matrix(rnorm(n_traits^2), nrow = n_traits, ncol = n_traits)
  gmat <- (gmat + t(gmat)) / 2

  C_gebv_g <- matrix(rnorm(n_traits^2), nrow = n_traits, ncol = n_traits)

  A <- genetic_genomic_varcov(gmat, C_gebv_g = C_gebv_g)

  expect_equal(dim(A), c(2 * n_traits, 2 * n_traits))
})

test_that("genetic_genomic_varcov square parameter works", {
  set.seed(1616)
  gmat <- gen_varcov(seldata[, 3:9], seldata[, 2], seldata[, 1])


  A_square <- genetic_genomic_varcov(gmat, square = TRUE)
  expect_equal(nrow(A_square), 2 * ncol(gmat))
  expect_equal(ncol(A_square), 2 * ncol(gmat))


  A_rect <- genetic_genomic_varcov(gmat, square = FALSE)
  expect_equal(nrow(A_rect), 2 * ncol(gmat))
  expect_equal(ncol(A_rect), ncol(gmat))
})

test_that("genetic_genomic_varcov errors with invalid reliability", {
  skip_on_cran() # error handling test or warning test
  gmat <- gen_varcov(seldata[, 3:9], seldata[, 2], seldata[, 1])


  expect_error(
    genetic_genomic_varcov(gmat, reliability = 1.5),
    "reliability|0 and 1"
  )


  expect_error(
    genetic_genomic_varcov(gmat, reliability = -0.2),
    "reliability|0 and 1"
  )

  # Wrong length vector
  expect_error(
    genetic_genomic_varcov(gmat, reliability = c(0.7, 0.8)),
    "reliability|length"
  )
})

test_that("genetic_genomic_varcov errors with dimension mismatch", {
  skip_on_cran() # error handling test or warning test
  gmat <- gen_varcov(seldata[, 3:9], seldata[, 2], seldata[, 1])

  wrong_Gamma <- matrix(rnorm(25), nrow = 5, ncol = 5)
  wrong_Gamma <- (wrong_Gamma + t(wrong_Gamma)) / 2 # Make symmetric

  expect_error(
    genetic_genomic_varcov(gmat, Gamma = wrong_Gamma),
    "Gamma must be"
  )
})

test_that("genetic_genomic_varcov adds dimension names", {
  set.seed(1717)
  gmat <- gen_varcov(seldata[, 3:9], seldata[, 2], seldata[, 1])

  A <- genetic_genomic_varcov(gmat)

  expect_false(is.null(colnames(A)))
  expect_false(is.null(rownames(A)))
})

test_that("genetic_genomic_varcov returns all finite values", {
  set.seed(1818)
  gmat <- gen_varcov(seldata[, 3:9], seldata[, 2], seldata[, 1])

  A <- genetic_genomic_varcov(gmat)

  expect_true(all(is.finite(A)))
  expect_false(any(is.na(A)))
})

# ==============================================================================
# TEST: Integration tests
# ==============================================================================

test_that("genomic covariance functions work together", {
  set.seed(2020)

  # Generate test data
  n_genotypes <- 100
  n_traits <- 7 # Match seldata trait count

  phen_mat <- matrix(rnorm(n_genotypes * n_traits, mean = 15, sd = 3),
    nrow = n_genotypes, ncol = n_traits
  )
  gebv_mat <- matrix(rnorm(n_genotypes * n_traits, mean = 10, sd = 2),
    nrow = n_genotypes, ncol = n_traits
  )

  # Compute all matrices
  Gamma <- genomic_varcov(gebv_mat)
  Phi <- phenomic_genomic_varcov(phen_mat, gebv_mat)

  # Use realvariance-covariance matrices
  gmat <- gen_varcov(seldata[, 3:9], seldata[, 2], seldata[, 1])
  A <- genetic_genomic_varcov(gmat, Gamma = Gamma[seq_len(nrow(gmat)), seq_len(ncol(gmat))]) # 1:nrow(gmat), 1:ncol(gmat)])

  expect_equal(dim(Gamma), c(n_traits, n_traits))
  expect_equal(dim(Phi), c(2 * n_traits, 2 * n_traits))
  expect_equal(nrow(A), 2 * nrow(gmat))
})

# ==============================================================================
# NEW COVERAGE TESTS — targeting previously uncovered lines in R/genomic.R
# ==============================================================================

test_that("phenomic_genomic_varcov parameter validation and warnings (lines 241-275)", {
  skip_on_cran() # error handling test or warning test
  n_traits <- 3
  P <- matrix(rnorm(n_traits^2), n_traits, n_traits)
  P <- (P + t(P)) / 2 # symmetric

  Gamma_nonsym <- matrix(rnorm(n_traits^2), n_traits, n_traits)
  # line 241: Gamma not symmetric
  expect_error(
    phenomic_genomic_varcov(P = P, Gamma = Gamma_nonsym, P_yg = P),
    "Gamma must be symmetric"
  )

  Gamma_sym <- (Gamma_nonsym + t(Gamma_nonsym)) / 2
  Gamma_wrong_dim <- matrix(1, 2, 2)
  # line 247: Gamma wrong dimension
  expect_error(
    phenomic_genomic_varcov(P = P, Gamma = Gamma_wrong_dim, P_yg = P),
    "Gamma must be 3 x 3"
  )

  P_yg_wrong_dim <- matrix(1, 2, 2)
  # line 250: P_yg wrong dimension
  expect_error(
    phenomic_genomic_varcov(P = P, Gamma = Gamma_sym, P_yg = P_yg_wrong_dim),
    "P_yg must be 3 x 3"
  )

  # lines 272-275: Phi not symmetric
  # Mock is_symmetric to return FALSE when called on the combined 6x6 Phi matrix
  mock_is_sym <- function(x, ...) {
    if (nrow(x) > n_traits) {
      return(FALSE)
    }
    TRUE
  }

  expect_warning(
    with_mocked_bindings(
      phenomic_genomic_varcov(P = P, Gamma = Gamma_sym, P_yg = P),
      is_symmetric = mock_is_sym,
      .package = "selection.index"
    ),
    "Phi is not symmetric \\(max asymmetry"
  )
})

test_that("genetic_genomic_varcov parameter validation and warnings (lines 366-439)", {
  skip_on_cran() # error handling test or warning test
  n_traits <- 3
  gmat_nonsym <- matrix(rnorm(n_traits^2), n_traits, n_traits)

  # line 366: gmat not symmetric
  expect_error(
    genetic_genomic_varcov(gmat = gmat_nonsym),
    "gmat must be symmetric"
  )

  gmat_sym <- (gmat_nonsym + t(gmat_nonsym)) / 2
  Gamma_nonsym <- matrix(rnorm(n_traits^2), n_traits, n_traits)

  # line 376: Gamma not symmetric
  expect_error(
    genetic_genomic_varcov(gmat = gmat_sym, Gamma = Gamma_nonsym),
    "Gamma must be symmetric"
  )

  Gamma_sym <- (Gamma_nonsym + t(Gamma_nonsym)) / 2
  C_gebv_g_wrong <- matrix(1, 2, 2)

  # line 388: C_gebv_g wrong dimension
  expect_error(
    genetic_genomic_varcov(gmat = gmat_sym, Gamma = Gamma_sym, C_gebv_g = C_gebv_g_wrong),
    "C_gebv_g must be 3 x 3"
  )

  # lines 436-439: A is not symmetric
  mock_is_sym <- function(x, ...) {
    if (nrow(x) > n_traits) {
      return(FALSE)
    }
    TRUE
  }

  expect_warning(
    with_mocked_bindings(
      genetic_genomic_varcov(gmat = gmat_sym, Gamma = Gamma_sym),
      is_symmetric = mock_is_sym,
      .package = "selection.index"
    ),
    "A is not symmetric \\(max asymmetry"
  )
})