v.2.5.5 on CRAN

.Rbuildignore

@@ -10,4 +10,5 @@ tar.gz$
 ^appveyor\.yml$
 ^\.github$
 .DS_Store
-^revdep$
+^revdep$
+^CRAN-SUBMISSION$

CRAN-SUBMISSION

@@ -0,0 +1,3 @@
+Version: 2.5.5
+Date: 2025-06-08 18:57:19 UTC
+SHA: 5f47d4cf5aa147c9f310e2917e566d2480ddd527

DESCRIPTION

@@ -7,11 +7,11 @@ Description: Estimate significance of importance metrics
     metrics for each predictor variable and p-value of
     observed. Provides summary and visualization functions for 'randomForest' 
     results.
-Version: 2.5.4
+Version: 2.5.6
 Authors@R: c(
-  EA = person("Eric", "Archer", email = "eric.archer@noaa.gov", role = c("aut", "cre")))
-URL: https://github.com/EricArcher/rfPermute
-BugReports: https://github.com/EricArcher/rfPermute/issues
+  EA = person("Eric", "Archer", email = "eric.ivan.archer@gmail.com", role = c("aut", "cre")))
+URL: https://github.com/SWFSC/rfPermute
+BugReports: https://github.com/SWFSC/rfPermute/issues
 Depends:
     R (>= 4.1.0)
 Imports:
@@ -20,9 +20,9 @@ Imports:
     ggplot2 (>= 3.3),
     grDevices,
     gridExtra,
-    magrittr (>= 2.0),
     methods,
     parallel,
+    pROC,
     randomForest (>= 4.6),
     rlang,
     scales,
@@ -52,7 +52,8 @@ Collate:
     plotVotes.R
     balancedSampsize.R
     cleanRFdata.R
+    rfROC.R
 LazyData: TRUE
 License: GPL (>= 2)
 Encoding: UTF-8
-RoxygenNote: 7.3.2
+Config/roxygen2/version: 8.0.0

NAMESPACE

@@ -27,7 +27,7 @@ export(plotTrace)
 export(plotVotes)
 export(rfPermute)
 export(rfPermuteTutorial)
-importFrom(magrittr,"%>%")
+export(rfROC)
 importFrom(methods,new)
 importFrom(randomForest,importance)
 importFrom(randomForest,randomForest)

R/confusionMatrix.R

@@ -72,6 +72,7 @@ confusionMatrix <- function(x, conf.level = 0.95, threshold = NULL) {
   cm <- rbind(cm, Overall = rep(NA, ncol(cm)))
   pct.correct <- (correct.n / all.n) * 100
   cbind(
+    n = all.n,
     cm, 
     pct.correct = pct.correct[rownames(cm)], 
     ci[rownames(cm), , drop = FALSE],
@@ -88,8 +89,8 @@ plotConfMat <- function(x, title = NULL, plot = TRUE) {
   if(rf$type == "regression") stop("'rf' must be of a classification model")
 
   conf <- .confMat(rf)
-  pct.correct <- (100 * sum(diag(conf)) / sum(conf)) %>% 
-    round(0) %>% 
+  pct.correct <- (100 * sum(diag(conf)) / sum(conf)) |> 
+    round(0) |> 
     paste0("% correct")
   title <- if(is.null(title)) {
     pct.correct 
@@ -99,18 +100,18 @@ plotConfMat <- function(x, title = NULL, plot = TRUE) {
   freq <- rowSums(conf)
   rownames(conf) <- paste0(names(freq), " (", freq, ")")
 
-  p <- conf %>% 
-    prop.table(1) %>% 
-    as.data.frame %>% 
-    tibble::rownames_to_column("observed") %>% 
-    tidyr::gather("predicted", "prop", -.data$observed) %>% 
+  p <- conf |> 
+    prop.table(1) |> 
+    as.data.frame() |> 
+    tibble::rownames_to_column("observed") |> 
+    tidyr::gather("predicted", "prop", -.data$observed) |> 
     dplyr::mutate(
       observed = factor(.data$observed),
       observed = stats::reorder(.data$observed, dplyr::desc(.data$observed)),
       predicted = factor(.data$predicted)
-    ) %>% 
-    ggplot2::ggplot(ggplot2::aes_string("predicted", "observed")) +
-    ggplot2::geom_raster(ggplot2::aes_string(fill = "prop")) +
+    ) |> 
+    ggplot2::ggplot(ggplot2::aes(x = .data$predicted, y = .data$observed)) +
+    ggplot2::geom_raster(ggplot2::aes(fill = .data$prop)) +
     ggplot2::scale_fill_viridis_c(
       option = "magma", 
       direction = -1, 
@@ -121,7 +122,8 @@ plotConfMat <- function(x, title = NULL, plot = TRUE) {
     ggplot2::guides(fill = ggplot2::guide_colorbar(title = "Proportion")) +
     ggplot2::theme(
       axis.text.x.top = ggplot2::element_text(angle = 45, hjust = 0),
-      panel.background = ggplot2::element_blank()
+      panel.background = ggplot2::element_blank(),
+      legend.key.height = ggplot2::unit(1, 'null')
     )
 
   if(plot) print(p)

R/importance.R

@@ -137,12 +137,12 @@ plotImportance <- function(x, plot.type = c("bar", "heatmap"), imp.type = NULL,
         pval = if(inherits(x, "rfPermute")) {
           x$pval[rownames(imp.mat), i, sc]
         } else Inf
-      ) %>% 
-        tibble::rownames_to_column("pred") %>% 
+      ) |> 
+        tibble::rownames_to_column("pred") |> 
         dplyr::mutate(
           is.sig = .data$pval <= alpha,
           pred = stats::reorder(.data$pred, .data$imp)
-        ) %>% 
+        ) |> 
         dplyr::arrange(-.data$imp)
       if(sig.only) imp.df <- imp.df[imp.df$is.sig, ]
       n <- min(n, nrow(imp.df))
@@ -151,7 +151,7 @@ plotImportance <- function(x, plot.type = c("bar", "heatmap"), imp.type = NULL,
 
       ggplot2::ggplot(
         imp.df, 
-        ggplot2::aes_string(x = "pred", y = "imp", fill = "is.sig") 
+        ggplot2::aes(x = .data$pred, y = .data$imp, fill = .data$is.sig) 
       ) + 
         ggplot2::geom_bar(stat = "identity") +
         ggplot2::coord_flip() + 
@@ -174,17 +174,17 @@ plotImportance <- function(x, plot.type = c("bar", "heatmap"), imp.type = NULL,
     preds <- rev(rev(preds)[1:n])
     imp.df <- data.frame(imp.mat[preds, imp.type, drop = FALSE], check.names = FALSE)
     if(ranks) for(i in imp.type) imp.df[[i]] <- rank(-imp.df[[i]])
-    imp.df <- imp.df %>% 
-      tibble::rownames_to_column("pred") %>% 
-      tidyr::pivot_longer(-.data$pred, names_to = "type") %>% 
+    imp.df <- imp.df |> 
+      tibble::rownames_to_column("pred") |> 
+      tidyr::pivot_longer(-.data$pred, names_to = "type") |> 
       dplyr::mutate(
         type = factor(.data$type, levels = imp.type),
         pred = factor(.data$pred, levels = preds)
       )
 
     # create plot
-    g <- ggplot2::ggplot(imp.df, ggplot2::aes_string("type", "pred")) +
-      ggplot2::geom_raster(ggplot2::aes_string(fill = "value")) + 
+    g <- ggplot2::ggplot(imp.df, ggplot2::aes(x = .data$type, y = .data$pred)) +
+      ggplot2::geom_raster(ggplot2::aes(fill = .data$value)) + 
       ggplot2::theme(panel.background = ggplot2::element_blank())
     g <- g + if(ranks) {
       ggplot2::scale_fill_gradient2(
@@ -236,4 +236,4 @@ plotImportance <- function(x, plot.type = c("bar", "heatmap"), imp.type = NULL,
     }
   }
   invisible(imp.plot)
-}
+}

R/plotImpPreds.R

@@ -68,10 +68,10 @@ plotImpPreds <- function(x, df, class.col, imp.type = NULL, max.vars = 16,
   df$.class. <- factor(df[[class.col]])
   df <- df[, c(".class.", imp.vars)]
 
-  p <- df %>%
-    tidyr::pivot_longer(-.data$.class., names_to = "var") %>% 
-    dplyr::mutate(var = factor(.data$var, levels = imp.vars)) %>% 
-    ggplot2::ggplot(ggplot2::aes_string(".class.", "value")) +
+  p <- df |>
+    tidyr::pivot_longer(-.data$.class., names_to = "var") |> 
+    dplyr::mutate(var = factor(.data$var, levels = imp.vars)) |> 
+    ggplot2::ggplot(ggplot2::aes(x = .data$.class., y = .data$value)) +
     ggplot2::geom_violin(alpha = violin.alpha) +
     ggplot2::geom_jitter(size = size, alpha = point.alpha, width = 0.25, height = 0) +
     ggplot2::facet_wrap(~ var, scales = "free_y") +
@@ -80,4 +80,4 @@ plotImpPreds <- function(x, df, class.col, imp.type = NULL, max.vars = 16,
 
   if(plot) print(p)
   invisible(p)
-}
+}

R/plotInbag.R

@@ -24,8 +24,6 @@
 #' library(randomForest)
 #' data(mtcars)
 #' 
-#' sampsize = c(5, 5)
-#' 
 #' rf <- randomForest(factor(am) ~ ., data = mtcars, ntree = 10)
 #' plotInbag(rf)
 #' 
@@ -35,6 +33,9 @@
 #' rf <- randomForest(factor(am) ~ ., data = mtcars, ntree = 10000)
 #' plotInbag(rf)
 #' 
+#' rf <- randomForest(factor(am) ~ ., data = mtcars, ntree = 10000, sampsize = c(5, 5))
+#' plotInbag(rf, sampsize = c(5, 5))
+#' 
 #' @export
 #'
 plotInbag <- function(x, bins = 10, replace = TRUE, sampsize = NULL, 
@@ -49,37 +50,84 @@ plotInbag <- function(x, bins = 10, replace = TRUE, sampsize = NULL,
     }
   }
 
-  n <- length(rf$y)
-  if(is.null(sampsize)) sampsize <- if(replace) n else ceiling(0.632 * n)
-
-  .pctPicked <- function(m) {
-    pct <- 1 - (1 - (1 / m)) ^ m
-    sapply(pct, function(p) if(is.nan(p)) 1 - (1 / exp(1)) else p)
-  }
+  # number of individuals
+  k <- length(rf$y)
+  # number of individuals per class
+  n <- table(rf$y)
+  # check sampsize
+  if(is.null(sampsize)) sampsize <- if(replace) k else ceiling(0.632 * k)
 
+  # compute expected percent
   exp.pct <- if(replace) {
     if(length(sampsize) == 1) {
-      .pctPicked(sampsize) * 100
+      pct <- 1 - (1 - (1 / sampsize)) ^ sampsize
+      if(is.nan(pct)) pct <- 1 - (1 / exp(1))
+      pct * 100
     } else {
-      (as.vector((.pctPicked(sampsize) * sampsize)) / table(rf$y)) * 100
+      as.vector((1 - ((n - 1) / n) ^ sampsize)) * 100
     }
   } else if(length(sampsize) == 1) {
-    (sampsize / n) * 100
+    (sampsize / k) * 100
+  } else {
+    as.vector(sampsize / n) * 100
+  }
+
+  # convert expected percent to data frame
+  exp.pct <- if(rf$type == "classification") {
+    data.frame(group = levels(rf$y), exp.pct = exp.pct) 
   } else {
-    as.vector(sampsize / table(rf$y)) * 100
+    data.frame(group = 1, exp.pct = exp.pct)
   }
 
-  pct <- ((rf$ntree - rf$oob.times) / rf$ntree) * 100
-  bins <- max(bins, floor(length(pct) / 5))
-  p <- data.frame(pct = pct) |> 
-    ggplot2::ggplot(ggplot2::aes_string("pct")) +
-    ggplot2::geom_histogram(bins = bins) +
+  # observed percent inbag
+  obs.pct <- data.frame(
+    group = rf$y,
+    pct = ((rf$ntree - rf$oob.times) / rf$ntree) * 100
+  )
+
+  # create histograms
+  p <- obs.pct |> 
+    ggplot2::ggplot(ggplot2::aes(x = .data$pct)) +
+    ggplot2::geom_histogram(bins = max(bins, floor(k / 5))) +
     ggplot2::labs(
       x = "Percent of trees where sample was inbag",
       y = "Frequency"
     ) + 
-    ggplot2::geom_vline(xintercept = exp.pct, color = "red")
+    ggplot2::geom_vline(
+      ggplot2::aes(xintercept = exp.pct), 
+      data = exp.pct, 
+      color = "red"
+    )
+  if(length(sampsize) > 1) p <- p + ggplot2::facet_wrap(~.data$group, scales = 'free_x')
 
+  # plot histograms
   if(plot) print(p)
+
+  # summarize inbag rates
+  smry.vals <- c('mean', 'median', 'mode', 'min', 'max', 'sd', 'ci.lower', 'ci.upper')
+  inbag.smry <- suppressWarnings(if(length(sampsize) == 1) {
+    c(
+      expected = exp.pct$exp.pct[1],
+      swfscMisc::distSmry(obs.pct$pct, method = 'venter')[smry.vals] 
+    ) 
+  } else {
+    smry <- do.call(
+      rbind,
+      tapply(
+        obs.pct$pct, 
+        obs.pct$group, 
+        swfscMisc::distSmry, 
+        method = 'venter'
+      )
+    ) |> 
+      t()
+    rbind(
+      expected = tibble::deframe(exp.pct), smry[smry.vals, ])
+  })
+
+  # show summary
+  message('Percent inbag summary:')
+  print(inbag.smry)
+
   invisible(p)
 }

R/plotNull.R

@@ -65,17 +65,17 @@ plotNull <- function(x, preds = NULL, imp.type = NULL, scale = TRUE,
       imp.type
     )
 
-    df <- sapply(imp.type, function(i) x$null.dist[[sc]][pr, i, ]) %>% 
-      as.data.frame() %>% 
-      tidyr::gather("imp.type", "importance") %>% 
+    df <- sapply(imp.type, function(i) x$null.dist[[sc]][pr, i, ]) |> 
+      as.data.frame() |> 
+      tidyr::gather("imp.type", "importance") |> 
       dplyr::mutate(imp.type = factor(labels[imp.type], levels = labels))
-    obs <- imp[pr, imp.type, drop = FALSE] %>% 
-      as.data.frame() %>% 
-      tibble::rownames_to_column("predictor") %>% 
-      tidyr::gather("imp.type", "importance", -.data$predictor) %>% 
+    obs <- imp[pr, imp.type, drop = FALSE] |> 
+      as.data.frame() |> 
+      tibble::rownames_to_column("predictor") |> 
+      tidyr::gather("imp.type", "importance", -.data$predictor) |> 
       dplyr::mutate(imp.type = factor(labels[imp.type], levels = labels))
 
-    p <- ggplot2::ggplot(df, ggplot2::aes_string("importance")) 
+    p <- ggplot2::ggplot(df, ggplot2::aes(x = .data$importance)) 
     p <- if(plot.type == "hist") {
         p + ggplot2::geom_histogram() + ggplot2::ylab("Count")
       } else {
@@ -85,12 +85,12 @@ plotNull <- function(x, preds = NULL, imp.type = NULL, scale = TRUE,
       ggplot2::xlab("Importance") + 
       ggplot2::ggtitle(pr) +
       ggplot2::geom_vline(
-        ggplot2::aes_string(xintercept = "importance"), 
+        ggplot2::aes(xintercept = .data$importance), 
         color = "red", data = obs
       ) +
       ggplot2::facet_wrap(~ imp.type, scales = "free")
   }, simplify = FALSE, USE.NAMES = TRUE)
 
   if(plot) for(p in g) print(p)
   invisible(g)
-}
+}

R/plotPredictedProbs.R

@@ -25,21 +25,21 @@ plotPredictedProbs <- function(x, bins = 30, plot = TRUE) {
   rf <- as.randomForest(x)
   if(rf$type == "regression") stop("'rf' must be of a classification model")
 
-  p <- rf$votes %>% 
-    as.data.frame %>% 
+  p <- rf$votes |> 
+    as.data.frame() |> 
     cbind(
       class = as.character(rf$y),
       predicted = as.character(rf$predicted)
-    ) %>% 
-    tidyr::gather("pred.class", "prob", -.data$class, -.data$predicted) %>% 
-    dplyr::filter(.data$predicted == .data$pred.class) %>% 
-    dplyr::mutate(correct = .data$class == .data$predicted) %>% 
-    ggplot2::ggplot(ggplot2::aes_string("prob", fill = "class")) +
+    ) |> 
+    tidyr::gather("pred.class", "prob", -.data$class, -.data$predicted) |> 
+    dplyr::filter(.data$predicted == .data$pred.class) |> 
+    dplyr::mutate(correct = .data$class == .data$predicted) |> 
+    ggplot2::ggplot(ggplot2::aes(.data$prob, fill = .data$class)) +
     ggplot2::geom_histogram(bins = bins) +
     ggplot2::facet_wrap(~ predicted) +
     ggplot2::labs(x = "Assignment probability", y = "Frequency") +
     ggplot2::theme(legend.title = ggplot2::element_blank())
 
   if(plot) print(p)
   invisible(p)
-}
+}