perf_df_untidy <- structure(list(cv_metric_AUC = c(
0.626118719362745, 0.631857444852941,
0.660083976715686, 0.638769209558824, 0.657143321078431
), logLoss = c(
0.686781644602582,
0.683505908139307, 0.687957870274247, 0.688183575172013, 0.688869161857159
), AUC = c(
0.634210526315789, 0.652631578947368, 0.589473684210526,
0.573684210526316, 0.586842105263158
), prAUC = c(
0.565824790303497,
0.61663092781822, 0.545144586653095, 0.555803529302002, 0.533415969473769
), Accuracy = c(
0.615384615384615, 0.58974358974359, 0.615384615384615,
0.512820512820513, 0.641025641025641
), Kappa = c(
0.225165562913907,
0.168, 0.22103861517976, 0.0159362549800795, 0.275862068965517
), F1 = c(
0.666666666666667, 0.68, 0.693877551020408, 0.595744680851064,
0.695652173913043
), Sensitivity = c(0.75, 0.85, 0.85, 0.7, 0.8), Specificity = c(
0.473684210526316, 0.315789473684211, 0.368421052631579,
0.315789473684211, 0.473684210526316
), Pos_Pred_Value = c(
0.6,
0.566666666666667, 0.586206896551724, 0.518518518518518, 0.615384615384615
), Neg_Pred_Value = c(
0.642857142857143, 0.666666666666667, 0.7,
0.5, 0.692307692307692
), Precision = c(
0.6, 0.566666666666667,
0.586206896551724, 0.518518518518518, 0.615384615384615
), Recall = c(
0.75,
0.85, 0.85, 0.7, 0.8
), Detection_Rate = c(
0.384615384615385,
0.435897435897436, 0.435897435897436, 0.358974358974359, 0.41025641025641
), Balanced_Accuracy = c(
0.611842105263158, 0.582894736842105,
0.609210526315789, 0.507894736842105, 0.636842105263158
), method = c(
"glmnet",
"glmnet", "glmnet", "glmnet", "glmnet"
), seed = c(
100, 101, 102,
103, 104
)), row.names = c(NA, -5L), class = c("tbl_df", "tbl", "data.frame"))
perf_df_tidy <- dplyr::tibble(
method = c(
"glmnet", "glmnet", "glmnet", "glmnet",
"glmnet", "glmnet", "glmnet", "glmnet", "glmnet", "glmnet"
),
metric = c(
"CV AUC", "Test AUC", "CV AUC", "Test AUC", "CV AUC",
"Test AUC", "CV AUC", "Test AUC", "CV AUC", "Test AUC"
),
value = c(
0.626118719362745, 0.634210526315789, 0.631857444852941,
0.652631578947368, 0.660083976715686, 0.589473684210526,
0.638769209558824, 0.573684210526316, 0.657143321078431,
0.586842105263158
)
)
test_that("tidy_perf_data works", {
expect_equal(tidy_perf_data(perf_df_untidy), perf_df_tidy)
})
test_that("plot_model_performance creates a boxplot from tidied data", {
p <- perf_df_untidy %>% plot_model_performance()
expect_invisible(print(p))
expect_equal(p$data, perf_df_untidy %>% tidy_perf_data())
expect_equal(
p$layers[[1]]$geom %>% class() %>% as.vector(),
c("GeomBoxplot", "Geom", "ggproto", "gg")
)
})
test_that("get_hp_performance works", {
expect_equal(
get_hp_performance(otu_mini_bin_results_glmnet$trained_model),
list(dat = structure(list(
alpha = c(0L, 0L, 0L, 0L, 0L, 0L),
lambda = c(1e-04, 0.001, 0.01, 0.1, 1, 10), AUC = c(
0.608255208333333,
0.608255208333333, 0.608645833333333, 0.616678921568627,
0.622173713235294, 0.618740808823529
)
), row.names = c(
NA,
6L
), class = "data.frame"), params = "lambda", metric = "AUC")
)
})
test_that("combine_hp_performance works", {
expect_equal(
combine_hp_performance(list(otu_mini_bin_results_glmnet$trained_model, otu_mini_bin_results_glmnet$trained_model)),
list(dat = structure(list(alpha = c(
0L, 0L, 0L, 0L, 0L, 0L, 0L,
0L, 0L, 0L, 0L, 0L
), lambda = c(
1e-04, 0.001, 0.01, 0.1, 1, 10,
1e-04, 0.001, 0.01, 0.1, 1, 10
), AUC = c(
0.608255208333333, 0.608255208333333,
0.608645833333333, 0.616678921568627, 0.622173713235294, 0.618740808823529,
0.608255208333333, 0.608255208333333, 0.608645833333333, 0.616678921568627,
0.622173713235294, 0.618740808823529
)), row.names = c(NA, -12L), class = "data.frame"), params = "lambda", metric = "AUC")
)
})
test_that("plot_mean_roc uses geom ribbon, line, and abline", {
sensspec_roc <- readRDS(testthat::test_path("fixtures", "sensspec_roc.Rds"))
p_roc <- sensspec_roc %>% plot_mean_roc()
expect_equal(p_roc$data, sensspec_roc)
expect_equal(
sapply(
p_roc$layers,
function(x) {
return(x$geom %>% class() %>% as.vector())
}
) %>%
unlist(),
c(
"GeomRibbon", "Geom", "ggproto", "gg", "GeomLine", "GeomPath",
"Geom", "ggproto", "gg", "GeomAbline", "Geom", "ggproto", "gg"
)
)
})
test_that("plot_mean_prc uses geom ribbon, line, and hline", {
sensspec_prc <- readRDS(testthat::test_path("fixtures", "sensspec_prc.Rds"))
p_prc <- sensspec_prc %>% plot_mean_prc(baseline_precision = 0.49)
expect_equal(p_prc$data, sensspec_prc)
expect_equal(
sapply(
p_prc$layers,
function(x) {
return(x$geom %>% class() %>% as.vector())
}
) %>%
unlist(),
c(
"GeomRibbon", "Geom", "ggproto", "gg", "GeomLine", "GeomPath",
"Geom", "ggproto", "gg", "GeomHline", "Geom", "ggproto", "gg"
)
)
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.