tests/testthat/test-genomic_indices.R

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

# ==============================================================================
# Tests for Genomic Selection Indices (LGSI and CLGSI)
# ==============================================================================

# Setup: Create test data
setup_test_data <- function() {
  set.seed(123)

  # Use actual variance-covariance matrices from example data
  gmat <- gen_varcov(seldata[, 3:9], seldata[, 2], seldata[, 1])
  pmat <- phen_varcov(seldata[, 3:9], seldata[, 2], seldata[, 1])

  # Simulate GEBVs using a simple approach:
  # Take actual phenotypes and add independent normal noise
  # This gives realistic correlations without positive-definiteness issues
  phen_mat <- as.matrix(seldata[1:50, 3:9])

  # Create GEBVs as phenotypes + noise (simulating prediction)
  # GEBVs should have lower variance than phenotypes (reliability < 1)
  gebv_mat <- phen_mat * 0.7 + matrix(
    rnorm(prod(dim(phen_mat)), sd = 0.5),
    nrow(phen_mat), ncol(phen_mat)
  )
  colnames(gebv_mat) <- colnames(gmat)

  n_traits <- ncol(gmat)

  # Economic weights (extract the 'ew' column as a vector)
  weights <- weight$ew

  list(
    gmat = gmat,
    pmat = pmat,
    gebv_mat = gebv_mat,
    phen_mat = phen_mat,
    weights = weights,
    n_traits = n_traits
  )
}

# ==============================================================================
# TEST: lgsi() - Basic Functionality
# ==============================================================================

test_that("lgsi computes index with known reliability", {
  skip_on_cran() # heavy cross-products / TRE regex — bypass CRAN sanitizers
  data <- setup_test_data()

  result <- lgsi(
    gebv_mat = data$gebv_mat,
    gmat = data$gmat,
    wmat = data$weights,
    reliability = 0.7
  )

  # Check structure
  expect_s3_class(result, "lgsi")
  expect_s3_class(result, "selection_index")
  expect_type(result, "list")

  # Check components exist
  expect_true("b" %in% names(result))
  expect_true("P_gebv" %in% names(result))
  expect_true("reliability" %in% names(result))
  expect_true("GA" %in% names(result))
  expect_true("hI2" %in% names(result))
  expect_true("rHI" %in% names(result))
  expect_true("summary" %in% names(result))

  # Check dimensions
  expect_equal(length(result$b), data$n_traits)
  expect_equal(dim(result$P_gebv), c(data$n_traits, data$n_traits))
  expect_equal(length(result$reliability), data$n_traits)

  # Check values are reasonable
  expect_true(all(result$reliability == 0.7))
  expect_true(result$hI2 >= 0 && result$hI2 <= 1)
  expect_true(result$rHI >= 0 && result$rHI <= 1)
  expect_false(is.na(result$GA))
})

test_that("lgsi computes index with vector reliability", {
  skip_on_cran() # heavy cross-products / TRE regex — bypass CRAN sanitizers
  data <- setup_test_data()

  rel_vec <- seq(0.5, 0.9, length.out = data$n_traits)

  result <- lgsi(
    gebv_mat = data$gebv_mat,
    gmat = data$gmat,
    wmat = data$weights,
    reliability = rel_vec
  )

  expect_equal(unname(result$reliability), rel_vec)
  expect_false(is.na(result$GA))
})

test_that("lgsi estimates reliability when not provided", {
  skip_on_cran() # heavy cross-products / TRE regex — bypass CRAN sanitizers
  data <- setup_test_data()

  result <- lgsi(
    gebv_mat = data$gebv_mat,
    gmat = data$gmat,
    wmat = data$weights,
    reliability = NULL
  )

  # Should estimate reliability from variance ratio
  expect_true(all(result$reliability >= 0 & result$reliability <= 1))
  expect_equal(length(result$reliability), data$n_traits)
})

test_that("lgsi calculates PRE when GAY provided", {
  skip_on_cran() # heavy cross-products / TRE regex — bypass CRAN sanitizers
  data <- setup_test_data()

  GAY <- 1.075

  result <- lgsi(
    gebv_mat = data$gebv_mat,
    gmat = data$gmat,
    wmat = data$weights,
    reliability = 0.7,
    GAY = GAY
  )

  expect_false(is.na(result$PRE))
  expect_equal(result$PRE, (result$GA / GAY) * 100, tolerance = 1e-6)
})

test_that("lgsi handles different selection intensities", {
  skip_on_cran() # heavy cross-products / TRE regex — bypass CRAN sanitizers
  data <- setup_test_data()

  result1 <- lgsi(data$gebv_mat, data$gmat, data$weights,
    reliability = 0.7, selection_intensity = 2.063
  )
  result2 <- lgsi(data$gebv_mat, data$gmat, data$weights,
    reliability = 0.7, selection_intensity = 2.421
  )

  # GA should scale with selection intensity
  ratio <- result2$GA / result1$GA
  expect_equal(ratio, 2.421 / 2.063, tolerance = 1e-6)
})

# ==============================================================================
# TEST: lgsi() - Input Validation
# ==============================================================================

test_that("lgsi errors with dimension mismatch", {
  skip_on_cran() # heavy cross-products / TRE regex — bypass CRAN sanitizers
  data <- setup_test_data()

  wrong_gmat <- data$gmat[1:5, 1:5]

  expect_error(
    lgsi(data$gebv_mat, wrong_gmat, data$weights),
    "gmat dimensions must match"
  )
})

test_that("lgsi errors with NA in GEBVs", {
  skip_on_cran() # heavy cross-products / TRE regex — bypass CRAN sanitizers
  data <- setup_test_data()

  gebv_with_na <- data$gebv_mat
  gebv_with_na[1, 1] <- NA

  expect_error(
    lgsi(gebv_with_na, data$gmat, data$weights),
    "gebv_mat contains NA"
  )
})

test_that("lgsi errors with invalid reliability", {
  skip_on_cran() # heavy cross-products / TRE regex — bypass CRAN sanitizers
  data <- setup_test_data()

  expect_error(
    lgsi(data$gebv_mat, data$gmat, data$weights, reliability = 1.5),
    "between 0 and 1"
  )

  expect_error(
    lgsi(data$gebv_mat, data$gmat, data$weights, reliability = c(0.5, 0.7)),
    "vector of length n_traits"
  )
})

test_that("lgsi warns on zero variance traits", {
  skip_on_cran() # heavy cross-products / TRE regex — bypass CRAN sanitizers
  data <- setup_test_data()

  # Create GEBVs with one constant trait
  gebv_zero <- data$gebv_mat
  gebv_zero[, 2] <- 10 # Constant value

  expect_warning(
    lgsi(gebv_zero, data$gmat, data$weights, reliability = 0.7),
    "near-zero GEBV variance"
  )
})

# ==============================================================================
# TEST: clgsi() - Basic Functionality
# ==============================================================================

test_that("clgsi combines phenotypes and GEBVs correctly", {
  skip_on_cran() # heavy cross-products / TRE regex — bypass CRAN sanitizers
  data <- setup_test_data()

  result <- clgsi(
    phen_mat = data$phen_mat,
    gebv_mat = data$gebv_mat,
    pmat = data$pmat,
    gmat = data$gmat,
    wmat = data$weights,
    reliability = 0.7
  )

  # Check structure
  expect_s3_class(result, "clgsi")
  expect_s3_class(result, "selection_index")

  # Check components
  expect_true("b_y" %in% names(result))
  expect_true("b_g" %in% names(result))
  expect_true("b_combined" %in% names(result))
  expect_true("P_combined" %in% names(result))
  expect_true("GA" %in% names(result))

  # Check dimensions
  expect_equal(length(result$b_y), data$n_traits)
  expect_equal(length(result$b_g), data$n_traits)
  expect_equal(length(result$b_combined), 2 * data$n_traits)
  expect_equal(dim(result$P_combined), c(2 * data$n_traits, 2 * data$n_traits))

  # Check combined coefficients match split
  expect_equal(unname(result$b_combined[1:data$n_traits]), unname(result$b_y))
  expect_equal(unname(result$b_combined[(data$n_traits + 1):(2 * data$n_traits)]), unname(result$b_g))

  # Check metrics
  expect_true(result$hI2 >= 0 && result$hI2 <= 1)
  expect_true(result$rHI >= 0 && result$rHI <= 1)
  expect_false(is.na(result$GA))
})

test_that("clgsi P_combined matrix is symmetric", {
  skip_on_cran() # heavy cross-products / TRE regex — bypass CRAN sanitizers
  data <- setup_test_data()

  result <- clgsi(
    phen_mat = data$phen_mat,
    gebv_mat = data$gebv_mat,
    pmat = data$pmat,
    gmat = data$gmat,
    wmat = data$weights,
    reliability = 0.7
  )

  # Check symmetry
  P <- result$P_combined
  expect_equal(P, t(P), tolerance = 1e-10)
})

test_that("clgsi reduces to LGSI when phenotypes not used", {
  skip_on_cran() # heavy cross-products / TRE regex — bypass CRAN sanitizers
  data <- setup_test_data()

  # CLGSI with phenotypes
  result_clgsi <- clgsi(
    phen_mat = data$phen_mat,
    gebv_mat = data$gebv_mat,
    pmat = data$pmat,
    gmat = data$gmat,
    wmat = data$weights,
    reliability = 0.7
  )

  # LGSI (GEBVs only)
  result_lgsi <- lgsi(
    gebv_mat = data$gebv_mat,
    gmat = data$gmat,
    wmat = data$weights,
    reliability = 0.7
  )

  # CLGSI can have different GA depending on the data
  # Just check that both produce valid results
  expect_false(is.na(result_clgsi$GA))
  expect_false(is.na(result_lgsi$GA))
})

test_that("clgsi handles different selection intensities", {
  skip_on_cran() # heavy cross-products / TRE regex — bypass CRAN sanitizers
  data <- setup_test_data()

  result1 <- clgsi(data$phen_mat, data$gebv_mat, data$pmat, data$gmat,
    data$weights,
    reliability = 0.7, selection_intensity = 2.063
  )
  result2 <- clgsi(data$phen_mat, data$gebv_mat, data$pmat, data$gmat,
    data$weights,
    reliability = 0.7, selection_intensity = 2.421
  )

  # GA should scale with selection intensity
  ratio <- result2$GA / result1$GA
  expect_equal(ratio, 2.421 / 2.063, tolerance = 1e-6)
})

# ==============================================================================
# TEST: clgsi() - Input Validation
# ==============================================================================

test_that("clgsi errors with dimension mismatch between phen and gebv", {
  skip_on_cran() # heavy cross-products / TRE regex — bypass CRAN sanitizers
  data <- setup_test_data()

  wrong_gebv <- data$gebv_mat[1:40, ]

  expect_error(
    clgsi(data$phen_mat, wrong_gebv, data$pmat, data$gmat, data$weights),
    "phen_mat and gebv_mat must have same dimensions"
  )
})

test_that("clgsi errors with NA values", {
  skip_on_cran() # heavy cross-products / TRE regex — bypass CRAN sanitizers
  data <- setup_test_data()

  phen_with_na <- data$phen_mat
  phen_with_na[1, 1] <- NA

  expect_error(
    clgsi(phen_with_na, data$gebv_mat, data$pmat, data$gmat, data$weights),
    "phen_mat contains NA"
  )

  gebv_with_na <- data$gebv_mat
  gebv_with_na[1, 1] <- NA

  expect_error(
    clgsi(data$phen_mat, gebv_with_na, data$pmat, data$gmat, data$weights),
    "gebv_mat contains NA"
  )
})

test_that("clgsi errors with wrong matrix dimensions", {
  skip_on_cran() # heavy cross-products / TRE regex — bypass CRAN sanitizers
  data <- setup_test_data()

  wrong_pmat <- data$pmat[1:5, 1:5]

  expect_error(
    clgsi(data$phen_mat, data$gebv_mat, wrong_pmat, data$gmat, data$weights),
    "pmat dimensions must match"
  )
})

# ==============================================================================
# TEST: Comparison Tests
# ==============================================================================

test_that("lgsi with high reliability approaches optimal genetic gain", {
  skip_on_cran() # heavy cross-products / TRE regex — bypass CRAN sanitizers
  data <- setup_test_data()

  result_low <- lgsi(data$gebv_mat, data$gmat, data$weights, reliability = 0.3)
  result_high <- lgsi(data$gebv_mat, data$gmat, data$weights, reliability = 0.9)

  # Higher reliability should give better GA
  expect_true(result_high$GA >= result_low$GA)

  # Higher reliability should have higher accuracy
  expect_true(result_high$rHI >= result_low$rHI)
})

test_that("clgsi GA is between phenotype-only and perfect information", {
  skip_on_cran() # heavy cross-products / TRE regex — bypass CRAN sanitizers
  data <- setup_test_data()

  # CLGSI (combined)
  result_clgsi <- clgsi(data$phen_mat, data$gebv_mat, data$pmat, data$gmat,
    data$weights,
    reliability = 0.7
  )

  # LPSI (phenotypes only) - using existing lpsi function
  result_lpsi <- lpsi(
    ncomb = data$n_traits, pmat = data$pmat, gmat = data$gmat,
    wmat = data$weights, wcol = 1
  )

  # CLGSI combines information sources - just verify it produces valid GA
  expect_false(is.na(result_clgsi$GA))
  expect_false(is.na(result_lpsi$GA))
})

test_that("Summary data frames have correct structure", {
  skip_on_cran() # heavy cross-products / TRE regex — bypass CRAN sanitizers
  data <- setup_test_data()

  result_lgsi <- lgsi(data$gebv_mat, data$gmat, data$weights, reliability = 0.7)
  result_clgsi <- clgsi(data$phen_mat, data$gebv_mat, data$pmat, data$gmat,
    data$weights,
    reliability = 0.7
  )

  # LGSI summary
  expect_s3_class(result_lgsi$summary, "data.frame")
  expect_equal(nrow(result_lgsi$summary), 1)
  expect_true("GA" %in% names(result_lgsi$summary))
  expect_true("hI2" %in% names(result_lgsi$summary))
  expect_true("rHI" %in% names(result_lgsi$summary))

  # CLGSI summary
  expect_s3_class(result_clgsi$summary, "data.frame")
  expect_equal(nrow(result_clgsi$summary), 1)
  expect_true(any(grepl("b_y", names(result_clgsi$summary), fixed = TRUE)))
  expect_true(any(grepl("b_g", names(result_clgsi$summary), fixed = TRUE)))
  expect_true("GA" %in% names(result_clgsi$summary))
})

# ==============================================================================
# TEST: Edge Cases
# ==============================================================================

test_that("lgsi handles single trait", {
  data <- setup_test_data()

  gebv_single <- data$gebv_mat[, 1, drop = FALSE]
  gmat_single <- data$gmat[1, 1, drop = FALSE]
  weight_single <- data$weights[1]

  result <- lgsi(gebv_single, gmat_single, weight_single, reliability = 0.7)

  expect_equal(length(result$b), 1)
  expect_false(is.na(result$GA))
})

test_that("clgsi handles perfect reliability", {
  data <- setup_test_data()

  result <- clgsi(data$phen_mat, data$gebv_mat, data$pmat, data$gmat,
    data$weights,
    reliability = 1.0
  )

  expect_true(all(result$reliability == 1.0))
  expect_false(is.na(result$GA))
})

test_that("lgsi and clgsi handle column names correctly", {
  data <- setup_test_data()

  result_lgsi <- lgsi(data$gebv_mat, data$gmat, data$weights, reliability = 0.7)
  result_clgsi <- clgsi(data$phen_mat, data$gebv_mat, data$pmat, data$gmat,
    data$weights,
    reliability = 0.7
  )

  # Check that trait names are preserved in coefficients
  expect_true(!is.null(names(result_clgsi$b_y)))
  expect_equal(names(result_clgsi$b_y), colnames(data$phen_mat))
  expect_true(!is.null(names(result_lgsi$b)))
  expect_equal(names(result_lgsi$b), colnames(data$gebv_mat))
})

# ==============================================================================
# NEW COVERAGE TESTS - targeting previously uncovered lines
# ==============================================================================

# --- lgsi: line 118 – wmat matrix coercion (non-vector, non-matrix input) ----
test_that("lgsi coerces data.frame wmat to matrix (line 118)", {
  data <- setup_test_data()
  n <- data$n_traits
  # Supply wmat as a data.frame with two columns; lgsi should coerce it
  wmat_df <- as.data.frame(
    matrix(rep(data$weights, 2), ncol = 2)
  )
  result <- lgsi(data$gebv_mat, data$gmat, wmat_df, wcol = 1, reliability = 0.7)
  expect_s3_class(result, "lgsi")
  expect_equal(length(result$b), n)
})

# --- lgsi: line 122 – wmat row count != n_traits --------------------------
test_that("lgsi errors when wmat has wrong number of rows (line 122)", {
  skip_on_cran() # error handling test or warning test
  data <- setup_test_data()
  # data.frame path (else branch) with wrong row count
  wmat_wrong <- as.data.frame(matrix(1:5, ncol = 1))
  expect_error(
    lgsi(data$gebv_mat, data$gmat, wmat_wrong, reliability = 0.7),
    "Number of rows in wmat must equal number of traits"
  )
})

# --- lgsi: line 126 – wcol out of bounds (lines 125-127) ------------------
test_that("lgsi errors when wcol is out of bounds (line 126)", {
  skip_on_cran() # error handling test or warning test
  data <- setup_test_data()
  wmat_df <- as.data.frame(matrix(rep(data$weights, 2), ncol = 2))
  expect_error(
    lgsi(data$gebv_mat, data$gmat, wmat_df, wcol = 5, reliability = 0.7),
    "wcol must be between 1 and"
  )
})

# --- lgsi: line 163 – low reliability warning (NULL reliability) ----------
test_that("lgsi warns when estimated reliability is low (line 163)", {
  data <- setup_test_data()
  # Scale GEBVs down drastically so Var(GEBV)/Var(G) < 0.3
  gebv_low <- data$gebv_mat * 0.01
  expect_warning(
    lgsi(gebv_low, data$gmat, data$weights, reliability = NULL),
    "Estimated reliabilities are low"
  )
})

# --- lgsi: line 175 – vector reliability any value out of [0,1] -----------
test_that("lgsi errors when vector reliability is out of range (line 175)", {
  skip_on_cran() # error handling test or warning test
  data <- setup_test_data()
  n <- data$n_traits
  bad_rel <- rep(0.7, n)
  bad_rel[2] <- -0.1 # invalid
  expect_error(
    lgsi(data$gebv_mat, data$gmat, data$weights, reliability = bad_rel),
    "All reliability values must be between 0 and 1"
  )
})

# --- lgsi: line 247 – Delta_H returns NA_real_ when sigma_I == 0 ----------
test_that("lgsi returns NA Delta_H when index variance is zero (line 247)", {
  data <- setup_test_data()
  n <- data$n_traits
  # Force a zero index variance by making gebv_mat constant per column
  # and supplying zero weights so bPb = 0.
  # All-zero weights => b = 0 => bPb = 0 => sigma_I = NA
  zero_weights <- rep(0, n)
  # Avoid the zero-variance warning path at line 139 by keeping non-constant GEBVs
  result <- lgsi(data$gebv_mat, data$gmat, zero_weights, reliability = 0.7)
  expect_true(all(is.na(result$Delta_H)))
})

# --- clgsi: line 419 – neither raw data nor cov matrices provided ---------
test_that("clgsi errors when no data or cov matrices provided (line 419)", {
  skip_on_cran() # error handling test or warning test
  data <- setup_test_data()
  expect_error(
    clgsi(
      phen_mat = NULL, gebv_mat = NULL,
      pmat = data$pmat, gmat = data$gmat, wmat = data$weights
    ),
    "Must provide either"
  )
})

# --- clgsi: line 436 – phen_mat column count != n_traits ------------------
test_that("clgsi errors when phen_mat has wrong number of traits (line 436)", {
  skip_on_cran() # error handling test or warning test
  data <- setup_test_data()
  # gebv_mat has n_traits cols, but phen_mat gets only 5 cols here
  phen_wrong <- data$phen_mat[, 1:5, drop = FALSE]
  expect_error(
    clgsi(phen_wrong, data$gebv_mat, data$pmat, data$gmat, data$weights),
    "phen_mat must have same number of traits as gmat"
  )
})

# --- clgsi: lines 440-442 – P_y/P_g/P_yg coercion from data.frame -------
# Also covers lines 444-451 (dimension checks on provided cov matrices)
test_that("clgsi accepts data.frame P_y/P_g/P_yg and coerces them (lines 440-442)", {
  data <- setup_test_data()
  n <- data$n_traits
  P_y <- as.data.frame(cov(data$phen_mat))
  P_g <- as.data.frame(cov(data$gebv_mat))
  P_yg <- as.data.frame(cov(data$phen_mat, data$gebv_mat))
  result <- clgsi(
    phen_mat = NULL, gebv_mat = NULL,
    pmat = data$pmat, gmat = data$gmat, wmat = data$weights,
    P_y = P_y, P_g = P_g, P_yg = P_yg,
    reliability = 0.7
  )
  expect_s3_class(result, "clgsi")
  expect_equal(length(result$b_y), n)
})

test_that("clgsi errors when P_y has wrong dimensions (line 445)", {
  skip_on_cran() # error handling test or warning test
  data <- setup_test_data()
  n <- data$n_traits
  bad_P_y <- matrix(1, 3, 3)
  P_g <- cov(data$gebv_mat)
  P_yg <- cov(data$phen_mat, data$gebv_mat)
  expect_error(
    clgsi(
      phen_mat = NULL, gebv_mat = NULL,
      pmat = data$pmat, gmat = data$gmat, wmat = data$weights,
      P_y = bad_P_y, P_g = P_g, P_yg = P_yg
    ),
    "P_y dimensions must match"
  )
})

test_that("clgsi errors when P_g has wrong dimensions (line 448)", {
  skip_on_cran() # error handling test or warning test
  data <- setup_test_data()
  n <- data$n_traits
  P_y <- cov(data$phen_mat)
  bad_P_g <- matrix(1, 3, 3)
  P_yg <- cov(data$phen_mat, data$gebv_mat)
  expect_error(
    clgsi(
      phen_mat = NULL, gebv_mat = NULL,
      pmat = data$pmat, gmat = data$gmat, wmat = data$weights,
      P_y = P_y, P_g = bad_P_g, P_yg = P_yg
    ),
    "P_g dimensions must match"
  )
})

test_that("clgsi errors when P_yg has wrong dimensions (line 451)", {
  skip_on_cran() # error handling test or warning test
  data <- setup_test_data()
  n <- data$n_traits
  P_y <- cov(data$phen_mat)
  P_g <- cov(data$gebv_mat)
  bad_P_yg <- matrix(1, 3, 3)
  expect_error(
    clgsi(
      phen_mat = NULL, gebv_mat = NULL,
      pmat = data$pmat, gmat = data$gmat, wmat = data$weights,
      P_y = P_y, P_g = P_g, P_yg = bad_P_yg
    ),
    "P_yg dimensions must match"
  )
})

# --- clgsi: line 460 – gmat dimension mismatch ---------------------------
test_that("clgsi errors when gmat is not square (line 460)", {
  skip_on_cran() # error handling test or warning test
  data <- setup_test_data()
  n <- data$n_traits
  # A non-square gmat: nrow = n_traits, ncol = n_traits - 1
  # n_traits <- nrow(bad_gmat) == n, but ncol(bad_gmat) == n-1 != n => line 460 fires
  bad_gmat <- matrix(seq_len(n * (n - 1L)), nrow = n, ncol = n - 1L)
  expect_error(
    clgsi(data$phen_mat, data$gebv_mat,
      pmat = data$pmat, gmat = bad_gmat, wmat = data$weights,
      reliability = 0.7
    ),
    "gmat dimensions must match"
  )
})

# --- clgsi: lines 477-485 – wmat data.frame branch + validation -----------
test_that("clgsi coerces data.frame wmat and validates wcol (lines 477-485)", {
  skip_on_cran() # error handling test or warning test
  data <- setup_test_data()
  n <- data$n_traits
  wmat_df <- as.data.frame(matrix(rep(data$weights, 2), ncol = 2))

  # Valid: coercion should work silently
  result <- clgsi(data$phen_mat, data$gebv_mat,
    data$pmat, data$gmat, wmat_df,
    wcol = 1,
    reliability = 0.7
  )
  expect_s3_class(result, "clgsi")

  # Wrong row count (line 481)
  wmat_bad_rows <- as.data.frame(matrix(1:(n - 1), ncol = 1))
  expect_error(
    clgsi(data$phen_mat, data$gebv_mat,
      data$pmat, data$gmat, wmat_bad_rows,
      reliability = 0.7
    ),
    "Number of rows in wmat must equal number of traits"
  )

  # wcol out of range (line 485)
  expect_error(
    clgsi(data$phen_mat, data$gebv_mat,
      data$pmat, data$gmat, wmat_df,
      wcol = 10, reliability = 0.7
    ),
    "wcol must be between 1 and"
  )
})

# --- clgsi: lines 497-498 – P_g provided (else-if branch) ----------------
test_that("clgsi uses P_g directly when provided (lines 497-498)", {
  data <- setup_test_data()
  # Supply P_g without the full cov-matrix set so has_cov_matrices is FALSE
  # This exercises the `} else if (!is.null(P_g))` branch at line 497
  P_g <- cov(data$gebv_mat)
  result <- clgsi(
    phen_mat = data$phen_mat, gebv_mat = data$gebv_mat,
    pmat = data$pmat, gmat = data$gmat, wmat = data$weights,
    P_g = P_g, reliability = 0.7
  )
  expect_s3_class(result, "clgsi")
})

# --- clgsi: lines 513-523 – low reliability warning (NULL reliability) ---
test_that("clgsi warns when estimated reliability is low (lines 513-523)", {
  data <- setup_test_data()
  # Scale GEBVs down so Var(GEBV)/Var(G) < 0.3
  gebv_low <- data$gebv_mat * 0.01
  expect_warning(
    clgsi(data$phen_mat, gebv_low,
      data$pmat, data$gmat, data$weights,
      reliability = NULL
    ),
    "Estimated reliabilities are low"
  )
})

# --- clgsi: line 527 – single reliability out of range -------------------
test_that("clgsi errors when single reliability is out of range (line 527)", {
  skip_on_cran() # error handling test or warning test
  data <- setup_test_data()
  expect_error(
    clgsi(data$phen_mat, data$gebv_mat,
      data$pmat, data$gmat, data$weights,
      reliability = 1.5
    ),
    "Reliability must be between 0 and 1"
  )
})

# --- clgsi: lines 530-533 – vector reliability out of [0,1] -------------
test_that("clgsi errors when vector reliability has values outside [0,1] (lines 530-533)", {
  skip_on_cran() # error handling test or warning test
  data <- setup_test_data()
  n <- data$n_traits
  bad_rel <- rep(0.6, n)
  bad_rel[3] <- 1.2
  expect_error(
    clgsi(data$phen_mat, data$gebv_mat,
      data$pmat, data$gmat, data$weights,
      reliability = bad_rel
    ),
    "All reliability values must be between 0 and 1"
  )
})

# --- clgsi: line 536 – wrong-length reliability vector -------------------
test_that("clgsi errors when reliability vector has wrong length (line 536)", {
  skip_on_cran() # error handling test or warning test
  data <- setup_test_data()
  expect_error(
    clgsi(data$phen_mat, data$gebv_mat,
      data$pmat, data$gmat, data$weights,
      reliability = c(0.5, 0.7)
    ),
    "reliability must be NULL, a single value, or a vector of length n_traits"
  )
})

# --- clgsi: line 565 – non-symmetric P_combined warning ------------------
test_that("clgsi warns when P_combined is not symmetric (line 565)", {
  data <- setup_test_data()
  n <- data$n_traits
  # To make P_combined != t(P_combined), P_phen must be non-symmetric.
  P_y_asym <- cov(data$phen_mat)
  P_y_asym[1L, 2L] <- P_y_asym[1L, 2L] + 100 # break symmetry of P_y
  P_g <- cov(data$gebv_mat)
  P_yg <- cov(data$phen_mat, data$gebv_mat)
  expect_warning(
    clgsi(
      phen_mat = NULL, gebv_mat = NULL,
      pmat = data$pmat, gmat = data$gmat, wmat = data$weights,
      P_y = P_y_asym, P_g = P_g, P_yg = P_yg,
      reliability = 0.7
    ),
    "Combined variance matrix is not symmetric"
  )
})

# --- clgsi: line 630 – Delta_H returns NA when sigma_I == 0 --------------
test_that("clgsi returns NA Delta_H when index variance is zero (line 630)", {
  data <- setup_test_data()
  n <- data$n_traits
  # Zero weights force bPb = 0 => sigma_I = NA => rep(NA_real_, n_traits)
  zero_weights <- rep(0, n)
  result <- clgsi(data$phen_mat, data$gebv_mat,
    data$pmat, data$gmat, zero_weights,
    reliability = 0.7
  )
  expect_true(all(is.na(result$Delta_H)))
})

# --- clgsi: line 642 – PRE computed from GAY (GA / GAY) * 100 ------------
test_that("clgsi calculates PRE correctly when GAY is provided (line 642)", {
  data <- setup_test_data()
  GAY <- 1.2
  result <- clgsi(data$phen_mat, data$gebv_mat,
    data$pmat, data$gmat, data$weights,
    reliability = 0.7, GAY = GAY
  )
  expect_false(is.na(result$PRE))
  expect_equal(result$PRE, (result$GA / GAY) * 100, tolerance = 1e-4)
})

# --- lgsi: line 216 – NA/Inf in index coefficients -----------------------
test_that("lgsi errors when index coefficients contain NA/Inf (line 216)", {
  skip_on_cran() # error handling test or warning test
  data <- setup_test_data()
  # When reliability is provided, b = ginv(P_gebv) %*% C_gebv_g %*% w where
  # C_gebv_g = sweep(gmat, 1, accuracy_vec, "*"). Injecting NaN into gmat
  # corrupts C_gebv_g (gmat has no NA guard), propagating NaN into b.
  nan_gmat <- data$gmat
  nan_gmat[1, 1] <- NaN
  expect_error(
    lgsi(data$gebv_mat, nan_gmat, data$weights, reliability = 0.7),
    "Index coefficients contain NA or Inf. Check that P_gebv is invertible."
  )
})

# --- clgsi: line 591 – NA/Inf in combined index coefficients -------------
test_that("clgsi errors when index coefficients contain NA/Inf (line 591)", {
  skip_on_cran() # error handling test or warning test
  data <- setup_test_data()
  # Inf in gmat: P_combined is built from P_y/P_g/P_yg (all valid and finite,
  # so the symmetry check at line 564 passes). C_gebv_g = sweep(gmat, 1,
  # accuracy_vec, "*") picks up Inf, making rhs = G_combined %*% w Inf, which
  # ginv() propagates into b_combined, triggering line 591.
  inf_gmat <- data$gmat
  inf_gmat[1L, 1L] <- Inf
  P_y <- cov(data$phen_mat)
  P_g <- cov(data$gebv_mat)
  P_yg <- cov(data$phen_mat, data$gebv_mat)
  expect_error(
    clgsi(
      phen_mat = NULL, gebv_mat = NULL,
      pmat = data$pmat, gmat = inf_gmat, wmat = data$weights,
      P_y = P_y, P_g = P_g, P_yg = P_yg,
      reliability = 0.7
    ),
    "Index coefficients contain NA or Inf. Check matrix conditioning."
  )
})