# construct_factorial_labels() tests ---- test_that("construct_factorial_labels works with default separators", { # Create a simple design_book with 2 factors design_book <- data.frame( plot = 1:4, block = 1, A = c("a1", "a1", "a2", "a2"), B = c("b1", "b2", "b1", "b2") ) result <- biometryassist:::construct_factorial_labels(design_book, start_col = 3) # Default separators: c("", " ") means no separator between name and level, space between factors expect_equal(as.character(result), c("Aa1 Bb1", "Aa1 Bb2", "Aa2 Bb1", "Aa2 Bb2")) expect_s3_class(result, "factor") }) test_that("construct_factorial_labels works with single custom separator", { # Create a simple design_book design_book <- data.frame( plot = 1:2, A = c("low", "high"), B = c("x", "y") ) # When a single separator is provided, it's used for both positions result <- biometryassist:::construct_factorial_labels(design_book, start_col = 2, fac.sep = "_") expect_equal(as.character(result), c("A_low_B_x", "A_high_B_y")) expect_s3_class(result, "factor") }) test_that("construct_factorial_labels works with two custom separators", { # Create a design_book design_book <- data.frame( id = 1:2, Variety = c("V1", "V2"), Fertilizer = c("F1", "F2") ) # First separator between name and level, second between factors result <- biometryassist:::construct_factorial_labels(design_book, start_col = 2, fac.sep = c(":", " x ")) expect_equal(as.character(result), c("Variety:V1 x Fertilizer:F1", "Variety:V2 x Fertilizer:F2")) expect_s3_class(result, "factor") }) test_that("construct_factorial_labels handles single factor column", { # Design book with only one factor column to combine design_book <- data.frame( plot = 1:3, treatment = c("T1", "T2", "T3") ) result <- biometryassist:::construct_factorial_labels(design_book, start_col = 2) expect_equal(as.character(result), c("treatmentT1", "treatmentT2", "treatmentT3")) expect_s3_class(result, "factor") }) test_that("construct_factorial_labels handles three factors", { # Design book with three factors design_book <- data.frame( A = c("a1", "a2"), B = c("b1", "b2"), C = c("c1", "c2") ) result <- biometryassist:::construct_factorial_labels(design_book, start_col = 1, fac.sep = c("=", ", ")) expect_equal(as.character(result), c("A=a1, B=b1, C=c1", "A=a2, B=b2, C=c2")) expect_s3_class(result, "factor") }) test_that("construct_factorial_labels trims whitespace from results", { # Design book that might produce extra whitespace design_book <- data.frame( X = c("val1", "val2"), Y = c("val3", "val4") ) # Using space as both separators could create extra spaces result <- biometryassist:::construct_factorial_labels(design_book, start_col = 1, fac.sep = c(" ", " ")) # Check that there's no leading/trailing whitespace expect_equal(as.character(result), c("X val1 Y val3", "X val2 Y val4")) expect_true(all(!grepl("^\\s|\\s$", as.character(result)))) }) test_that("construct_factorial_labels throws error for invalid start_col", { design_book <- data.frame( A = c("a1", "a2"), B = c("b1", "b2") ) # start_col greater than ncol(design_book) should error expect_error( biometryassist:::construct_factorial_labels(design_book, start_col = 5), "start_col must be <= ncol\\(design_book\\)" ) }) test_that("construct_factorial_labels handles various data types in columns", { # Design book with numeric and character columns design_book <- data.frame( dose = c(10, 20, 30), method = c("A", "B", "C"), temp = c(20, 25, 30) ) result <- biometryassist:::construct_factorial_labels(design_book, start_col = 1, fac.sep = c(":", "|")) expect_equal(as.character(result), c("dose:10|method:A|temp:20", "dose:20|method:B|temp:25", "dose:30|method:C|temp:30")) expect_s3_class(result, "factor") }) test_that("construct_factorial_labels produces correct factor levels", { # Create design with repeated combinations design_book <- data.frame( A = c("a1", "a2", "a1", "a2"), B = c("b1", "b1", "b2", "b2") ) result <- biometryassist:::construct_factorial_labels(design_book, start_col = 1) # Should have 4 treatments expect_length(result, 4) # Should have 4 unique levels expect_equal(nlevels(result), 4) # Check the actual levels expect_setequal(levels(result), c("Aa1 Bb1", "Aa1 Bb2", "Aa2 Bb1", "Aa2 Bb2")) }) test_that("construct_factorial_labels works with empty string separators", { design_book <- data.frame( Factor1 = c("X", "Y"), Factor2 = c("1", "2") ) # Both separators as empty strings result <- biometryassist:::construct_factorial_labels(design_book, start_col = 1, fac.sep = c("", "")) expect_equal(as.character(result), c("Factor1XFactor21", "Factor1YFactor22")) expect_s3_class(result, "factor") }) # Tests for apply_factor_names() internal function # Helper to access internal function apply_factor_names <- biometryassist:::apply_factor_names # Test 1: NULL fac.names returns design_book unchanged ---- test_that("apply_factor_names returns design_book unchanged when fac.names is NULL", { design_book <- data.frame( A = factor(c("A1", "A2")), B = factor(c("B1", "B2")), plot = 1:2 ) result <- apply_factor_names(design_book, fac.names = NULL, design_type = "factorial") expect_identical(result, design_book) }) # Test 2: Unknown design_type throws error ---- test_that("apply_factor_names throws error for unknown design_type", { design_book <- data.frame( A = factor(c("A1", "A2")), B = factor(c("B1", "B2")) ) expect_error( apply_factor_names(design_book, fac.names = list(F1 = c("a", "b"), F2 = c("x", "y")), design_type = "unknown"), "Unknown design_type: unknown" ) }) # Test 3: Factorial design with 2 factors ---- test_that("apply_factor_names works with 2-factor factorial design", { design_book <- data.frame( A = factor(c("1", "2", "1", "2")), B = factor(c("X", "X", "Y", "Y")), plot = 1:4 ) fac.names <- list( Nitrogen = c("Low", "High"), Water = c("Dry", "Wet") ) result <- apply_factor_names(design_book, fac.names, design_type = "factorial") # Check that column names changed expect_true("Nitrogen" %in% colnames(result)) expect_true("Water" %in% colnames(result)) expect_false("A" %in% colnames(result)) expect_false("B" %in% colnames(result)) # Check that factor levels changed expect_equal(levels(result$Nitrogen), c("Low", "High")) expect_equal(levels(result$Water), c("Dry", "Wet")) }) # Test 4: Factorial design with 3 factors ---- test_that("apply_factor_names works with 3-factor factorial design", { design_book <- data.frame( A = factor(c("1", "2")), B = factor(c("X", "Y")), C = factor(c("P", "Q")), plot = 1:2 ) fac.names <- list( Nitrogen = c("N50", "N100"), Water = c("Irrigated", "Rainfed"), Variety = c("V1", "V2") ) result <- apply_factor_names(design_book, fac.names, design_type = "factorial") # Check that column names changed expect_true("Nitrogen" %in% colnames(result)) expect_true("Water" %in% colnames(result)) expect_true("Variety" %in% colnames(result)) # Check that factor levels changed expect_equal(levels(result$Nitrogen), c("N50", "N100")) expect_equal(levels(result$Water), c("Irrigated", "Rainfed")) expect_equal(levels(result$Variety), c("V1", "V2")) }) # Test 5: Split plot design with list ---- test_that("apply_factor_names works with split plot design using list", { design_book <- data.frame( treatments = factor(c("A", "B", "A", "B")), sub_treatments = factor(c("1", "2", "1", "2")), plot = 1:4 ) fac.names <- list( Water = c("Irrigated", "Rainfed"), Nitrogen = c("N50", "N100") ) result <- apply_factor_names(design_book, fac.names, design_type = "split") # Check that column names changed expect_true("Water" %in% colnames(result)) expect_true("Nitrogen" %in% colnames(result)) expect_false("treatments" %in% colnames(result)) expect_false("sub_treatments" %in% colnames(result)) # Check that factor levels changed expect_equal(levels(result$Water), c("Irrigated", "Rainfed")) expect_equal(levels(result$Nitrogen), c("N50", "N100")) }) # Test 6: Split plot design with character vector ---- test_that("apply_factor_names works with split plot design using character vector", { design_book <- data.frame( treatments = factor(c("A", "B")), sub_treatments = factor(c("1", "2")), plot = 1:2 ) fac.names <- c("Water", "Nitrogen") result <- apply_factor_names(design_book, fac.names, design_type = "split") # Check that column names changed expect_true("Water" %in% colnames(result)) expect_true("Nitrogen" %in% colnames(result)) expect_false("treatments" %in% colnames(result)) expect_false("sub_treatments" %in% colnames(result)) }) # Test 7: Warning when fac.names has too many elements ---- test_that("apply_factor_names warns when fac.names has too many elements for factorial", { design_book <- data.frame( A = factor(c("1", "2")), B = factor(c("X", "Y")), plot = 1:2 ) fac.names <- list( F1 = c("a", "b"), F2 = c("x", "y"), F3 = c("p", "q") # Too many ) expect_warning( apply_factor_names(design_book, fac.names, design_type = "factorial"), "fac.names contains 3 elements but only the first 2 have been used." ) }) # Test 8: Warning when fac.names has too few elements ---- test_that("apply_factor_names warns and returns unchanged when fac.names has too few elements", { design_book <- data.frame( A = factor(c("1", "2")), B = factor(c("X", "Y")), plot = 1:2 ) fac.names <- list( F1 = c("a", "b") # Only 1, need 2 ) expect_warning( result <- apply_factor_names(design_book, fac.names, design_type = "factorial"), "fac.names doesn't contain enough elements and has not been used." ) # Check that design_book is returned unchanged expect_identical(result, design_book) }) # Test 9: Warning when factor levels don't match ---- test_that("apply_factor_names warns when factor levels don't match", { design_book <- data.frame( A = factor(c("1", "2", "3")), # 3 levels B = factor(c("X", "Y", "Y")), plot = 1:3 ) fac.names <- list( Nitrogen = c("Low", "High"), # Only 2 levels, but A has 3 Water = c("Dry", "Wet") ) expect_warning( result <- apply_factor_names(design_book, fac.names, design_type = "factorial"), "Nitrogen must contain the correct number of elements. Elements have not been applied." ) # Check that the mismatched factor was NOT changed expect_true("A" %in% colnames(result)) # Column name should still be A expect_false("Nitrogen" %in% colnames(result)) # Check that the correctly matched factor WAS changed expect_true("Water" %in% colnames(result)) expect_equal(levels(result$Water), c("Dry", "Wet")) }) # Test 10: Split plot with too few elements ---- test_that("apply_factor_names warns for split plot with too few elements", { design_book <- data.frame( treatments = factor(c("A", "B")), sub_treatments = factor(c("1", "2")), plot = 1:2 ) fac.names <- list(Water = c("Irrigated", "Rainfed")) # Only 1, need 2 expect_warning( result <- apply_factor_names(design_book, fac.names, design_type = "split"), "fac.names doesn't contain enough elements and has not been used." ) # Check that design_book is returned unchanged expect_identical(result, design_book) }) # Test 11: Split plot with too many elements ---- test_that("apply_factor_names warns for split plot with too many elements", { design_book <- data.frame( treatments = factor(c("A", "B")), sub_treatments = factor(c("1", "2")), plot = 1:2 ) fac.names <- list( Water = c("Irrigated", "Rainfed"), Nitrogen = c("N50", "N100"), Extra = c("E1", "E2") # Too many ) expect_warning( apply_factor_names(design_book, fac.names, design_type = "split"), "fac.names contains 3 elements but only the first 2 have been used." ) }) # Test 12: Factorial design with partial mismatch in levels ---- test_that("apply_factor_names handles partial mismatch in factor levels for factorial", { design_book <- data.frame( A = factor(c("1", "2", "2")), B = factor(c("X", "Y", "Z")), # 3 levels plot = 1:3 ) fac.names <- list( Nitrogen = c("Low", "High"), # Matches A (2 levels) Water = c("Dry", "Wet") # Doesn't match B (3 levels) ) expect_warning( result <- apply_factor_names(design_book, fac.names, design_type = "factorial"), "Water must contain the correct number of elements. Elements have not been applied." ) # Check that Nitrogen was applied successfully expect_true("Nitrogen" %in% colnames(result)) expect_equal(levels(result$Nitrogen), c("Low", "High")) # Check that Water was not applied expect_true("B" %in% colnames(result)) expect_false("Water" %in% colnames(result)) }) # Test 13: Split plot with mismatched levels ---- test_that("apply_factor_names warns when split plot factor levels don't match", { design_book <- data.frame( treatments = factor(c("A", "B", "C")), # 3 levels sub_treatments = factor(c("1", "2", "2")), plot = 1:3 ) fac.names <- list( Water = c("Irrigated", "Rainfed"), # Only 2, but treatments has 3 Nitrogen = c("N50", "N100") ) expect_warning( result <- apply_factor_names(design_book, fac.names, design_type = "split"), "Water must contain the correct number of elements. Elements have not been applied." ) }) # Test 14: Factorial design - column name updates only on successful application ---- test_that("apply_factor_names only updates column names when levels are successfully applied", { design_book <- data.frame( A = factor(c("1", "2", "2")), B = factor(c("X", "Y", "Z")), # Mismatch plot = 1:3 ) fac.names <- list( GoodName = c("a", "b"), # Matches A BadName = c("x", "y") # Doesn't match B ) expect_warning( result <- apply_factor_names(design_book, fac.names, design_type = "factorial"), "BadName must contain the correct number of elements" ) # GoodName should be applied to A expect_true("GoodName" %in% colnames(result)) expect_false("A" %in% colnames(result)) # BadName should NOT be applied to B expect_true("B" %in% colnames(result)) expect_false("BadName" %in% colnames(result)) }) # Test 15: Verify factorial design determines n_facs correctly for 2 factors ---- test_that("apply_factor_names correctly identifies 2-factor factorial design", { # Design with A and B but no C design_book <- data.frame( A = factor(c("1", "2")), B = factor(c("X", "Y")) ) fac.names <- list( F1 = c("a", "b"), F2 = c("x", "y") ) # Should work without error expect_silent( result <- apply_factor_names(design_book, fac.names, design_type = "factorial") ) expect_true("F1" %in% colnames(result)) expect_true("F2" %in% colnames(result)) }) # Test 16: Verify factorial design determines n_facs correctly for 3 factors ---- test_that("apply_factor_names correctly identifies 3-factor factorial design", { # Design with A, B, and C design_book <- data.frame( A = factor(c("1", "2")), B = factor(c("X", "Y")), C = factor(c("P", "Q")) ) fac.names <- list( F1 = c("a", "b"), F2 = c("x", "y"), F3 = c("p", "q") ) # Should work without error expect_silent( result <- apply_factor_names(design_book, fac.names, design_type = "factorial") ) expect_true("F1" %in% colnames(result)) expect_true("F2" %in% colnames(result)) expect_true("F3" %in% colnames(result)) }) # Tests for reorder_row_col() internal helper ---- test_that("reorder_row_col returns plan unchanged when row/col are missing", { plan <- data.frame(x = 1:3) result <- biometryassist:::reorder_row_col(plan) expect_identical(result, plan) }) test_that("reorder_row_col reorders row/col to the front when present", { plan <- data.frame(col = 1:2, row = 3:4, block = c("B1", "B2")) result <- biometryassist:::reorder_row_col(plan) expect_equal(names(result)[1:2], c("row", "col")) expect_equal(names(result)[3], "block") expect_equal(result$row, plan$row) expect_equal(result$col, plan$col) }) # Tests for calculate_block_layout() helper function test_that("calculate_block_layout validates brows and bcols parameters", { # NULL values expect_error( biometryassist:::calculate_block_layout(10, 10, NULL, 5, 10), "calculate_block_layout: 'brows' and 'bcols' must be positive, finite, non-missing values." ) expect_error( biometryassist:::calculate_block_layout(10, 10, 5, NULL, 10), "calculate_block_layout: 'brows' and 'bcols' must be positive, finite, non-missing values." ) # NA values expect_error( biometryassist:::calculate_block_layout(10, 10, NA, 5, 10), "calculate_block_layout: 'brows' and 'bcols' must be positive, finite, non-missing values." ) expect_error( biometryassist:::calculate_block_layout(10, 10, 5, NA, 10), "calculate_block_layout: 'brows' and 'bcols' must be positive, finite, non-missing values." ) # Infinite values expect_error( biometryassist:::calculate_block_layout(10, 10, Inf, 5, 10), "calculate_block_layout: 'brows' and 'bcols' must be positive, finite, non-missing values." ) expect_error( biometryassist:::calculate_block_layout(10, 10, 5, Inf, 10), "calculate_block_layout: 'brows' and 'bcols' must be positive, finite, non-missing values." ) # Zero or negative values expect_error( biometryassist:::calculate_block_layout(10, 10, 0, 5, 10), "calculate_block_layout: 'brows' and 'bcols' must be positive, finite, non-missing values." ) expect_error( biometryassist:::calculate_block_layout(10, 10, -1, 5, 10), "calculate_block_layout: 'brows' and 'bcols' must be positive, finite, non-missing values." ) expect_error( biometryassist:::calculate_block_layout(10, 10, 5, 0, 10), "calculate_block_layout: 'brows' and 'bcols' must be positive, finite, non-missing values." ) expect_error( biometryassist:::calculate_block_layout(10, 10, 5, -1, 10), "calculate_block_layout: 'brows' and 'bcols' must be positive, finite, non-missing values." ) }) test_that("calculate_block_layout handles blocking across rows (brows == ntrt)", { # When brows equals ntrt, blocks span entire columns result <- biometryassist:::calculate_block_layout( nrows = 6, ncols = 3, brows = 6, bcols = 1, ntrt = 6 ) # Should return expand.grid(row = 1:nrows, col = 1:ncols) expected <- expand.grid(row = 1:6, col = 1:3) expect_equal(result, expected, ignore_attr = TRUE) expect_equal(nrow(result), 18) expect_equal(names(result), c("row", "col")) # Check that rows are ordered correctly (1,2,3,4,5,6 for each column) expect_equal(result$row[1:6], 1:6) expect_equal(result$col[1:6], rep(1, 6)) }) test_that("calculate_block_layout handles blocking incomplete rows with all columns (rr > 1 & cc == 1)", { # Multiple row blocks spanning all columns result <- biometryassist:::calculate_block_layout( nrows = 8, ncols = 4, brows = 2, bcols = 4, ntrt = 8 ) # Should match expand.grid(col = 1:ncols, row = 1:nrows), but with a stable # output column order of row then col expected <- expand.grid(col = 1:4, row = 1:8) expected <- expected[, c("row", "col")] expect_equal(result, expected) expect_equal(nrow(result), 32) expect_equal(names(result), c("row", "col")) # Check that columns are ordered correctly (1,2,3,4 for each row) expect_equal(result$col[1:4], 1:4) expect_equal(result$row[1:4], rep(1, 4)) }) test_that("calculate_block_layout handles blocking across columns (bcols == ntrt)", { # When bcols equals ntrt, blocks span entire rows result <- biometryassist:::calculate_block_layout( nrows = 3, ncols = 6, brows = 3, bcols = 6, ntrt = 6 ) # Should match expand.grid(col = 1:ncols, row = 1:nrows), but with a stable # output column order of row then col expected <- expand.grid(col = 1:6, row = 1:3) expected <- expected[, c("row", "col")] expect_equal(result, expected) expect_equal(nrow(result), 18) expect_equal(names(result), c("row", "col")) # Check ordering expect_equal(result$col[1:6], 1:6) expect_equal(result$row[1:6], rep(1, 6)) }) test_that("calculate_block_layout handles blocking incomplete rows and columns (rr > 1 & cc > 1)", { # Square blocks with multiple rows and columns # Example: 6x4 grid with 3x2 blocks (2 row blocks, 2 column blocks = 4 blocks) block_vec <- rep(1:4, each = 6) result <- biometryassist:::calculate_block_layout( nrows = 6, ncols = 4, brows = 3, bcols = 2, ntrt = 6, block_vec = block_vec ) expect_equal(nrow(result), 24) expect_equal(names(result), c("row", "col")) expect_false(any(is.na(result$row))) expect_false(any(is.na(result$col))) # All row and column values should be within bounds expect_true(all(result$row >= 1 & result$row <= 6)) expect_true(all(result$col >= 1 & result$col <= 4)) # Check that block assignments produced correct layout # Block 1 should be in rows 1-3, cols 1-2 block1_rows <- result$row[1:6] block1_cols <- result$col[1:6] expect_true(all(block1_rows >= 1 & block1_rows <= 3)) expect_true(all(block1_cols >= 1 & block1_cols <= 2)) }) test_that("calculate_block_layout handles blocking incomplete columns with all rows (cc > 1 & rr == 1)", { # Multiple column blocks spanning all rows block_vec <- rep(1:3, each = 4) result <- biometryassist:::calculate_block_layout( nrows = 4, ncols = 6, brows = 4, bcols = 2, ntrt = 8, block_vec = block_vec ) expect_equal(nrow(result), 24) expect_equal(names(result), c("row", "col")) expect_false(any(is.na(result$row))) expect_false(any(is.na(result$col))) # All row and column values should be within bounds expect_true(all(result$row >= 1 & result$row <= 4)) expect_true(all(result$col >= 1 & result$col <= 6)) # Block 1 should be in all rows (1-4), cols 1-2 block1_rows <- result$row[1:4] block1_cols <- result$col[1:4] expect_true(all(block1_rows >= 1 & block1_rows <= 4)) expect_true(all(block1_cols >= 1 & block1_cols <= 2)) }) test_that("calculate_block_layout falls back to default for edge cases", { # Test the default fallback when none of the special conditions are met # This can happen when rr == 1 and cc == 1 (single block) result <- biometryassist:::calculate_block_layout( nrows = 5, ncols = 5, brows = 5, bcols = 5, ntrt = 10 ) # Should return expand.grid(row = 1:nrows, col = 1:ncols) expected <- expand.grid(row = 1:5, col = 1:5) expect_equal(result, expected, ignore_attr = TRUE) expect_equal(nrow(result), 25) expect_equal(names(result), c("row", "col")) }) test_that("calculate_block_layout handles various block configurations correctly", { # Test 1: 4x3 grid with 2x1 blocks (2 row blocks, 3 column blocks) block_vec <- rep(1:6, each = 2) result1 <- biometryassist:::calculate_block_layout( nrows = 4, ncols = 3, brows = 2, bcols = 1, ntrt = 6, block_vec = block_vec ) expect_equal(nrow(result1), 12) expect_equal(names(result1), c("row", "col")) expect_true(all(result1$row >= 1 & result1$row <= 4)) expect_true(all(result1$col >= 1 & result1$col <= 3)) # Test 2: 3x4 grid with 1x2 blocks (3 row blocks, 2 column blocks) block_vec <- rep(1:6, each = 2) result2 <- biometryassist:::calculate_block_layout( nrows = 3, ncols = 4, brows = 1, bcols = 2, ntrt = 6, block_vec = block_vec ) expect_equal(nrow(result2), 12) expect_equal(names(result2), c("row", "col")) expect_true(all(result2$row >= 1 & result2$row <= 3)) expect_true(all(result2$col >= 1 & result2$col <= 4)) }) test_that("calculate_block_layout returns correct dimensions for all paths", { # Each test should return nrows * ncols total positions # Path 1: brows == ntrt r1 <- biometryassist:::calculate_block_layout(5, 4, 5, 1, 5) expect_equal(nrow(r1), 20) # Path 2: rr > 1 & cc == 1 r2 <- biometryassist:::calculate_block_layout(6, 3, 2, 3, 6) expect_equal(nrow(r2), 18) # Path 3: bcols == ntrt r3 <- biometryassist:::calculate_block_layout(3, 5, 3, 5, 5) expect_equal(nrow(r3), 15) # Path 4: rr > 1 & cc > 1 (with block_vec) r4 <- biometryassist:::calculate_block_layout(6, 6, 3, 3, 9, rep(1:4, each = 9)) expect_equal(nrow(r4), 36) # Path 5: cc > 1 & rr == 1 (with block_vec) r5 <- biometryassist:::calculate_block_layout(3, 6, 3, 2, 6, rep(1:3, each = 6)) expect_equal(nrow(r5), 18) # Path 6: default r6 <- biometryassist:::calculate_block_layout(4, 4, 4, 4, 8) expect_equal(nrow(r6), 16) }) test_that("calculate_block_layout always returns data frame with row and col columns", { # Test that all return paths produce consistent output with row and col columns # This ensures the reorder_row_col helper function works correctly # Test various configurations test_cases <- list( list(nrows = 5, ncols = 4, brows = 5, bcols = 1, ntrt = 5), list(nrows = 6, ncols = 3, brows = 2, bcols = 3, ntrt = 6), list(nrows = 3, ncols = 5, brows = 3, bcols = 5, ntrt = 5), list(nrows = 6, ncols = 6, brows = 3, bcols = 3, ntrt = 9, block_vec = rep(1:4, each = 9)), list(nrows = 4, ncols = 4, brows = 4, bcols = 4, ntrt = 8) ) for (tc in test_cases) { result <- do.call(biometryassist:::calculate_block_layout, tc) # Verify output is a data frame expect_s3_class(result, "data.frame") # Verify it has row and col columns expect_true("row" %in% names(result)) expect_true("col" %in% names(result)) # Verify row and col are the first two columns (reorder_row_col output) expect_equal(names(result)[1:2], c("row", "col")) # Verify all values are within valid ranges expect_true(all(result$row >= 1 & result$row <= tc$nrows)) expect_true(all(result$col >= 1 & result$col <= tc$ncols)) } }) # Tests for internal helper functions in design_helpers.R test_that("get_design_info correctly identifies non-factorial designs", { # Test with a CRD design crd_design <- agricolae::design.crd(trt = c("A", "B", "C"), r = 3, seed = 42) result <- biometryassist:::get_design_info(crd_design) expect_type(result, "list") expect_named(result, c("type", "is_factorial", "base")) expect_equal(result$type, "crd") expect_false(result$is_factorial) expect_equal(result$base, "crd") }) test_that("get_design_info correctly identifies RCBD designs", { # Test with an RCBD design rcbd_design <- agricolae::design.rcbd(trt = c("T1", "T2", "T3", "T4"), r = 4, seed = 42) result <- biometryassist:::get_design_info(rcbd_design) expect_type(result, "list") expect_equal(result$type, "rcbd") expect_false(result$is_factorial) expect_equal(result$base, "rcbd") }) test_that("get_design_info correctly identifies LSD designs", { # Test with a Latin Square design lsd_design <- agricolae::design.lsd(trt = c("V1", "V2", "V3", "V4"), seed = 42) result <- biometryassist:::get_design_info(lsd_design) expect_type(result, "list") expect_equal(result$type, "lsd") expect_false(result$is_factorial) expect_equal(result$base, "lsd") }) test_that("get_design_info correctly identifies factorial designs with CRD", { # Test with a factorial CRD design factorial_crd <- agricolae::design.ab(trt = c(2, 3), r = 2, design = "crd", seed = 42) result <- biometryassist:::get_design_info(factorial_crd) expect_type(result, "list") expect_named(result, c("type", "is_factorial", "base")) expect_equal(result$type, "factorial_crd") expect_true(result$is_factorial) expect_equal(result$base, "crd") }) test_that("get_design_info correctly identifies factorial designs with RCBD", { # Test with a factorial RCBD design factorial_rcbd <- agricolae::design.ab(trt = c(3, 2), r = 3, design = "rcbd", seed = 42) result <- biometryassist:::get_design_info(factorial_rcbd) expect_type(result, "list") expect_equal(result$type, "factorial_rcbd") expect_true(result$is_factorial) expect_equal(result$base, "rcbd") }) test_that("get_design_info correctly identifies factorial designs with LSD", { # Test with a factorial Latin Square design factorial_lsd <- agricolae::design.ab(trt = c(2, 2), r = 1, design = "lsd", seed = 42) result <- biometryassist:::get_design_info(factorial_lsd) expect_type(result, "list") expect_equal(result$type, "factorial_lsd") expect_true(result$is_factorial) expect_equal(result$base, "lsd") }) test_that("get_design_info handles 3-way factorial designs", { # Test with a 3-way factorial design factorial_3way <- agricolae::design.ab(trt = c(2, 2, 2), r = 2, design = "crd", seed = 42) result <- biometryassist:::get_design_info(factorial_3way) expect_type(result, "list") expect_equal(result$type, "factorial_crd") expect_true(result$is_factorial) expect_equal(result$base, "crd") }) test_that("get_design_info structure is consistent across design types", { # Create different design types and verify structure is always the same designs <- list( crd = agricolae::design.crd(trt = c("A", "B"), r = 2, seed = 42), rcbd = agricolae::design.rcbd(trt = c("A", "B"), r = 3, seed = 42), lsd = agricolae::design.lsd(trt = c("A", "B", "C"), seed = 42), factorial = agricolae::design.ab(trt = c(2, 2), r = 2, design = "crd", seed = 42) ) for (design in designs) { result <- biometryassist:::get_design_info(design) # Check that all expected fields are present expect_named(result, c("type", "is_factorial", "base")) # Check types of fields expect_type(result$type, "character") expect_type(result$is_factorial, "logical") expect_type(result$base, "character") # Check that all fields have length 1 expect_length(result$type, 1) expect_length(result$is_factorial, 1) expect_length(result$base, 1) } }) # Tests for validate_design_inputs() ---- # Tests for validate_block_params() ---- test_that("validate_block_params errors when brows/bcols are missing for blocked designs", { # Any blocked design should require brows/bcols to be supplied. expect_error( biometryassist:::validate_block_params( design_info = list(base = "rcbd"), brows = NA, bcols = 2 ), "Design has blocks so brows and bcols must be supplied\\.", fixed = FALSE ) expect_error( biometryassist:::validate_block_params( design_info = list(base = "strip"), brows = 2, bcols = NA ), "Design has blocks so brows and bcols must be supplied\\.", fixed = FALSE ) }) test_that("validate_block_params enforces strip plot brows/bcols > 1", { expect_error( biometryassist:::validate_block_params( design_info = list(base = "strip"), brows = 1, bcols = 2 ), "Strip plot designs require blocks with more than one row and more than one column\\. Please supply brows > 1 and bcols > 1\\.", fixed = FALSE ) expect_error( biometryassist:::validate_block_params( design_info = list(base = "strip"), brows = 2, bcols = 1 ), "Strip plot designs require blocks with more than one row and more than one column\\. Please supply brows > 1 and bcols > 1\\.", fixed = FALSE ) expect_silent( biometryassist:::validate_block_params( design_info = list(base = "strip"), brows = 2, bcols = 2 ) ) }) test_that("validate_strip_inputs errors on invalid strip inputs", { # A minimal valid starting point: 2x2 layout, brows=2, bcols=2. base_book <- data.frame( treatments = factor(c("A", "A", "B", "B")), sub_treatments = factor(c("x", "y", "x", "y")) ) # Missing brows/bcols expect_error( biometryassist:::validate_strip_inputs(base_book, nrows = 2, ncols = 2, brows = NA, bcols = 2), "Strip plot designs require brows and bcols\\.", fixed = FALSE ) expect_error( biometryassist:::validate_strip_inputs(base_book, nrows = 2, ncols = 2, brows = 2, bcols = NA), "Strip plot designs require brows and bcols\\.", fixed = FALSE ) # brows/bcols must be > 1 expect_error( biometryassist:::validate_strip_inputs(base_book, nrows = 2, ncols = 2, brows = 1, bcols = 2), "Strip plot designs require blocks with more than one row and more than one column \\(brows > 1 and bcols > 1\\)\\.", fixed = FALSE ) expect_error( biometryassist:::validate_strip_inputs(base_book, nrows = 2, ncols = 2, brows = 2, bcols = 1), "Strip plot designs require blocks with more than one row and more than one column \\(brows > 1 and bcols > 1\\)\\.", fixed = FALSE ) # nrows/ncols must be multiples of brows/bcols expect_error( biometryassist:::validate_strip_inputs(base_book, nrows = 3, ncols = 2, brows = 2, bcols = 2), "For strip plot designs, nrows must be a multiple of brows and ncols must be a multiple of bcols so blocks tile the layout\\.", fixed = FALSE ) # Must contain required columns missing_cols <- data.frame( treatments = factor(c("A", "A", "B", "B")) ) expect_error( biometryassist:::validate_strip_inputs(missing_cols, nrows = 2, ncols = 2, brows = 2, bcols = 2), "Expected strip plot design book to contain 'treatments' and 'sub_treatments' columns\\.", fixed = FALSE ) # Area mismatch expect_error( biometryassist:::validate_strip_inputs(base_book, nrows = 2, ncols = 3, brows = 2, bcols = 3), "Strip plot layout area \\(nrows \\* ncols\\) must match the number of plots implied by reps, treatments, and sub_treatments\\.", fixed = FALSE ) # Within-block row/column strip level counts must match brows/bcols bad_row_levels <- data.frame( treatments = factor(c("A", "A", "A", "A")), sub_treatments = factor(c("x", "y", "x", "y")) ) expect_error( biometryassist:::validate_strip_inputs(bad_row_levels, nrows = 2, ncols = 2, brows = 2, bcols = 2), "Strip plot designs apply one treatment to each row within a block, so length\\(treatments\\) must equal brows\\.", fixed = FALSE ) bad_col_levels <- data.frame( treatments = factor(c("A", "A", "B", "B")), sub_treatments = factor(c("x", "x", "x", "x")) ) expect_error( biometryassist:::validate_strip_inputs(bad_col_levels, nrows = 2, ncols = 2, brows = 2, bcols = 2), "Strip plot designs apply one treatment to each column within a block, so length\\(sub_treatments\\) must equal bcols\\.", fixed = FALSE ) # Block count mismatch when block column exists # Use an area-correct book (nrow == nrows*ncols) so the block-count check is # actually reached. with_blocks <- data.frame( treatments = factor(rep(c("A", "B"), each = 4)), sub_treatments = factor(rep(c("x", "y"), times = 4)), block = factor(rep(1, 8)) ) expect_error( biometryassist:::validate_strip_inputs(with_blocks, nrows = 4, ncols = 2, brows = 2, bcols = 2), "Strip plot designs require one block per replicate; the number of blocks implied by brows/bcols does not match the design book\\.", fixed = FALSE ) }) test_that("validate_strip_inputs is silent when block count matches", { # Same 4x2 layout (area = 8) with 2 blocks implied by rr*cc. with_blocks_ok <- data.frame( treatments = factor(rep(c("A", "B"), each = 4)), sub_treatments = factor(rep(c("x", "y"), times = 4)), block = factor(rep(1:2, each = 4)) ) expect_silent( result <- biometryassist:::validate_strip_inputs( with_blocks_ok, nrows = 4, ncols = 2, brows = 2, bcols = 2 ) ) expect_equal(result$row_levels, c("A", "B")) expect_equal(result$col_levels, c("x", "y")) expect_equal(result$rr, 2L) expect_equal(result$cc, 1L) }) test_that("validate_strip_inputs uses unique() for non-factor treatments", { # Use character columns (not factors) to trigger the else branches for # row_levels/col_levels. char_book <- data.frame( treatments = c("A", "A", "B", "B"), sub_treatments = c("x", "y", "x", "y") ) result <- biometryassist:::validate_strip_inputs( char_book, nrows = 2, ncols = 2, brows = 2, bcols = 2 ) expect_equal(result$row_levels, c("A", "B")) expect_equal(result$col_levels, c("x", "y")) expect_equal(result$rr, 1L) expect_equal(result$cc, 1L) }) test_that("validate_design_inputs passes valid inputs", { expect_silent( biometryassist:::validate_design_inputs( nrows = 10, ncols = 5, brows = NA, bcols = NA, size = 4, seed = TRUE ) ) expect_silent( biometryassist:::validate_design_inputs( nrows = 10, ncols = 5, brows = 5, bcols = 2, size = 6, seed = 42 ) ) }) test_that("validate_design_inputs errors when brows > nrows", { expect_error( biometryassist:::validate_design_inputs( nrows = 10, ncols = 5, brows = 15, bcols = 2, size = 4, seed = TRUE ), "brows must not be larger than nrows" ) }) test_that("validate_design_inputs errors when bcols > ncols", { expect_error( biometryassist:::validate_design_inputs( nrows = 10, ncols = 5, brows = 5, bcols = 10, size = 4, seed = TRUE ), "bcols must not be larger than ncols" ) }) test_that("validate_design_inputs errors when size is not numeric", { expect_error( biometryassist:::validate_design_inputs( nrows = 10, ncols = 5, brows = NA, bcols = NA, size = "large", seed = TRUE ), "size must be numeric" ) }) test_that("validate_design_inputs errors for invalid seed values", { expect_error( biometryassist:::validate_design_inputs( nrows = 10, ncols = 5, brows = NA, bcols = NA, size = 4, seed = NA ), "seed must be numeric or TRUE/FALSE" ) expect_error( biometryassist:::validate_design_inputs( nrows = 10, ncols = 5, brows = NA, bcols = NA, size = 4, seed = "random" ), "seed must be numeric or TRUE/FALSE" ) }) # Tests for parse_design_type() ---- test_that("parse_design_type handles non-factorial designs", { result <- biometryassist:::parse_design_type("crd") expect_equal(result$base, "crd") expect_false(result$is_factorial) expect_equal(result$full_type, "crd") result <- biometryassist:::parse_design_type("RCBD") expect_equal(result$base, "rcbd") expect_false(result$is_factorial) result <- biometryassist:::parse_design_type(" lsd ") expect_equal(result$base, "lsd") expect_false(result$is_factorial) result <- biometryassist:::parse_design_type("split") expect_equal(result$base, "split") expect_false(result$is_factorial) }) test_that("parse_design_type handles factorial designs", { result <- biometryassist:::parse_design_type("crossed:crd") expect_equal(result$base, "crd") expect_true(result$is_factorial) expect_equal(result$full_type, "factorial_crd") result <- biometryassist:::parse_design_type("CROSSED:RCBD") expect_equal(result$base, "rcbd") expect_true(result$is_factorial) expect_equal(result$full_type, "factorial_rcbd") result <- biometryassist:::parse_design_type("crossed: lsd") expect_equal(result$base, "lsd") expect_true(result$is_factorial) }) test_that("parse_design_type errors for invalid types", { expect_error( biometryassist:::parse_design_type("invalid"), "Designs of type 'invalid' are not supported" ) expect_error( biometryassist:::parse_design_type(c("crd", "rcbd")), "type must be a single non-missing string" ) expect_error( biometryassist:::parse_design_type(NA), "type must be a single non-missing string" ) expect_error( biometryassist:::parse_design_type(""), "type must be a non-empty string" ) }) test_that("parse_design_type errors for invalid factorial types", { expect_error( biometryassist:::parse_design_type("crossed:"), "Crossed factorial designs must be specified as 'crossed:'" ) expect_error( biometryassist:::parse_design_type("crossed:split"), "Crossed designs of type 'split' are not supported" ) expect_error( biometryassist:::parse_design_type("crossed:invalid"), "Crossed designs of type 'invalid' are not supported" ) }) # Tests for create_agricolae_design() ---- test_that("create_agricolae_design creates CRD designs", { parsed_type <- list(base = "crd", is_factorial = FALSE, full_type = "crd") result <- biometryassist:::create_agricolae_design( parsed_type, treatments = 1:4, reps = 5, sub_treatments = NULL, seed = 42 ) expect_equal(result$parameters$design, "crd") expect_equal(result$parameters$seed, 42) expect_equal(nrow(result$book), 20) }) test_that("create_agricolae_design creates RCBD designs", { parsed_type <- list(base = "rcbd", is_factorial = FALSE, full_type = "rcbd") result <- biometryassist:::create_agricolae_design( parsed_type, treatments = letters[1:6], reps = 4, sub_treatments = NULL, seed = 123 ) expect_equal(result$parameters$design, "rcbd") expect_equal(result$parameters$seed, 123) expect_equal(nrow(result$book), 24) }) test_that("create_agricolae_design creates LSD designs", { parsed_type <- list(base = "lsd", is_factorial = FALSE, full_type = "lsd") expect_message( result <- biometryassist:::create_agricolae_design( parsed_type, treatments = 1:5, reps = 3, sub_treatments = NULL, seed = 42 ), "Number of replicates is not required for Latin Square designs" ) expect_equal(result$parameters$design, "lsd") expect_equal(nrow(result$book), 25) }) test_that("create_agricolae_design creates split plot designs", { parsed_type <- list(base = "split", is_factorial = FALSE, full_type = "split") result <- biometryassist:::create_agricolae_design( parsed_type, treatments = c("A", "B"), reps = 4, sub_treatments = 1:4, seed = 42 ) expect_equal(result$parameters$design, "split") expect_equal(nrow(result$book), 32) }) test_that("create_agricolae_design errors when split plot missing sub_treatments", { parsed_type <- list(base = "split", is_factorial = FALSE, full_type = "split") expect_error( biometryassist:::create_agricolae_design( parsed_type, treatments = c("A", "B"), reps = 4, sub_treatments = NULL, seed = 42 ), "sub_treatments are required for a split plot design" ) }) test_that("create_agricolae_design creates factorial designs", { parsed_type <- list(base = "crd", is_factorial = TRUE, full_type = "factorial_crd") result <- biometryassist:::create_agricolae_design( parsed_type, treatments = c(3, 2), reps = 3, sub_treatments = NULL, seed = 42 ) expect_equal(result$parameters$design, "factorial") expect_equal(result$parameters$applied, "crd") expect_equal(nrow(result$book), 18) }) test_that("create_agricolae_design errors for >3 factor factorial", { parsed_type <- list(base = "crd", is_factorial = TRUE, full_type = "factorial_crd") expect_error( biometryassist:::create_agricolae_design( parsed_type, treatments = c(2, 2, 2, 2), reps = 3, sub_treatments = NULL, seed = 42 ), "Crossed designs with more than three treatment factors are not supported" ) }) test_that("create_agricolae_design uses seed value correctly", { parsed_type <- list(base = "crd", is_factorial = FALSE, full_type = "crd") result1 <- biometryassist:::create_agricolae_design( parsed_type, treatments = 1:4, reps = 5, sub_treatments = NULL, seed = 42 ) result2 <- biometryassist:::create_agricolae_design( parsed_type, treatments = 1:4, reps = 5, sub_treatments = NULL, seed = 42 ) expect_identical(result1$book, result2$book) }) # Tests for calculate_total_plots() ---- test_that("calculate_total_plots works for CRD", { parsed_type <- list(base = "crd", is_factorial = FALSE) result <- biometryassist:::calculate_total_plots( parsed_type, treatments = 1:5, reps = 4, sub_treatments = NULL ) expect_equal(result, 20) }) test_that("calculate_total_plots works for RCBD", { parsed_type <- list(base = "rcbd", is_factorial = FALSE) result <- biometryassist:::calculate_total_plots( parsed_type, treatments = letters[1:6], reps = 3, sub_treatments = NULL ) expect_equal(result, 18) }) test_that("calculate_total_plots works for LSD", { parsed_type <- list(base = "lsd", is_factorial = FALSE) result <- biometryassist:::calculate_total_plots( parsed_type, treatments = 1:4, reps = NULL, sub_treatments = NULL ) expect_equal(result, 16) }) test_that("calculate_total_plots works for split plot", { parsed_type <- list(base = "split", is_factorial = FALSE) result <- biometryassist:::calculate_total_plots( parsed_type, treatments = c("A", "B"), reps = 4, sub_treatments = 1:3 ) expect_equal(result, 24) }) test_that("calculate_total_plots works for factorial CRD", { parsed_type <- list(base = "crd", is_factorial = TRUE) result <- biometryassist:::calculate_total_plots( parsed_type, treatments = c(3, 2), reps = 4, sub_treatments = NULL ) expect_equal(result, 24) }) test_that("calculate_total_plots works for factorial LSD", { parsed_type <- list(base = "lsd", is_factorial = TRUE) result <- biometryassist:::calculate_total_plots( parsed_type, treatments = c(3, 2), reps = NULL, sub_treatments = NULL ) expect_equal(result, 36) }) test_that("calculate_total_plots works for 3-way factorial", { parsed_type <- list(base = "crd", is_factorial = TRUE) result <- biometryassist:::calculate_total_plots( parsed_type, treatments = c(2, 2, 2), reps = 3, sub_treatments = NULL ) expect_equal(result, 24) }) test_that("calculate_total_plots errors for unknown non-factorial design type", { parsed_type <- list(base = "unknown", is_factorial = FALSE) expect_error( biometryassist:::calculate_total_plots( parsed_type, treatments = c("A", "B"), reps = 2, sub_treatments = 1:3 ), "Unknown design type" ) }) # Tests for validate_dimensions() ---- test_that("validate_dimensions warns when area > treatments", { expect_warning( biometryassist:::validate_dimensions(dim = 30, trs = 20), "Area provided is larger than treatments applied" ) }) test_that("validate_dimensions warns when area < treatments", { expect_warning( biometryassist:::validate_dimensions(dim = 20, trs = 30), "Area provided is smaller than treatments applied" ) }) test_that("validate_dimensions is silent when area == treatments", { expect_silent( biometryassist:::validate_dimensions(dim = 25, trs = 25) ) }) # Tests for handle_save() ---- test_that("handle_save does nothing when save = FALSE", { info <- list(design = data.frame(x = 1:5)) expect_silent( biometryassist:::handle_save( save = FALSE, savename = "test", plottype = "pdf", info = info ) ) expect_false(file.exists("test.pdf")) expect_false(file.exists("test.csv")) }) test_that("handle_save does nothing when save = 'none'", { info <- list(design = data.frame(x = 1:5)) expect_silent( biometryassist:::handle_save( save = "none", savename = "test", plottype = "pdf", info = info ) ) expect_false(file.exists("test.pdf")) expect_false(file.exists("test.csv")) }) test_that("handle_save creates CSV when save = 'workbook'", { withr::local_file("test_save_wb.csv") info <- list(design = data.frame(x = 1:5, y = letters[1:5])) biometryassist:::handle_save( save = "workbook", savename = "test_save_wb", plottype = "pdf", info = info ) expect_true(file.exists("test_save_wb.csv")) expect_false(file.exists("test_save_wb.pdf")) # Verify CSV content saved <- read.csv("test_save_wb.csv") expect_equal(nrow(saved), 5) expect_equal(names(saved), c("x", "y")) }) test_that("handle_save errors for invalid save option", { info <- list(design = data.frame(x = 1:5)) expect_error( biometryassist:::handle_save( save = "invalid", savename = "test", plottype = "pdf", info = info ), "save must be one of 'none'/FALSE, 'both'/TRUE, 'plot', or 'workbook'" ) })