#8: remove yardstick (#9)

Close #8

Author: slamao

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 = "[email protected]", role = c("aut", "cre")),
     person("Darrick", "Shen", email = "[email protected]", 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,

R/PV.R

@@ -34,23 +34,19 @@ 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)
   )
 
   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"),

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) +

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

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")
 ```