test_that("gen.varcov and phen.varcov return correct dimensions", { skip_on_cran() # heavy cross-products / TRE regex — bypass CRAN sanitizers gen <- gen_varcov(seldata[, 3:9], seldata$treat, seldata$rep) phen <- phen_varcov(seldata[, 3:9], seldata$treat, seldata$rep) expect_equal(nrow(gen), 7) expect_equal(ncol(gen), 7) expect_equal(nrow(phen), 7) expect_equal(ncol(phen), 7) }) test_that("gen.varcov and phen.varcov return symmetric matrices", { skip_on_cran() # heavy cross-products / TRE regex — bypass CRAN sanitizers gen <- gen_varcov(seldata[, 3:9], seldata$treat, seldata$rep) phen <- phen_varcov(seldata[, 3:9], seldata$treat, seldata$rep) expect_true(isSymmetric(gen)) expect_true(isSymmetric(phen)) }) test_that("gen.varcov and phen.varcov have appropriate column names", { skip_on_cran() # heavy cross-products / TRE regex — bypass CRAN sanitizers gen <- gen_varcov(seldata[, 3:9], seldata$treat, seldata$rep) phen <- phen_varcov(seldata[, 3:9], seldata$treat, seldata$rep) expect_equal(colnames(gen), colnames(seldata[, 3:9])) expect_equal(colnames(phen), colnames(seldata[, 3:9])) expect_equal(rownames(gen), colnames(seldata[, 3:9])) expect_equal(rownames(phen), colnames(seldata[, 3:9])) }) test_that("gen.varcov returns values less than or equal to phen.varcov", { skip_on_cran() # heavy cross-products / TRE regex — bypass CRAN sanitizers gen <- gen_varcov(seldata[, 3:9], seldata$treat, seldata$rep) phen <- phen_varcov(seldata[, 3:9], seldata$treat, seldata$rep) # Diagonal elements: genotypic variance should be <= phenotypic variance expect_true(all(diag(gen) <= diag(phen))) }) test_that("gen.varcov and phen.varcov handle single trait", { skip_on_cran() # heavy cross-products / TRE regex — bypass CRAN sanitizers gen_single <- gen_varcov(seldata[, 3, drop = FALSE], seldata$treat, seldata$rep) phen_single <- phen_varcov(seldata[, 3, drop = FALSE], seldata$treat, seldata$rep) expect_equal(dim(gen_single), c(1, 1)) expect_equal(dim(phen_single), c(1, 1)) expect_true(is.finite(gen_single[1, 1])) expect_true(is.finite(phen_single[1, 1])) }) test_that("gen.varcov and phen.varcov work with different missing value methods", { skip_on_cran() # heavy cross-products / TRE regex — bypass CRAN sanitizers # Create test data with missing values test_data <- seldata[, 3:9] test_data[1, 1] <- NA test_data[5, 3] <- NA # Test all methods methods <- c("REML", "Yates", "Healy", "Regression", "Mean", "Bartlett") for (method in methods) { gen <- gen_varcov(test_data, seldata$treat, seldata$rep, method = method) phen <- phen_varcov(test_data, seldata$treat, seldata$rep, method = method) expect_equal(nrow(gen), 7, info = paste("Method:", method)) expect_equal(nrow(phen), 7, info = paste("Method:", method)) expect_true(all(is.finite(gen)), info = paste("Method:", method)) expect_true(all(is.finite(phen)), info = paste("Method:", method)) } }) test_that("gen.varcov and phen.varcov return all finite values", { skip_on_cran() # heavy cross-products / TRE regex — bypass CRAN sanitizers gen <- gen_varcov(seldata[, 3:9], seldata$treat, seldata$rep) phen <- phen_varcov(seldata[, 3:9], seldata$treat, seldata$rep) expect_true(all(is.finite(gen))) expect_true(all(is.finite(phen))) }) # ============================================================================== # NEW COVERAGE TESTS — targeting previously uncovered lines in R/varcov.R # ============================================================================== # Helper to build minimal LSD and SPD datasets .make_lsd <- function() { set.seed(123) data.frame( row_block = rep(1:3, each = 3), col_block = rep(1:3, 3), geno = c(1, 2, 3, 2, 3, 1, 3, 1, 2), trait1 = rnorm(9, 30, 5), trait2 = rnorm(9, 20, 3) ) } .make_spd <- function() { set.seed(123) data.frame( rep = rep(1:3, each = 4), main_plot = rep(rep(1:2, each = 2), 3), sub_plot = rep(1:2, 6), trait1 = rnorm(12, 50, 8), trait2 = rnorm(12, 10, 2) ) } test_that(".calculate_varcov internal validations (lines 31-40)", { skip_on_cran() # error handling test or warning test mat <- as.matrix(seldata[1:10, 3:4]) gen_idx <- as.integer(as.factor(seldata$treat[1:10])) rep_idx <- as.integer(as.factor(seldata$rep[1:10])) # line 31: invalid design_type expect_error( selection.index:::.calculate_varcov(mat, gen_idx, rep_idx, design_type = 4L), "design_type must be 1 \\(RCBD\\), 2 \\(LSD\\), or 3 \\(SPD\\)." ) # line 34: invalid cov_type expect_error( selection.index:::.calculate_varcov(mat, gen_idx, rep_idx, design_type = 1L, cov_type = 3L), "cov_type must be 1 \\(genotypic\\) or 2 \\(phenotypic\\)." ) # line 37: LSD without col_idx expect_error( selection.index:::.calculate_varcov(mat, gen_idx, rep_idx, design_type = 2L, col_idx = NULL), "col_idx is required for Latin Square Design" ) # line 40: SPD without main_idx expect_error( selection.index:::.calculate_varcov(mat, gen_idx, rep_idx, design_type = 3L, main_idx = NULL), "main_idx is required for Split Plot Design" ) }) test_that("gen_varcov validations for LSD and SPD (lines 126-137) and SPD formula (lines 67-70)", { skip_on_cran() # error handling test or warning test lsd <- .make_lsd() spd <- .make_spd() # line 126: LSD without columns expect_error( gen_varcov(data = lsd[, c("trait1", "trait2")], genotypes = lsd$geno, replication = lsd$row_block, design_type = "LSD"), "Latin Square Design requires 'columns' parameter" ) # line 129: LSD with columns res_lsd <- gen_varcov(data = lsd[, c("trait1", "trait2")], genotypes = lsd$geno, replication = lsd$row_block, columns = lsd$col_block, design_type = "LSD") expect_true(isSymmetric(res_lsd)) # line 134: SPD without main_plots expect_error( gen_varcov(data = spd[, c("trait1", "trait2")], genotypes = spd$sub_plot, replication = spd$rep, design_type = "SPD"), "Split Plot Design requires 'main_plots' parameter" ) # lines 137, 67-70: SPD with main_plots res_spd <- gen_varcov(data = spd[, c("trait1", "trait2")], genotypes = spd$sub_plot, replication = spd$rep, main_plots = spd$main_plot, design_type = "SPD") expect_true(isSymmetric(res_spd)) }) test_that("phen_varcov validations for LSD and SPD (lines 238-249)", { skip_on_cran() # error handling test or warning test lsd <- .make_lsd() spd <- .make_spd() # line 238: LSD without columns expect_error( phen_varcov(data = lsd[, c("trait1", "trait2")], genotypes = lsd$geno, replication = lsd$row_block, design_type = "LSD"), "Latin Square Design requires 'columns' parameter" ) # line 241: LSD with columns res_lsd <- phen_varcov(data = lsd[, c("trait1", "trait2")], genotypes = lsd$geno, replication = lsd$row_block, columns = lsd$col_block, design_type = "LSD") expect_true(isSymmetric(res_lsd)) # line 246: SPD without main_plots expect_error( phen_varcov(data = spd[, c("trait1", "trait2")], genotypes = spd$sub_plot, replication = spd$rep, design_type = "SPD"), "Split Plot Design requires 'main_plots' parameter" ) # line 249: SPD with main_plots res_spd <- phen_varcov(data = spd[, c("trait1", "trait2")], genotypes = spd$sub_plot, replication = spd$rep, main_plots = spd$main_plot, design_type = "SPD") expect_true(isSymmetric(res_spd)) })