diff --git a/DESCRIPTION b/DESCRIPTION index bced1b7..386b2ff 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: stats4phc Title: Performance Evaluation for the Prognostic Value of Predictive Models Intended to Support Personalized Healthcare Through Predictiveness Curves and Positive / Negative Predictive Values -Version: 0.1.1 +Version: 0.1.2 Authors@R: c( person("Ondrej", "Slama", email = "ondrej.slama@roche.com", role = c("aut", "cre")), person("Darrick", "Shen", email = "shend9@gene.com", role = "aut"), @@ -36,8 +36,7 @@ Imports: isotone (>= 1.1.0), mgcv (>= 1.8.41), pracma (>= 2.4.2), - tidyr (>= 1.3.0), - yardstick (>= 1.1.0) + tidyr (>= 1.3.0) Suggests: knitr, rmarkdown, diff --git a/R/PV.R b/R/PV.R index b0d6c65..3c5e258 100644 --- a/R/PV.R +++ b/R/PV.R @@ -34,11 +34,9 @@ nonParametricPV <- function(outcome, score) { ppv <- vapply( thresh.predictions, function(x) { - yardstick::ppv_vec( - truth = factor(outcome, levels = c("1", "0")), - estimate = factor(x, levels = c("1", "0")), - event_level = "first" - ) + tp <- sum(outcome == 1 & x == 1) + fp <- sum(outcome == 0 & x == 1) + tp / (tp + fp) }, numeric(1) ) @@ -46,11 +44,9 @@ nonParametricPV <- function(outcome, score) { npv <- vapply( thresh.predictions, function(x) { - yardstick::npv_vec( - truth = factor(outcome, levels = c("1", "0")), - estimate = factor(x, levels = c("1", "0")), - event_level = "first" - ) + tn <- sum(outcome == 0 & x == 0) + fn <- sum(outcome == 1 & x == 0) + tn / (tn + fn) }, numeric(1) ) @@ -136,35 +132,27 @@ nonParametricTR <- function(outcome, score) { # Calc sensitivities and specificities at each risk percentile threshold senses <- vapply( - thresh.predictions[1:(length(score) - 1)], + thresh.predictions, function(x) { - yardstick::sens_vec( - truth = factor(outcome, levels = c("1", "0")), - estimate = factor(x, levels = c("1", "0")), - event_level = "first" - ) + sum(outcome == 1 & x == 1) / sum(outcome == 1) }, numeric(1) ) specs <- vapply( - thresh.predictions[1:(length(score) - 1)], + thresh.predictions, function(x) { - yardstick::spec_vec( - truth = factor(outcome, levels = c("1", "0")), - estimate = factor(x, levels = c("1", "0")), - event_level = "first" - ) + sum(outcome == 0 & x == 0) / sum(outcome == 0) }, numeric(1) ) # Create a data.frame dat <- data.frame( - score = c(min(score), score), - percentile = c(0, ecdf(score)(score)), - Sensitivity = c(1, senses, 0), - Specificity = c(0, specs, 1) + score = score, + percentile = ecdf(score)(score), + Sensitivity = senses, + Specificity = specs ) %>% tidyr::pivot_longer( cols = c("Sensitivity", "Specificity"), diff --git a/R/sensSpec.R b/R/sensSpec.R index 97ab83f..4527a40 100644 --- a/R/sensSpec.R +++ b/R/sensSpec.R @@ -67,6 +67,10 @@ sensSpec <- function(outcome, dat <- split(dat, dat$method) %>% lapply(\(d) nonParametricTR(outcome = d$outcome, score = d$estimate)) %>% bind_rows(.id = "method") + + if (!plot.raw) { + dat <- add0thPercTR(dat) + } # Plot p <- ggplot(dat) + diff --git a/R/utils.R b/R/utils.R index 51cb3e3..b58c600 100644 --- a/R/utils.R +++ b/R/utils.R @@ -303,6 +303,30 @@ add0thPercPV <- function(x) { } +add0thPercTR <- function(x) { + bind_rows( + x, + x %>% + group_by(.data$method) %>% + summarise( + score = NA, + percentile = 0, + pf = "Sensitivity", + value = 1 + ), + x %>% + group_by(.data$method) %>% + summarise( + score = NA, + percentile = 0, + pf = "Specificity", + value = 0 + ) + ) %>% + arrange(.data$method, .data$pf, .data$percentile) +} + + #' For snapshot testing of graphs #' #' @param code Code to create a graph diff --git a/README.md b/README.md index 036d98e..49e41f3 100644 --- a/README.md +++ b/README.md @@ -30,7 +30,7 @@ remotes::install_github(repo = "genentech/stats4phc") For reproducibility, refer to a specific version tag, for example ``` r -remotes::install_github(repo = "genentech/stats4phc", ref = "v0.1.1") +remotes::install_github(repo = "genentech/stats4phc", ref = "v0.1.2") ```