library(SDMtune)
library(kableExtra)
options(crayon.enabled = TRUE)

r class(params$model@model) output produced using SDMtune version r packageVersion("SDMtune") (Vignali S. et al., 2019).

message(paste0("\n", cli::rule(left = paste("Model Report -", "method:", class(params$model@model)), right = params$model@data@species, line_col = "#4bc0c0", col = "#f58410", width = 80)))
message("\r- Saving files...", appendLF = FALSE)
saveRDS(params$model, file = paste0(params$folder, "/model.Rds"))
swd2csv(params$model@data, paste0(params$folder, "/train.csv"))
if (!is.null(params$test))
  swd2csv(params$test, paste0(params$folder, "/test.csv"))
plot_folder <- paste0(params$folder, "/plots")
message("\r", crayon::green(cli::symbol$tick), " Saving files...")

ROC curve

message("- Plotting ROC curve...", appendLF = FALSE)
plot <- plotROC(params$model, test = params$test)
suppressMessages(ggplot2::ggsave(filename = "ROC_curve.png", plot = plot, device = "png", path = plot_folder))
element <- "<p><a href=\"./plots/ROC_curve.png\"><img src=\"./plots/ROC_curve.png\" style=\"width: 70%; display: block; margin-left: auto; margin-right: auto;\"></a></p>"
htmltools::HTML(element)
message("\r", crayon::green(cli::symbol$tick), " Plotting ROC curve...")

Thresholds

message("- Computing thresholds...", appendLF = FALSE)
knitr::kable(thresholds(params$model, type = params$type, test = params$test), digits = 20) %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed", "responsive"))
message("\r", crayon::green(cli::symbol$tick), " Computing thresholds...")

r if(!params$response_curves) {"<!--"}

Response curves {#response}

Marginal curves:

if (params$response_curves) {
  message("- Plotting marginal response curves...", appendLF = FALSE)
  vars <- sort(colnames(params$model@data@data))
  elements <- c()
  for (var in vars) {
    plot <- plotResponse(params$model, var, type = params$type, only_presence = params$only_presence, marginal = TRUE, rug = TRUE, color = "#4bc0c0")
    suppressMessages(ggplot2::ggsave(filename = paste0(var, "_marginal.png"), plot = plot, device = "png", path = plot_folder))
    path <- paste0(plot_folder, "/", var, "_marginal.png")
    element <- paste0("<a href=\"", path, "\"><figure><img src=\"", path, "\" title=\"", var, "\"><figcaption>", var, "</figcaption></figure></a>")
    elements <- c(elements, element)
  }
  elements <- paste(elements, collapse = "")
  htmltools::HTML(elements)
}

Univariate curves:

if (params$response_curves) {
  message("\r", crayon::green(cli::symbol$tick), " Plotting marginal response curves...")
  message("- Plotting univariate response curves...", appendLF = FALSE)
  elements <- c("")
  for (var in vars) {
    plot <- suppressMessages(plotResponse(params$model, var, type = params$type, only_presence = params$only_presence, marginal = FALSE, rug = TRUE, color = "#4bc0c0"))
    suppressMessages(ggplot2::ggsave(filename = paste0(var, ".png"), plot = plot, device = "png", path = plot_folder))
    path <- paste0(plot_folder, "/", var, ".png")
    element <- paste0("<a href=\"", path, "\"><figure><img src=\"", path, "\" title=\"", var, "\"><figcaption>", var, "</figcaption></figure></a>")
    elements <- c(elements, element)
  }
  elements <- c(elements, "<p></p>")
  elements <- paste(elements, collapse = "")
  htmltools::HTML(elements)
}
# Leave this chunk outside to avoid deleting html...
if (params$response_curves) {
  message("\r", crayon::green(cli::symbol$tick), " Plotting univariate response curves...")
}

r if(!params$response_curves) {"-->"}

r if(is.null(params$env)) {"<!--"}

Map

if (!is.null(env)) {
  message("- Predicting distribution map...", appendLF = FALSE)
  pred <- predict(params$model, data = params$env, type = params$type, filename = paste0(params$folder, "/map"), overwrite = TRUE, clamp = params$clamp, factors = params$factors)
  plot <- plotPred(pred, lt = params$type, hr = TRUE, colorramp = c("#2c7bb6", "#abd9e9", "#ffffbf", "#fdae61", "#d7191c"))
suppressMessages(ggplot2::ggsave(filename = "map.png", plot = plot, device = "png", path = plot_folder))
element <- "<p><a href=\"./plots/map.png\"><img src=\"./plots/map.png\" style=\"width: 70%; display: block; margin-left: auto; margin-right: auto;\"></a></p>"
htmltools::HTML(element)
}
if (!is.null(env))
  message("\r", crayon::green(cli::symbol$tick), " Predicting distribution map...")

r if(is.null(params$env)) {"-->"}

Variable importance

message("- Computing variable importance...", appendLF = FALSE)
knitr::kable(suppressMessages(varImp(params$model, params$permut))) %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed", "responsive"), full_width = FALSE)
message("\r", crayon::green(cli::symbol$tick), " Computing variable importance...")

r if(!params$jk) {"<!--"}

Jackknife test

if (params$jk) {
  message("- Running Jackknife test...", appendLF = FALSE)
  jk <- suppressMessages(doJk(params$model, metric = "auc", test = params$test))
  plot <- plotJk(jk, type = "train", ref = auc(params$model))
  suppressMessages(ggplot2::ggsave(filename = "train_jk.png", plot = plot, device = "png", path = plot_folder))
  if (!is.null(test)) {
    plot <- plotJk(jk, type = "test", ref = auc(params$model, test))
    suppressMessages(ggplot2::ggsave(filename = "test_jk.png", plot = plot, device = "png", path = plot_folder))
    element <- "<p><a href=\"./plots/train_jk.png\"><img src=\"./plots/train_jk.png\" width=50%></a><a href=\"./plots/test_jk.png\"><img src=\"./plots/test_jk.png\" width=50%></a></p>"
  } else {
    element <- "<p><a href=\"./plots/train_jk.png\"><img src=\"./plots/train_jk.png\" style=\"width: 70%; display: block; margin-left: auto; margin-right: auto;\"></a></p>"
  }
  htmltools::HTML(element)
}
# Leave this chunk outside to avoid deleting html...
if (params$jk) {
  message("\r", crayon::green(cli::symbol$tick), " Running Jackknife test...")
}

r if(!params$jk) {"-->"}

Model settings

message("- Writing model settings...", appendLF = FALSE)

Shown below the settings used to train the model:

cat("* Output type: ", params$type, "\n")
cat("* Feature Class combination: ", params$model@model@fc, "\n")
cat("* Regularization multiplier: ", params$model@model@reg, "\n")
cat("* Do clamping: ", params$clamp, "\n")
cat("* Extra arguments: ", paste(params$model@model@extra_args, collapse = ", "), "\n")
cat("* Size: ", params$model@model@size, "\n")
cat("* Decay: ", params$model@model@decay, "\n")
cat("* Rang: ", params$model@model@rang, "\n")
cat("* Maxit: ", params$model@model@maxit, "\n")
cat("* Distribution: ", params$model@model@distribution, "\n")
cat("* Number of trees: ", params$model@model@n.trees, "\n")
cat("* Interaction depth: ", params$model@model@interaction.depth, "\n")
cat("* Shrinkage: ", params$model@model@shrinkage, "\n")
cat("* Bag fraction: ", params$model@model@bag.fraction, "\n")
cat("* Mtry: ", params$model@model@mtry, "\n")
cat("* Number of trees: ", params$model@model@ntree, "\n")
cat("* Node size: ", params$model@model@nodesize, "\n")
message("\r", crayon::green(cli::symbol$tick)," Writing model settings...")

References



Try the SDMtune package in your browser

Any scripts or data that you put into this service are public.

SDMtune documentation built on July 17, 2021, 9:06 a.m.