diff --git a/DESCRIPTION b/DESCRIPTION index eafaf98..3f601a1 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -2,7 +2,7 @@ Type: Package Package: BayesianReasoning Title: Plot Positive and Negative Predictive Values for Medical Tests Version: 0.4.2 -Date: 2022-09-06 +Date: 2023-11-13 Authors@R: person("Gorka", "Navarrete", , "gorkang@gmail.com", role = c("aut", "cre"), comment = c(ORCID = "0000-0001-7678-8656")) @@ -22,10 +22,14 @@ Depends: Imports: cli, dplyr, - ggforce, + ggforce (>= 0.4.0), ggplot2, + ggtext, + gt, magrittr, + png, reshape2, + scales, stats, tibble, tidyr @@ -37,10 +41,11 @@ Suggests: purrr, rmarkdown, testthat (>= 3.0.0), - vdiffr + vdiffr, + webshot2 VignetteBuilder: knitr Encoding: UTF-8 LazyData: FALSE -RoxygenNote: 7.2.1 +RoxygenNote: 7.2.3 Config/testthat/edition: 3 diff --git a/NAMESPACE b/NAMESPACE index 7b1fea3..9850327 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -4,6 +4,8 @@ export("%>%") export(PPV_diagnostic_vs_screening) export(PPV_heatmap) export(min_possible_prevalence) +export(plot_cutoff) +export(remove_layers_cutoff_plot) importFrom(cli,cli_alert_info) importFrom(dplyr,filter) importFrom(dplyr,mutate) @@ -15,6 +17,7 @@ importFrom(ggplot2,element_text) importFrom(ggplot2,geom_line) importFrom(ggplot2,geom_tile) importFrom(ggplot2,ggplot) +importFrom(ggplot2,ggplot_build) importFrom(ggplot2,ggsave) importFrom(ggplot2,labs) importFrom(ggplot2,layer_scales) @@ -25,8 +28,19 @@ importFrom(ggplot2,scale_x_continuous) importFrom(ggplot2,scale_y_continuous) importFrom(ggplot2,theme) importFrom(ggplot2,theme_minimal) +importFrom(ggtext,element_markdown) +importFrom(gt,cell_text) +importFrom(gt,cells_column_labels) +importFrom(gt,cols_align) +importFrom(gt,cols_label) +importFrom(gt,fmt_markdown) +importFrom(gt,gt) +importFrom(gt,tab_style) importFrom(magrittr,"%>%") +importFrom(png,readPNG) importFrom(reshape2,melt) +importFrom(scales,comma) +importFrom(stats,rnorm) importFrom(stats,var) importFrom(tibble,as_tibble) importFrom(tidyr,gather) diff --git a/NEWS.md b/NEWS.md index 4b2ed89..4b14343 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,19 @@ +# BayesianReasoning 0.4.2 + +Major updates + +* New plot_cutoff() + + Shows healthy and sick distributions and shows FP, FN, TP and TN depending on a cutoff point +* New remove_layers_cutoff_plot() functions + + Get's rid of layers of a cutoff_plot: FP, FN, TP or TN + +Minor updates + +* Fix for CRAN change in docType +* Use linewidth instead of size +* Faster implementation of a step in min_possible_prevalence + + # BayesianReasoning 0.4.1 Minor updates diff --git a/R/globals.R b/R/globals.R index 46e826f..223d196 100644 --- a/R/globals.R +++ b/R/globals.R @@ -1,3 +1,4 @@ # https://community.rstudio.com/t/how-to-solve-no-visible-binding-for-global-variable-note/28887 # https://www.r-bloggers.com/2019/08/no-visible-binding-for-global-variable/ -utils::globalVariables(c("prevalence_1", "prevalence_2", "prevalence_pct", "FP", "NPV", "PPV", "Prevalence", "FN", "value", "prevalence", "sensitivity", "specificity")) +utils::globalVariables(c("prevalence_1", "prevalence_2", "prevalence_pct", "FP", "NPV", "PPV", "Prevalence", "FN", "value", "prevalence", "sensitivity", "specificity", + "N", "classification", "fill_str", "test_result", "type")) diff --git a/R/plot_cutoff.R b/R/plot_cutoff.R new file mode 100644 index 0000000..b5a4472 --- /dev/null +++ b/R/plot_cutoff.R @@ -0,0 +1,359 @@ +#' plot_cutoff +#' Create a cutoff plot, showing the healthy and sick distributions, and the +#' consequences of different cutoff points +#' +#' @param prevalence prevalence of the disease +#' @param cutoff_point cutoff point to use +#' @param mean_sick mean for the sick people distribution +#' @param mean_healthy mean for the healthy people distribution +#' @param sd_sick sd for the sick people distribution +#' @param sd_healthy sd for the healthy people distribution +#' @param n_people number of people to use +#' @param add_table FALSE/TRUE: add gt table with Sensitivity, Specificity, etc. +#' @param output_filename NULL. If a filename, will save the plot +#' +#' @return A list with plots and table +#' @export +#' @importFrom stats rnorm +#' @importFrom ggtext element_markdown +#' @importFrom gt gt cell_text cells_column_labels cols_align cols_label fmt_markdown tab_style +#' @importFrom png readPNG +#' @importFrom scales comma +#' @importFrom ggplot2 ggplot_build +#' +#' @examples +#' \dontrun{ +#' plot_cutoff(prevalence = 0.2) +#' } +plot_cutoff <- function(prevalence = 0.1, + cutoff_point = 30, + mean_sick = 35, + mean_healthy = 20, + sd_sick = 3, + sd_healthy = 5, + n_people = 100000, + add_table = FALSE, + output_filename = NULL) { + + + # DEBUG + # prevalence = 0.1 + # cutoff_point = 40 + # mean_sick = 35 + # mean_healthy = 20 + # sd_sick = 3 + # sd_healthy = 5 + # n_people = 100000 + # output_filename = NULL + + SEED = 10 + + # How many sick & healthy + n_healthy = (1 - prevalence) * n_people + n_sick = prevalence * n_people + + # Checks + if (n_people >= 10^7) cli::cli_alert_warning("Lots of observations. Will take a few seconds to create the plot. Lower the n_people ({n_people})") + if (prevalence < 0.005) cli::cli_alert_warning("With prevalence this low, you will hardly see the sick distribution ({prevalence})") + + + + # Colors ------------------------------------------------------------------ + + # Base 16 (0123456789abcdef), from 00 (lower) to ff (higher) + DF_colors = tibble::tibble( + classification = c("TN", "FP", "FN", "TP"), + fill_str = c("#00000040", "#990ff7ff", "#000000ee", "#990ff740") + ) + + color_TN = DF_colors[DF_colors$classification == "TN",]$fill_str + color_FP = DF_colors[DF_colors$classification == "FP",]$fill_str + color_FN = DF_colors[DF_colors$classification == "FN",]$fill_str + color_TP = DF_colors[DF_colors$classification == "TP",]$fill_str + + # Formatted names for title + TP_title = paste0("True Positives") + FN_title = paste0("False Negatives") + FP_title = paste0("False Positives") + TN_title = paste0("True Negatives") + + + + + # Create distributions ---------------------------------------------------- + + set.seed(SEED) + data_sick = round(rnorm(n_sick, mean = mean_sick , sd = sd_sick)) + set.seed(SEED) + data_healthy = round(rnorm(n_healthy, mean = mean_healthy , sd = sd_healthy)) + + + DF = tibble::tibble(type = c(rep("healthy", n_healthy), rep("sick", n_sick)), + test_result = c(data_healthy, data_sick)) |> + dplyr::mutate(test_result_dico = ifelse(test_result >= cutoff_point, "positive", "negative")) |> + dplyr::mutate(classification = + dplyr::case_when( + type == "healthy" & test_result_dico == "negative" ~ "TN", + type == "healthy" & test_result_dico == "positive" ~ "FP", + type == "sick" & test_result_dico == "negative" ~ "FN", + type == "sick" & test_result_dico == "positive" ~ "TP", + ), + fill_str = + dplyr::case_when( + classification == "TN" ~ color_TN, + classification == "FP" ~ color_FP, + classification == "FN" ~ color_FN, + classification == "TP" ~ color_TP, + )) + + + # Table ------------------------------------------------------------------- + + DF_table_raw1 = DF |> + dplyr::group_by(classification) |> + dplyr::summarise(N = dplyr::n(), .groups = "drop") + + table_template = tibble::tibble(TN = 0, FP = 0, FN = 0, TP = 0) + + DF_table_raw2 = + DF_table_raw1 |> + tidyr::pivot_wider(names_from = classification, values_from = N) + + DF_table = + DF_table_raw2 |> + # Add columns if they do not exist (e.g. when 0 FP) + tibble::add_column(!!!table_template[setdiff(names(table_template), names(DF_table_raw2))]) |> + # Calculate + dplyr::mutate(Sensitivity = TP/ (TP + FN), + Specificity = TN / (TN + FP), + PPV = TP / (TP + FP), + NPV = TN / (TN + FN), + Prevalence = prevalence) + + + # Formatted cells for table + TP = paste0("TP", "
", format(DF_table$TP, big.mark = ",", scientific = FALSE)) + FN = paste0("FN", "
", format(DF_table$FN, big.mark = ",", scientific = FALSE)) + FP = paste0("FP", "
", format(DF_table$FP, big.mark = ",", scientific = FALSE)) + TN = paste0("TN", "
", format(DF_table$TN, big.mark = ",", scientific = FALSE)) + Sensitivity = paste0("**Sensitivity**
", round(DF_table$Sensitivity, 3) * 100, "%") + Specificity = paste0("**Specificity**
", round(DF_table$Specificity, 3) * 100, "%") + PPV = paste0("**PPV**
", round(DF_table$PPV, 3) * 100, "%") + NPV = paste0("**NPV**
", round(DF_table$NPV, 3) * 100, "%") + + + TABLE_raw = tibble::tibble(X = c("**test +**", "**test -**", ""), + `Sick` = c(TP, FN, Sensitivity), + `Healthy` = c(FP, TN, Specificity), + Y = c(PPV, NPV, "")) + + TABLE_gt = + TABLE_raw |> + gt::gt() |> + gt::fmt_markdown(dplyr::everything()) |> + gt::cols_align(align = "center") |> + gt::cols_label(X = "", Y= "") |> + gt::tab_style( + style = gt::cell_text(weight = "bold"), + locations = gt::cells_column_labels() + ) + + + + # Initial Plot --------------------------------------------------------------- + + # Number of individual bins + bins_histogram = max(DF$test_result) - min(DF$test_result) + binwidth = 1 + + # Base plot + plot = + DF |> + ggplot2::ggplot(ggplot2::aes(test_result)) + + + # Histograms + ggplot2::geom_histogram(data = subset(DF, classification == 'TN'), ggplot2::aes(fill = fill_str), bins = bins_histogram, binwidth = 1, show.legend = FALSE) + + ggplot2::geom_histogram(data = subset(DF, classification == 'TP'), ggplot2::aes(fill = fill_str), bins = bins_histogram, binwidth = 1, show.legend = FALSE) + + ggplot2::geom_histogram(data = subset(DF, classification == 'FN'), ggplot2::aes(fill = fill_str), bins = bins_histogram, binwidth = 1, show.legend = FALSE) + + ggplot2::geom_histogram(data = subset(DF, classification == 'FP'), ggplot2::aes(fill = fill_str), bins = bins_histogram, binwidth = 1, show.legend = FALSE) + + + # Outlines (healthy, sick) + # stat_bin(data = subset(DF, classification %in% c('FN', 'TP')), geom = "step", direction = "mid", aes(linetype = type), binwidth = binwidth, show.legend = FALSE) + + # stat_bin(data = subset(DF, classification %in% c('TN', 'FP')), geom = "step", direction = "mid", aes(linetype = type), binwidth = binwidth, show.legend = FALSE) + + ggplot2::stat_bin(data = subset(DF, classification %in% c('TN')), geom = "step", direction = "mid", ggplot2::aes(linetype = type), binwidth = binwidth, show.legend = FALSE) + + ggplot2::stat_bin(data = subset(DF, classification %in% c('TP')), geom = "step", direction = "mid", ggplot2::aes(linetype = type), binwidth = binwidth, show.legend = FALSE) + + ggplot2::stat_bin(data = subset(DF, classification %in% c('FN')), geom = "step", direction = "mid", ggplot2::aes(linetype = type), binwidth = binwidth, show.legend = FALSE) + + ggplot2::stat_bin(data = subset(DF, classification %in% c('FP')), geom = "step", direction = "mid", ggplot2::aes(linetype = type), binwidth = binwidth, show.legend = FALSE) + + + + ggplot2::geom_vline(xintercept = cutoff_point - 0.5, linetype = "dashed") + + ggplot2::theme_minimal(base_size = 14) + + ggplot2::labs(caption = paste0(format(n_people, big.mark = ",", scientific = FALSE), " people, ", "prevalence 1 out of ", 1/DF_table$Prevalence, "\n", + format(n_sick, big.mark = ",", scientific = FALSE), " sick (M = ", mean_sick, ", SD = ", sd_sick, ")\n", + format(n_healthy, big.mark = ",", scientific = FALSE) , " healthy (M = ", mean_healthy, ", SD = ", sd_healthy, ")" + # "Sensitivity = ", round(DF_table$Sensitivity * 100, 0), "% Specificity = ", round(DF_table$Specificity * 100, 0), "% \n", + # "PPV = ", round(DF_table$PPV * 100, 0), "% NPV = ", round(DF_table$NPV * 100, 0), "%" + )) + + ggplot2::theme(legend.position = "top") + + ggplot2::scale_fill_identity() + + + # Max values for healthy and sick ----------------------------------------- + + ggplot_layout = ggplot2::ggplot_build(plot)$layout + ggplot_data = ggplot2::ggplot_build(plot)$data + + data_1 = ggplot_data[[1]][which.max(ggplot_data[[1]]$count),] + data_2 = ggplot_data[[2]][which.max(ggplot_data[[2]]$count),] + data_3 = ggplot_data[[3]][which.max(ggplot_data[[3]]$count),] + data_4 = ggplot_data[[4]][which.max(ggplot_data[[4]]$count),] + + max_counts = rbind(data_1, data_2, data_3, data_4) |> + dplyr::left_join(DF_colors, by = c("fill" = "fill_str")) + + range_x = ggplot_layout$panel_params[[1]]$x.range + + # Looking for the max value in the healthy or sick histograms + max_count_healthy = max(max_counts[max_counts$classification %in% c("TN", "FP"), "count"]) + max_count_sick = max(max_counts[max_counts$classification %in% c("TP", "FN"), "count"]) + + TN_x = max(max_counts[max_counts$classification %in% c("TN"), "x"]) + FN_x = max(max_counts[max_counts$classification %in% c("FN"), "x"]) + FP_x = max(max_counts[max_counts$classification %in% c("FP"), "x"]) + TP_x = max(max_counts[max_counts$classification %in% c("TP"), "x"]) + + + if (FP_x == TP_x) TP_x = TP_x * 1.05 + if (FN_x == TN_x) TN_x = TN_x * .95 + + + # Plot annotations -------------------------------------------------------- + + final_plot = + plot + + ggplot2::annotate(x = cutoff_point -.5, y = max_count_healthy *.95, label = "Cutoff point", vjust = 2, geom = "text", angle = 90) + + # annotate(x = mean_healthy, y = max_count_healthy / 2, label = "Healthy", vjust = 2, geom = "text") + + # annotate(x = mean_sick, y = max_count_sick / 2, label = "Sick", vjust = 2, geom = "text", color = "white") + + + # Sick / Healthy + ggplot2::annotate(x = mean_healthy, y = max_count_healthy, label = "Healthy", vjust = -1, geom = "text", color = "#000000") + + ggplot2::annotate(x = mean_sick, y = max_count_sick, label = "Sick", vjust = -1, geom = "text", color = "#222222") + + + # TN / FN / FP / TP + ggplot2::annotate(x = TN_x, y = 0, label = "TN", vjust = 2, geom = "text", color = color_TN) + + ggplot2::annotate(x = FN_x, y = 0, label = "FN", vjust = 2, geom = "text", color = color_FN) + + ggplot2::annotate(x = FP_x, y = 0, label = "FP", vjust = 2, geom = "text", color = color_FP) + + ggplot2::annotate(x = TP_x, y = 0, label = "TP", vjust = 2, geom = "text", color = color_TP) + + + ggplot2::labs(x = NULL, + y = NULL, + title = paste0(TP_title, ", ", FN_title, ", ", FP_title, ", ",TN_title), + subtitle = "Depending on a Cutoff point

") + + ggplot2::theme(plot.title = ggtext::element_markdown(), + plot.subtitle = ggtext::element_markdown()) + + ggplot2::scale_y_continuous(labels = scales::comma) + + + # Combine table and plot -------------------------------------------------- + + if (add_table == TRUE) { + + # Save and read image + name_file = paste0(tempfile(), ".png") + TABLE_gt |> gt::gtsave(name_file, quiet = TRUE) + grob_table <- grid::rasterGrob(png::readPNG(name_file), interpolate=TRUE) + + # Add image of gt table to plot + final_plot = + final_plot + + ggplot2::annotation_custom( + grob_table, + # xmin = min(range_x), + xmax = max(range_x) / 4 + min(range_x), + ymin = max_count_healthy * .8 + # ymax = max_count_healthy * .5 + ) + + } + + # Save plot + if (!is.null(output_filename)) ggplot2::ggsave(output_filename, final_plot, bg = "white", width = 16, height = 12) + + + # Output ------------------------------------------------------------------ + + OUTPUT = list(TABLE_gt = TABLE_gt, + final_plot = final_plot) + + return(OUTPUT) + +} + + + + +#' remove_layers_cutoff_plot +#' Remove layers from a cutoff plot. This is useful to show how different things +#' are calculated (e.g. Sensitivity) +#' +#' @param cutoff_plot A plot_cutoff() plot +#' @param delete_what Elements to delete (i.e. FP, FN, TP, TN) +#' @param silent TRUE do not show debug info +#' +#' @return a cutoff plot without the elements deleted +#' @export +#' +#' @examples +#' \dontrun{ +#' PLOT = plot_cutoff(prevalence = 0.2) +#' remove_layers_cutoff_plot(PLOT$final_plot, delete_what = c("FN", "TP")) + +#' ggplot2::labs(subtitle = "Specificity = TN/(TN+FP)") +#' } +remove_layers_cutoff_plot <- function(cutoff_plot, delete_what, silent = TRUE) { + + layers <- lapply(cutoff_plot$layers, function(x) { + + # GeomStep, GeomBar + if (class(x$geom)[1] %in% c("GeomStep", "GeomBar")) { + + if (unique(x$data$classification)[1] %in% delete_what) { + if (silent == FALSE) cli::cli_alert_info("DELETE: {class(x$geom)[1]} | {unique(x$data$classification)[1]}") + NULL + } else { + if (silent == FALSE) cli::cli_alert_info("{class(x$geom)[1]} | {unique(x$data$classification)[1]}") + x + } + + # GeomText + } else if (class(x$geom)[1] %in% c("GeomText")) { + + if (x$aes_params$label %in% delete_what) { + if (silent == FALSE) cli::cli_alert_info("DELETE: {class(x$geom)[1]} | {x$aes_params$label}") + NULL + + } else if (x$aes_params$label == "Cutoff point") { + if (silent == FALSE) cli::cli_alert_info("DELETE: {class(x$geom)[1]} | {x$aes_params$label}") + NULL + # Delete the Healthy text when we delete TN + } else if (x$aes_params$label == "Healthy" & all(c("TN", "FP") %in% delete_what)) { + if (silent == FALSE) cli::cli_alert_info("DELETE: {class(x$geom)[1]} | {x$aes_params$label} | delete_what: {c('TN', 'FP') %in% delete_what}") + NULL + } else if (x$aes_params$label == "Sick" & all(c("TP", "FN") %in% delete_what)) { + if (silent == FALSE) cli::cli_alert_info("DELETE: {class(x$geom)[1]} | {x$aes_params$label} | delete_what: {c('TP', 'FN') %in% delete_what}") + NULL + } else { + if (silent == FALSE) cli::cli_alert_info("{class(x$geom)[1]} | {x$aes_params$label}") + x + } + + } else { + if (silent == FALSE) cli::cli_alert_info("{class(x$geom)[1]} | {unique(x$data$classification)[1]} | {x$aes_params$label}") + x + } + }) + layers <- layers[!sapply(layers, is.null)] + cutoff_plot$layers <- layers + + return(cutoff_plot) + +} diff --git a/README.md b/README.md index 0b0d11f..37110c1 100644 --- a/README.md +++ b/README.md @@ -214,3 +214,50 @@ Another example, with a very good test, and lower expectations: > % False Positive Rate, you need a prevalence of at least 1 out of 429 ------------------------------------------------------------------------ + +## plot\_cutoff() + +Since v0.4.2 you can also plot the distributions of sick and healthy +individuals and learn about how a cutoff point changes the True +Positives, False Positives, True Negatives, False Negatives, +Sensitivity, Specificity, PPV and NPV. + + + PLOTS = plot_cutoff(prevalence = 0.2, + cutoff_point = 33, + mean_sick = 35, + mean_healthy = 20, + sd_sick = 3, + sd_healthy = 5 + ) + + PLOTS$final_plot + +![](man/figures/README_files/figure-markdown_strict/cutoff-1.png) + +Then, with `remove_layers_cutoff_plot()` you can remove specific layers, +to help you understand some of these concepts. + + + # Sensitivity + remove_layers_cutoff_plot(PLOTS$final_plot, delete_what = c("FP", "TN")) + ggplot2::labs(subtitle = "Sensitivity = TP/(TP+FN)") + +![](man/figures/README_files/figure-markdown_strict/remove-cutoff-1.png) + + + # Specificity + remove_layers_cutoff_plot(PLOTS$final_plot, delete_what = c("FN", "TP")) + ggplot2::labs(subtitle = "Specificity = TN/(TN+FP)") + +![](man/figures/README_files/figure-markdown_strict/remove-cutoff-2.png) + + + # PPV + remove_layers_cutoff_plot(PLOTS$final_plot, delete_what = c("TN", "FN")) + ggplot2::labs(subtitle = "PPV = TP/(TP+FP)") + +![](man/figures/README_files/figure-markdown_strict/remove-cutoff-3.png) + + + # NPV + remove_layers_cutoff_plot(PLOTS$final_plot, delete_what = c("TP", "FP")) + ggplot2::labs(subtitle = "NPV = TN/(TN+FN)") + +![](man/figures/README_files/figure-markdown_strict/remove-cutoff-4.png) diff --git a/app.R b/app.R index edad696..14315e3 100644 --- a/app.R +++ b/app.R @@ -17,7 +17,7 @@ ui <- function(request) { fluidPage( - tags$head(includeHTML(("google-analytics.html"))), + # tags$head(includeHTML(("google-analytics.html"))), useShinyjs(), theme = shinythemes::shinytheme("flatly"), diff --git a/cran-comments.md b/cran-comments.md index c4d9b15..f639d82 100644 --- a/cran-comments.md +++ b/cran-comments.md @@ -1,5 +1,5 @@ ## Test environments -* local Ubuntu 20.04, R 4.1.2 +* local Ubuntu 22.04, R 4.3.2 * win-builder (devel and release) * R-hub + Windows Server 2022, R-devel, 64 bit @@ -11,10 +11,15 @@ 0 errors | 0 warnings | 0 note -## Minor fixes +## Major updates -* Fixing issues with URL's (https://cran.r-project.org/web/checks/check_results_BayesianReasoning.html) +* New plot_cutoff() + + Shows healthy and sick distributions and shows FP, FN, TP and TN depending on a cutoff point +* New remove_layers_cutoff_plot() functions + + Get's rid of layers of a cutoff_plot: FP, FN, TP or TN - + Added function so the internet resources in the introduction vignette have a fallback condition with an informative message. +## Minor updates -* Add more checks and tests to catch corner cases \ No newline at end of file +* Fix for CRAN change in docType +* Use linewidth instead of size +* Faster implementation of a step in min_possible_prevalence diff --git a/docs/articles/introduction.html b/docs/articles/introduction.html index c99874a..2479c28 100644 --- a/docs/articles/introduction.html +++ b/docs/articles/introduction.html @@ -83,7 +83,7 @@

Gorka Navarrete

-

2023-10-23

+

2023-11-13

Source: vignettes/introduction.Rmd
introduction.Rmd
@@ -293,6 +293,48 @@

min_possible_prevalence()
+
+

plot_cutoff() +

+

Since v0.4.2 you can also plot the distributions of sick and healthy +individuals and learn about how a cutoff point changes the True +Positives, False Positives, True Negatives, False Negatives, +Sensitivity, Specificity, PPV and NPV.

+
+
+PLOTS = plot_cutoff(prevalence = 0.2,
+                    cutoff_point = 33, 
+                    mean_sick = 35, 
+                    mean_healthy = 20, 
+                    sd_sick = 3, 
+                    sd_healthy = 5
+                    )
+
+PLOTS$final_plot
+

+

Then, with remove_layers_cutoff_plot() you can remove +specific layers, to help you understand some of these concepts.

+
+
+# Sensitivity
+remove_layers_cutoff_plot(PLOTS$final_plot, delete_what = c("FP", "TN")) + ggplot2::labs(subtitle = "Sensitivity = TP/(TP+FN)")
+

+
+
+# Specificity
+remove_layers_cutoff_plot(PLOTS$final_plot, delete_what = c("FN", "TP")) + ggplot2::labs(subtitle = "Specificity = TN/(TN+FP)")
+

+
+
+# PPV
+remove_layers_cutoff_plot(PLOTS$final_plot, delete_what = c("TN", "FN")) + ggplot2::labs(subtitle = "PPV = TP/(TP+FP)")
+

+
+
+# NPV
+remove_layers_cutoff_plot(PLOTS$final_plot, delete_what = c("TP", "FP")) + ggplot2::labs(subtitle = "NPV = TN/(TN+FN)")
+

+
diff --git a/docs/news/index.html b/docs/news/index.html index 41b6950..6bbbe7f 100644 --- a/docs/news/index.html +++ b/docs/news/index.html @@ -53,8 +53,17 @@

BayesianReasoning 0.4.2

-

Minor updates

+

Major updates

+

Minor updates

BayesianReasoning 0.4.1

CRAN release: 2022-01-07

diff --git a/docs/pkgdown.yml b/docs/pkgdown.yml index 90f47fc..aa88216 100644 --- a/docs/pkgdown.yml +++ b/docs/pkgdown.yml @@ -1,8 +1,8 @@ -pandoc: 3.1.1 +pandoc: 3.1.8 pkgdown: 2.0.7 pkgdown_sha: ~ articles: PPV_NPV: PPV_NPV.html introduction: introduction.html -last_built: 2023-10-23T08:34Z +last_built: 2023-11-13T15:35Z diff --git a/docs/reference/index.html b/docs/reference/index.html index e556446..72465ee 100644 --- a/docs/reference/index.html +++ b/docs/reference/index.html @@ -76,6 +76,20 @@

All functionsmin_possible_prevalence()
Show minimum possible prevalence given the test characteristics
+
+ + plot_cutoff() +
+
plot_cutoff +Create a cutoff plot, showing the healthy and sick distributions, and the +consequences of different cutoff points
+
+ + remove_layers_cutoff_plot() +
+
remove_layers_cutoff_plot +Remove layers from a cutoff plot. This is useful to show how different things +are calculated (e.g. Sensitivity)

diff --git a/man/figures/README_files/figure-markdown_strict/cutoff-1.png b/man/figures/README_files/figure-markdown_strict/cutoff-1.png new file mode 100644 index 0000000..5a23bc4 Binary files /dev/null and b/man/figures/README_files/figure-markdown_strict/cutoff-1.png differ diff --git a/man/figures/README_files/figure-markdown_strict/remove-cutoff-1.png b/man/figures/README_files/figure-markdown_strict/remove-cutoff-1.png new file mode 100644 index 0000000..0f3983b Binary files /dev/null and b/man/figures/README_files/figure-markdown_strict/remove-cutoff-1.png differ diff --git a/man/figures/README_files/figure-markdown_strict/remove-cutoff-2.png b/man/figures/README_files/figure-markdown_strict/remove-cutoff-2.png new file mode 100644 index 0000000..a6fd2cf Binary files /dev/null and b/man/figures/README_files/figure-markdown_strict/remove-cutoff-2.png differ diff --git a/man/figures/README_files/figure-markdown_strict/remove-cutoff-3.png b/man/figures/README_files/figure-markdown_strict/remove-cutoff-3.png new file mode 100644 index 0000000..b5e4375 Binary files /dev/null and b/man/figures/README_files/figure-markdown_strict/remove-cutoff-3.png differ diff --git a/man/figures/README_files/figure-markdown_strict/remove-cutoff-4.png b/man/figures/README_files/figure-markdown_strict/remove-cutoff-4.png new file mode 100644 index 0000000..d6f1229 Binary files /dev/null and b/man/figures/README_files/figure-markdown_strict/remove-cutoff-4.png differ diff --git a/man/plot_cutoff.Rd b/man/plot_cutoff.Rd new file mode 100644 index 0000000..5c6b494 --- /dev/null +++ b/man/plot_cutoff.Rd @@ -0,0 +1,52 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/plot_cutoff.R +\name{plot_cutoff} +\alias{plot_cutoff} +\title{plot_cutoff +Create a cutoff plot, showing the healthy and sick distributions, and the +consequences of different cutoff points} +\usage{ +plot_cutoff( + prevalence = 0.1, + cutoff_point = 30, + mean_sick = 35, + mean_healthy = 20, + sd_sick = 3, + sd_healthy = 5, + n_people = 1e+05, + add_table = FALSE, + output_filename = NULL +) +} +\arguments{ +\item{prevalence}{prevalence of the disease} + +\item{cutoff_point}{cutoff point to use} + +\item{mean_sick}{mean for the sick people distribution} + +\item{mean_healthy}{mean for the healthy people distribution} + +\item{sd_sick}{sd for the sick people distribution} + +\item{sd_healthy}{sd for the healthy people distribution} + +\item{n_people}{number of people to use} + +\item{add_table}{FALSE/TRUE: add gt table with Sensitivity, Specificity, etc.} + +\item{output_filename}{NULL. If a filename, will save the plot} +} +\value{ +A list with plots and table +} +\description{ +plot_cutoff +Create a cutoff plot, showing the healthy and sick distributions, and the +consequences of different cutoff points +} +\examples{ +\dontrun{ +plot_cutoff(prevalence = 0.2) +} +} diff --git a/man/remove_layers_cutoff_plot.Rd b/man/remove_layers_cutoff_plot.Rd new file mode 100644 index 0000000..85f83d3 --- /dev/null +++ b/man/remove_layers_cutoff_plot.Rd @@ -0,0 +1,32 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/plot_cutoff.R +\name{remove_layers_cutoff_plot} +\alias{remove_layers_cutoff_plot} +\title{remove_layers_cutoff_plot +Remove layers from a cutoff plot. This is useful to show how different things +are calculated (e.g. Sensitivity)} +\usage{ +remove_layers_cutoff_plot(cutoff_plot, delete_what, silent = TRUE) +} +\arguments{ +\item{cutoff_plot}{A plot_cutoff() plot} + +\item{delete_what}{Elements to delete (i.e. FP, FN, TP, TN)} + +\item{silent}{TRUE do not show debug info} +} +\value{ +a cutoff plot without the elements deleted +} +\description{ +remove_layers_cutoff_plot +Remove layers from a cutoff plot. This is useful to show how different things +are calculated (e.g. Sensitivity) +} +\examples{ +\dontrun{ +PLOT = plot_cutoff(prevalence = 0.2) +remove_layers_cutoff_plot(PLOT$final_plot, delete_what = c("FN", "TP")) + +ggplot2::labs(subtitle = "Specificity = TN/(TN+FP)") +} +} diff --git a/vignettes/introduction.Rmd b/vignettes/introduction.Rmd index 97df14b..d3026d7 100644 --- a/vignettes/introduction.Rmd +++ b/vignettes/introduction.Rmd @@ -282,3 +282,42 @@ min_possible_prevalence(Sensitivity = 99.9, --- + + +## plot_cutoff() + +Since v0.4.2 you can also plot the distributions of sick and healthy individuals and learn about how a cutoff point changes the True Positives, False Positives, True Negatives, False Negatives, Sensitivity, Specificity, PPV and NPV. + + +```{r cutoff} + +PLOTS = plot_cutoff(prevalence = 0.2, + cutoff_point = 33, + mean_sick = 35, + mean_healthy = 20, + sd_sick = 3, + sd_healthy = 5 + ) + +PLOTS$final_plot + +``` + + +Then, with `remove_layers_cutoff_plot()` you can remove specific layers, to help you understand some of these concepts. + +```{r remove-cutoff} + +# Sensitivity +remove_layers_cutoff_plot(PLOTS$final_plot, delete_what = c("FP", "TN")) + ggplot2::labs(subtitle = "Sensitivity = TP/(TP+FN)") + +# Specificity +remove_layers_cutoff_plot(PLOTS$final_plot, delete_what = c("FN", "TP")) + ggplot2::labs(subtitle = "Specificity = TN/(TN+FP)") + +# PPV +remove_layers_cutoff_plot(PLOTS$final_plot, delete_what = c("TN", "FN")) + ggplot2::labs(subtitle = "PPV = TP/(TP+FP)") + +# NPV +remove_layers_cutoff_plot(PLOTS$final_plot, delete_what = c("TP", "FP")) + ggplot2::labs(subtitle = "NPV = TN/(TN+FN)") + +```