# Tests for precision_profile() # ============================================================================= # Helper function to create test data create_precision_profile_data <- function(n_levels = 6, seed = 42) { set.seed(seed) # Concentration levels spanning 2 orders of magnitude conc_levels <- c(5, 10, 25, 50, 100, 200)[1:n_levels] # True hyperbolic CV: sqrt(3^2 + (20/x)^2) # At x=5: CV ~4.5%, at x=200: CV ~3.0% prec_data <- data.frame() for (i in seq_along(conc_levels)) { level_data <- expand.grid( level = conc_levels[i], day = 1:5, replicate = 1:5 ) true_cv <- sqrt(3^2 + (20/conc_levels[i])^2) level_data$value <- conc_levels[i] * rnorm( nrow(level_data), mean = 1, sd = true_cv/100 ) prec_data <- rbind(prec_data, level_data) } prec_data } # Helper to create a data frame with concentration and CV columns create_cv_data <- function(n_levels = 6, seed = 42) { set.seed(seed) conc <- c(5, 10, 25, 50, 100, 200)[1:n_levels] # True hyperbolic CV with some noise true_cv <- sqrt(3^2 + (20/conc)^2) cv <- true_cv + rnorm(n_levels, 0, 0.3) cv <- pmax(cv, 1) # Ensure positive data.frame( concentration = conc, cv_pct = cv ) } # Input Validation Tests ---- test_that("precision_profile validates minimum number of concentration levels", { cv_data <- create_cv_data(n_levels = 3) expect_error( precision_profile(cv_data, concentration = "concentration", cv = "cv_pct"), "At least 4 concentration levels" ) }) test_that("precision_profile validates positive concentration values", { cv_data <- data.frame( concentration = c(-1, 10, 25, 50), cv_pct = c(5, 4, 3.5, 3) ) expect_error( precision_profile(cv_data, concentration = "concentration", cv = "cv_pct"), "positive" ) }) test_that("precision_profile validates positive CV values", { cv_data <- data.frame( concentration = c(5, 10, 25, 50), cv_pct = c(5, 4, -3.5, 3) ) expect_error( precision_profile(cv_data, concentration = "concentration", cv = "cv_pct"), "positive" ) }) test_that("precision_profile validates NA values", { cv_data <- data.frame( concentration = c(5, 10, NA, 50), cv_pct = c(5, 4, 3.5, 3) ) expect_error( precision_profile(cv_data, concentration = "concentration", cv = "cv_pct"), "NA" ) }) test_that("precision_profile validates conf_level", { cv_data <- create_cv_data() expect_error( precision_profile(cv_data, concentration = "concentration", cv = "cv_pct", conf_level = 0), "conf_level" ) expect_error( precision_profile(cv_data, concentration = "concentration", cv = "cv_pct", conf_level = 1.5), "conf_level" ) }) test_that("precision_profile validates cv_targets", { cv_data <- create_cv_data() expect_error( precision_profile(cv_data, concentration = "concentration", cv = "cv_pct", cv_targets = c(-10, 20)), "cv_targets" ) expect_error( precision_profile(cv_data, concentration = "concentration", cv = "cv_pct", cv_targets = c(10, 150)), "cv_targets" ) }) test_that("precision_profile validates boot_n", { cv_data <- create_cv_data() expect_error( precision_profile(cv_data, concentration = "concentration", cv = "cv_pct", bootstrap = TRUE, boot_n = 50), "boot_n" ) }) # Data Frame Interface Tests ---- test_that("precision_profile works with data frame input", { cv_data <- create_cv_data() result <- precision_profile( cv_data, concentration = "concentration", cv = "cv_pct" ) expect_s3_class(result, "precision_profile") expect_s3_class(result, "valytics_precision") expect_s3_class(result, "valytics_result") }) test_that("precision_profile returns expected structure", { cv_data <- create_cv_data() result <- precision_profile( cv_data, concentration = "concentration", cv = "cv_pct" ) # Check top-level components expect_named(result, c("input", "model", "fitted", "fit_quality", "functional_sensitivity", "settings", "call")) # Check input expect_true("concentration" %in% names(result$input)) expect_true("cv" %in% names(result$input)) expect_true("n_levels" %in% names(result$input)) expect_true("conc_range" %in% names(result$input)) expect_true("conc_span" %in% names(result$input)) # Check model expect_true("type" %in% names(result$model)) expect_true("parameters" %in% names(result$model)) expect_true("equation" %in% names(result$model)) # Check fitted expect_s3_class(result$fitted, "data.frame") expect_true(all(c("concentration", "cv_observed", "cv_fitted", "residual") %in% names(result$fitted))) # Check fit_quality expect_true("r_squared" %in% names(result$fit_quality)) expect_true("rmse" %in% names(result$fit_quality)) # Check functional_sensitivity expect_s3_class(result$functional_sensitivity, "data.frame") expect_true(all(c("cv_target", "concentration", "achievable") %in% names(result$functional_sensitivity))) }) # Hyperbolic Model Tests ---- test_that("precision_profile fits hyperbolic model correctly", { cv_data <- create_cv_data() result <- precision_profile( cv_data, concentration = "concentration", cv = "cv_pct", model = "hyperbolic" ) expect_equal(result$model$type, "hyperbolic") expect_true("a" %in% names(result$model$parameters)) expect_true("b" %in% names(result$model$parameters)) expect_true(grepl("sqrt", result$model$equation)) }) test_that("hyperbolic model parameters are reasonable", { # Create data with known parameters: CV = sqrt(3^2 + (20/x)^2) set.seed(123) conc <- c(5, 10, 25, 50, 100, 200) true_cv <- sqrt(3^2 + (20/conc)^2) cv_data <- data.frame(concentration = conc, cv_pct = true_cv + rnorm(6, 0, 0.1)) result <- precision_profile( cv_data, concentration = "concentration", cv = "cv_pct", model = "hyperbolic" ) # Parameters should be close to true values (a=3, b=20) expect_true(abs(result$model$parameters["a"] - 3) < 1) expect_true(abs(result$model$parameters["b"] - 20) < 5) }) test_that("hyperbolic model R-squared is reasonable for good fit", { # Create data with known relationship conc <- c(5, 10, 25, 50, 100, 200) true_cv <- sqrt(3^2 + (20/conc)^2) cv_data <- data.frame(concentration = conc, cv_pct = true_cv) result <- precision_profile( cv_data, concentration = "concentration", cv = "cv_pct", model = "hyperbolic" ) # R-squared should be very high for perfect fit expect_true(result$fit_quality$r_squared > 0.99) }) # Linear Model Tests ---- test_that("precision_profile fits linear model correctly", { cv_data <- create_cv_data() result <- precision_profile( cv_data, concentration = "concentration", cv = "cv_pct", model = "linear" ) expect_equal(result$model$type, "linear") expect_true("a" %in% names(result$model$parameters)) expect_true("b" %in% names(result$model$parameters)) expect_false(grepl("sqrt", result$model$equation)) }) test_that("linear model equation format is correct", { cv_data <- create_cv_data() result <- precision_profile( cv_data, concentration = "concentration", cv = "cv_pct", model = "linear" ) # Equation should be of form "CV = a + b/x" expect_true(grepl("/x", result$model$equation)) }) # Functional Sensitivity Tests ---- test_that("functional sensitivity is calculated for specified targets", { cv_data <- create_cv_data() result <- precision_profile( cv_data, concentration = "concentration", cv = "cv_pct", cv_targets = c(5, 10, 20) ) expect_equal(nrow(result$functional_sensitivity), 3) expect_equal(result$functional_sensitivity$cv_target, c(5, 10, 20)) }) test_that("functional sensitivity marks unachievable targets", { # Create data with asymptotic CV around 3% conc <- c(5, 10, 25, 50, 100, 200) cv <- sqrt(3^2 + (20/conc)^2) cv_data <- data.frame(concentration = conc, cv_pct = cv) result <- precision_profile( cv_data, concentration = "concentration", cv = "cv_pct", model = "hyperbolic", cv_targets = c(2, 5, 10) # 2% is below asymptotic CV of 3% ) # CV target of 2% should not be achievable (asymptotic is ~3%) expect_false(result$functional_sensitivity$achievable[ result$functional_sensitivity$cv_target == 2]) # CV targets of 5% and 10% should be achievable expect_true(result$functional_sensitivity$achievable[ result$functional_sensitivity$cv_target == 5]) expect_true(result$functional_sensitivity$achievable[ result$functional_sensitivity$cv_target == 10]) }) test_that("functional sensitivity concentration decreases with higher CV target", { cv_data <- create_cv_data() result <- precision_profile( cv_data, concentration = "concentration", cv = "cv_pct", cv_targets = c(4, 6, 8, 10) ) # Higher CV target should give lower concentration (functional sensitivity) fs <- result$functional_sensitivity achievable_conc <- fs$concentration[fs$achievable] if (length(achievable_conc) > 1) { # Concentrations should decrease as CV target increases expect_true(all(diff(achievable_conc) <= 0) || any(is.na(achievable_conc))) } }) # Bootstrap Tests ---- test_that("bootstrap produces confidence intervals for functional sensitivity", { skip_on_cran() # Skip slow test on CRAN cv_data <- create_cv_data() result <- precision_profile( cv_data, concentration = "concentration", cv = "cv_pct", cv_targets = c(10, 20), bootstrap = TRUE, boot_n = 199 # Reduced for faster testing ) # Check that CIs are present for achievable targets fs <- result$functional_sensitivity for (i in seq_len(nrow(fs))) { if (fs$achievable[i]) { expect_false(is.na(fs$ci_lower[i])) expect_false(is.na(fs$ci_upper[i])) expect_true(fs$ci_lower[i] <= fs$concentration[i]) expect_true(fs$ci_upper[i] >= fs$concentration[i]) } } }) test_that("bootstrap CIs are not present when bootstrap=FALSE", { cv_data <- create_cv_data() result <- precision_profile( cv_data, concentration = "concentration", cv = "cv_pct", cv_targets = c(10, 20), bootstrap = FALSE ) # CIs should be NA when bootstrap is not used expect_true(all(is.na(result$functional_sensitivity$ci_lower))) expect_true(all(is.na(result$functional_sensitivity$ci_upper))) }) # Fitted Values Tests ---- test_that("fitted values have correct length", { cv_data <- create_cv_data() result <- precision_profile( cv_data, concentration = "concentration", cv = "cv_pct" ) expect_equal(nrow(result$fitted), nrow(cv_data)) }) test_that("residuals are calculated correctly", { cv_data <- create_cv_data() result <- precision_profile( cv_data, concentration = "concentration", cv = "cv_pct" ) # Residuals should be observed - fitted expected_residuals <- result$fitted$cv_observed - result$fitted$cv_fitted expect_equal(result$fitted$residual, expected_residuals) }) test_that("prediction intervals contain observed values", { cv_data <- create_cv_data() result <- precision_profile( cv_data, concentration = "concentration", cv = "cv_pct", conf_level = 0.95 ) # Most observations should be within prediction intervals within_ci <- result$fitted$cv_observed >= result$fitted$ci_lower & result$fitted$cv_observed <= result$fitted$ci_upper # At least 80% should be within 95% CI (allowing for small samples) expect_true(mean(within_ci) >= 0.5) }) # Concentration Span Warning ---- test_that("precision_profile warns about narrow concentration span", { # Create data with only 1.5-fold span cv_data <- data.frame( concentration = c(100, 110, 120, 150), cv_pct = c(3.5, 3.4, 3.3, 3.2) ) expect_warning( precision_profile(cv_data, concentration = "concentration", cv = "cv_pct"), "span" ) }) # Fit Quality Tests ---- test_that("fit quality metrics are calculated correctly", { cv_data <- create_cv_data() result <- precision_profile( cv_data, concentration = "concentration", cv = "cv_pct" ) # R-squared should be between 0 and 1 expect_true(result$fit_quality$r_squared >= 0) expect_true(result$fit_quality$r_squared <= 1) # RMSE should be non-negative expect_true(result$fit_quality$rmse >= 0) # MAE should be non-negative expect_true(result$fit_quality$mae >= 0) # Adjusted R-squared should be less than or equal to R-squared expect_true(result$fit_quality$adj_r_squared <= result$fit_quality$r_squared) }) # Print Method Tests ---- test_that("print.precision_profile runs without error", { cv_data <- create_cv_data() result <- precision_profile( cv_data, concentration = "concentration", cv = "cv_pct" ) expect_output(print(result), "Precision Profile") expect_output(print(result), "Model:") expect_output(print(result), "Functional Sensitivity") }) test_that("print.precision_profile shows model equation", { cv_data <- create_cv_data() result <- precision_profile( cv_data, concentration = "concentration", cv = "cv_pct" ) expect_output(print(result), "CV =") }) # Summary Method Tests ---- test_that("summary.precision_profile runs without error", { cv_data <- create_cv_data() result <- precision_profile( cv_data, concentration = "concentration", cv = "cv_pct" ) expect_output(summary(result), "Detailed Summary") expect_output(summary(result), "Fit Quality") expect_output(summary(result), "Fitted Values") expect_output(summary(result), "Functional Sensitivity") }) # Plot Method Tests ---- test_that("plot.precision_profile returns ggplot object", { skip_if_not_installed("ggplot2") cv_data <- create_cv_data() result <- precision_profile( cv_data, concentration = "concentration", cv = "cv_pct" ) p <- plot(result) expect_s3_class(p, "ggplot") }) test_that("plot.precision_profile works without CI", { skip_if_not_installed("ggplot2") cv_data <- create_cv_data() result <- precision_profile( cv_data, concentration = "concentration", cv = "cv_pct" ) p <- plot(result, show_ci = FALSE) expect_s3_class(p, "ggplot") }) test_that("plot.precision_profile works without target lines", { skip_if_not_installed("ggplot2") cv_data <- create_cv_data() result <- precision_profile( cv_data, concentration = "concentration", cv = "cv_pct" ) p <- plot(result, show_targets = FALSE) expect_s3_class(p, "ggplot") }) test_that("plot.precision_profile works with log scale", { skip_if_not_installed("ggplot2") cv_data <- create_cv_data() result <- precision_profile( cv_data, concentration = "concentration", cv = "cv_pct" ) p <- plot(result, log_x = TRUE) expect_s3_class(p, "ggplot") }) test_that("autoplot.precision_profile works", { skip_if_not_installed("ggplot2") cv_data <- create_cv_data() result <- precision_profile( cv_data, concentration = "concentration", cv = "cv_pct" ) p <- ggplot2::autoplot(result) expect_s3_class(p, "ggplot") }) # Column Name Validation Tests ---- test_that("precision_profile validates concentration column name", { cv_data <- create_cv_data() expect_error( precision_profile(cv_data, concentration = "wrong_name", cv = "cv_pct"), "not found" ) }) test_that("precision_profile validates cv column name", { cv_data <- create_cv_data() expect_error( precision_profile(cv_data, concentration = "concentration", cv = "wrong_name"), "not found" ) }) # Invalid Input Type Tests ---- test_that("precision_profile rejects invalid input type", { expect_error( precision_profile(1:10), "precision_study object|data frame" ) expect_error( precision_profile("not_valid"), "precision_study object|data frame" ) }) # Precision Study Object Input Tests ---- test_that("precision_profile rejects precision_study with insufficient levels", { # Mock a precision_study object with only 2 levels mock_prec <- structure( list( by_sample = list( level1 = list(precision = data.frame(measure = "Repeatability", cv_pct = 5)), level2 = list(precision = data.frame(measure = "Repeatability", cv_pct = 4)) ), sample_means = c(level1 = 10, level2 = 50) ), class = c("precision_study", "valytics_precision", "valytics_result") ) expect_error( precision_profile(mock_prec), "at least 4 concentration levels" ) }) test_that("precision_profile rejects single-sample precision_study", { # Mock a precision_study object with no by_sample mock_prec <- structure( list( by_sample = NULL, sample_means = NULL ), class = c("precision_study", "valytics_precision", "valytics_result") ) expect_error( precision_profile(mock_prec), "at least 4 concentration levels" ) }) test_that("precision_profile works with valid precision_study object", { # Mock a precision_study object with 5 levels mock_prec <- structure( list( by_sample = list( level1 = list(precision = data.frame( measure = c("Repeatability", "Within-laboratory precision"), cv_pct = c(6, 6.5) )), level2 = list(precision = data.frame( measure = c("Repeatability", "Within-laboratory precision"), cv_pct = c(4.5, 5) )), level3 = list(precision = data.frame( measure = c("Repeatability", "Within-laboratory precision"), cv_pct = c(3.8, 4.2) )), level4 = list(precision = data.frame( measure = c("Repeatability", "Within-laboratory precision"), cv_pct = c(3.3, 3.7) )), level5 = list(precision = data.frame( measure = c("Repeatability", "Within-laboratory precision"), cv_pct = c(3.1, 3.4) )) ), sample_means = c(level1 = 10, level2 = 25, level3 = 50, level4 = 100, level5 = 200) ), class = c("precision_study", "valytics_precision", "valytics_result") ) result <- precision_profile(mock_prec) expect_s3_class(result, "precision_profile") expect_equal(result$input$n_levels, 5) }) test_that("precision_profile extracts Within-laboratory precision CV from precision_study", { # Mock a precision_study object - should prefer Within-laboratory precision mock_prec <- structure( list( by_sample = list( level1 = list(precision = data.frame( measure = c("Repeatability", "Within-laboratory precision"), cv_pct = c(5, 7) # Within-lab (7) should be used )), level2 = list(precision = data.frame( measure = c("Repeatability", "Within-laboratory precision"), cv_pct = c(4, 5.5) )), level3 = list(precision = data.frame( measure = c("Repeatability", "Within-laboratory precision"), cv_pct = c(3.5, 4.5) )), level4 = list(precision = data.frame( measure = c("Repeatability", "Within-laboratory precision"), cv_pct = c(3, 3.8) )) ), sample_means = c(level1 = 10, level2 = 25, level3 = 50, level4 = 100) ), class = c("precision_study", "valytics_precision", "valytics_result") ) result <- precision_profile(mock_prec) # Should have used Within-laboratory precision CVs (7, 5.5, 4.5, 3.8) expect_equal(result$input$cv[1], 7) expect_equal(result$input$cv[4], 3.8) }) test_that("precision_profile falls back to Repeatability when no Within-lab precision", { # Mock a precision_study object with only Repeatability mock_prec <- structure( list( by_sample = list( level1 = list(precision = data.frame( measure = c("Repeatability"), cv_pct = c(5) )), level2 = list(precision = data.frame( measure = c("Repeatability"), cv_pct = c(4) )), level3 = list(precision = data.frame( measure = c("Repeatability"), cv_pct = c(3.5) )), level4 = list(precision = data.frame( measure = c("Repeatability"), cv_pct = c(3) )) ), sample_means = c(level1 = 10, level2 = 25, level3 = 50, level4 = 100) ), class = c("precision_study", "valytics_precision", "valytics_result") ) result <- precision_profile(mock_prec) # Should have used Repeatability CVs expect_equal(result$input$cv[1], 5) expect_equal(result$input$cv[4], 3) }) # Settings Preservation Tests ---- test_that("settings are preserved in result object", { cv_data <- create_cv_data() result <- precision_profile( cv_data, concentration = "concentration", cv = "cv_pct", conf_level = 0.90, bootstrap = TRUE, boot_n = 199 ) expect_equal(result$settings$conf_level, 0.90) expect_true(result$settings$bootstrap) expect_equal(result$settings$boot_n, 199) }) test_that("boot_n is NA when bootstrap=FALSE", { cv_data <- create_cv_data() result <- precision_profile( cv_data, concentration = "concentration", cv = "cv_pct", bootstrap = FALSE ) expect_true(is.na(result$settings$boot_n)) })