## ----include = FALSE---------------------------------------------------------- knitr::opts_chunk$set( collapse = TRUE, comment = "#>", fig.width = 7, fig.height = 7, dpi = 100, out.width = "95%" ) ## ----get_ready, results='hide', message=FALSE, warning=FALSE------------------ library(nicheR) # Saving original plotting parameters original_par <- par(no.readonly = TRUE) ## ----data--------------------------------------------------------------------- data("ref_ellipse", package = "nicheR") data("back_data", package = "nicheR") ## ----predictions, message=FALSE----------------------------------------------- # Non-truncated Mahalanobis distance pred_maha <- predict(ref_ellipse, newdata = back_data[, ref_ellipse$var_names], include_mahalanobis = TRUE, include_suitability = FALSE, verbose = FALSE) # Non-truncated suitability pred_suit <- predict(ref_ellipse, newdata = back_data[, ref_ellipse$var_names], include_mahalanobis = FALSE, include_suitability = TRUE, verbose = FALSE) # Truncated suitability (outside = 0, inside = suitability value) pred_trunc <- predict(ref_ellipse, newdata = back_data[, ref_ellipse$var_names], include_mahalanobis = FALSE, include_suitability = FALSE, suitability_truncated = TRUE, verbose = FALSE) ## ----include=FALSE------------------------------------------------------------ # Shared settings used throughout mars <- c(4, 4, 2, 1) blue_pal <- hcl.colors(100, palette = "Oslo", rev = TRUE) vir_pal <- hcl.colors(100, palette = "Viridis") ## ----boundary_only------------------------------------------------------------ par(mar = mars) plot_ellipsoid(ref_ellipse, col_ell = "#e10000", lwd = 2, xlab = "Bio1 (Mean Annual Temperature)", ylab = "Bio12 (Annual Precipitation)", main = "Ellipsoid boundary only") ## ----background--------------------------------------------------------------- par(mar = mars) plot_ellipsoid(ref_ellipse, background = back_data[, ref_ellipse$var_names], col_ell = "#e10000", col_bg = "#9a9797", lwd = 2, pch = ".", xlab = "Bio1 (Mean Annual Temperature)", ylab = "Bio12 (Annual Precipitation)", main = "Background points") ## ----pred_maha---------------------------------------------------------------- par(mar = mars) plot_ellipsoid(ref_ellipse, prediction = pred_maha, col_layer = "Mahalanobis", pal = blue_pal, col_ell = "#e10000", lwd = 2, pch = 16, cex_bg = 0.5, xlab = "Bio1 (Mean Annual Temperature)", ylab = "Bio12 (Annual Precipitation)", main = "Mahalanobis distance (non-truncated)") legend("topright", legend = c("Ellipsoid boundary", "Low D\u00b2", "High D\u00b2"), col = c("#e10000", blue_pal[5], blue_pal[90]), pch = c(NA, 16, 16), lty = c(1, NA, NA), lwd = c(2, NA, NA), cex = 0.8, bty = "n") ## ----pred_suit---------------------------------------------------------------- par(mar = mars) plot_ellipsoid(ref_ellipse, prediction = pred_suit, col_layer = "suitability", pal = vir_pal, col_ell = "#e10000", lwd = 2, pch = 16, cex_bg = 0.5, xlab = "Bio1 (Mean Annual Temperature)", ylab = "Bio12 (Annual Precipitation)", main = "Suitability (non-truncated)") legend("topright", legend = c("Ellipsoid boundary", "Low suitability", "High suitability"), col = c("#e10000", vir_pal[5], vir_pal[95]), pch = c(NA, 16, 16), lty = c(1, NA, NA), lwd = c(2, NA, NA), cex = 0.8, bty = "n") ## ----pred_trunc--------------------------------------------------------------- par(mar = mars) plot_ellipsoid(ref_ellipse, prediction = pred_trunc, col_layer = "suitability_trunc", pal = vir_pal, col_bg = "#d4d4d4", col_ell = "#e10000", lwd = 2, pch = 16, cex_bg = 0.5, xlab = "Bio1 (Mean Annual Temperature)", ylab = "Bio12 (Annual Precipitation)", main = "Truncated suitability") legend("topright", legend = c("Ellipsoid boundary", "Low suitability", "High suitability", "Outside (zero)"), col = c("#e10000", vir_pal[5], vir_pal[95], "#d4d4d4"), pch = c(NA, 16, 16, 16), lty = c(1, NA, NA, NA), lwd = c(2, NA, NA, NA), cex = 0.8, bty = "n") ## ----pred_trunc_maha---------------------------------------------------------- pred_trunc_maha <- predict(ref_ellipse, newdata = back_data[, ref_ellipse$var_names], include_mahalanobis = FALSE, include_suitability = FALSE, mahalanobis_truncated = TRUE, verbose = FALSE) par(mar = mars) plot_ellipsoid(ref_ellipse, prediction = pred_trunc_maha, col_layer = "Mahalanobis_trunc", pal = blue_pal, col_bg = "#d4d4d4", col_ell = "#e10000", lwd = 2, pch = 16, cex_bg = 0.5, xlab = "Bio1 (Mean Annual Temperature)", ylab = "Bio12 (Annual Precipitation)", main = "Truncated Mahalanobis distance") legend("topright", legend = c("Ellipsoid boundary", "Inside (low D\u00b2)", "Inside (high D\u00b2)", "Outside (NA)"), col = c("#e10000", blue_pal[5], blue_pal[90], "#d4d4d4"), pch = c(NA, 16, 16, 16), lty = c(1, NA, NA, NA), lwd = c(2, NA, NA, NA), cex = 0.8, bty = "n") ## ----rev_pal------------------------------------------------------------------ par(mar = mars) plot_ellipsoid(ref_ellipse, prediction = pred_suit, col_layer = "suitability", pal = vir_pal, rev_pal = TRUE, alpha_bg = 0.5, alpha_ell = 0.8, col_ell = "#0004d5", lwd = 2, pch = 16, cex_bg = 0.5, xlab = "Bio1 (Mean Annual Temperature)", ylab = "Bio12 (Annual Precipitation)", main = "Reversed palette + transparency") legend("topright", legend = c("Ellipsoid boundary", "Low suitability (now bright)", "High suitability (now dark)"), col = c("#0004d5", vir_pal[95], vir_pal[5]), pch = c(NA, 16, 16), lty = c(1, NA, NA), lwd = c(2, NA, NA), cex = 0.8, bty = "n") ## ----bg_sample, fig.width=7, fig.height=3.5, out.width="95%"------------------ par(mfrow = c(1, 2), cex = 0.75, mar = mars) plot_ellipsoid(ref_ellipse, background = back_data[, ref_ellipse$var_names], col_ell = "#e10000", col_bg = "#9a9797", lwd = 2, pch = ".", xlab = "Bio1", ylab = "Bio12", main = "Full background") plot_ellipsoid(ref_ellipse, background = back_data[, ref_ellipse$var_names], bg_sample = 500, col_ell = "#e10000", col_bg = "#9a9797", lwd = 2, pch = 16, cex_bg = 0.4, xlab = "Bio1", ylab = "Bio12", main = "Subsampled (n = 500)") ## ----fixed_lims, fig.width=7, fig.height=3.5, out.width="95%"----------------- # Create a second ellipsoid with a shifted centroid for comparison ref_ellipse2 <- ref_ellipse ref_ellipse2$centroid <- ref_ellipse$centroid + c(5, 100) # Define shared limits from the full background extent global_lims <- list( xlim = range(back_data$bio_1, na.rm = TRUE), ylim = range(back_data$bio_12, na.rm = TRUE) ) par(mfrow = c(1, 2), cex = 0.75, mar = mars) plot_ellipsoid(ref_ellipse, background = back_data[, ref_ellipse$var_names], fixed_lims = global_lims, col_ell = "#e10000", col_bg = "#9a9797", lwd = 2, pch = ".", xlab = "Bio1", ylab = "Bio12", main = "Ellipsoid 1") plot_ellipsoid(ref_ellipse2, background = back_data[, ref_ellipse2$var_names], fixed_lims = global_lims, col_ell = "#0004d5", col_bg = "#9a9797", lwd = 2, pch = ".", xlab = "Bio1", ylab = "Bio12", main = "Ellipsoid 2 (shifted centroid)") ## ----layering----------------------------------------------------------------- # Simulate occurrence points from inside the ellipsoid set.seed(42) occ_idx <- sample(which(pred_trunc$suitability_trunc > 0), 40) occ_pts <- back_data[occ_idx, ref_ellipse$var_names] par(mar = mars) # Step 1: background (muted color, boundary also muted so it sits behind) plot_ellipsoid(ref_ellipse, background = back_data[, ref_ellipse$var_names], col_bg = "#c5c5c5", col_ell = "#c5c5c5", pch = ".", lwd = 1, xlab = "Bio1 (Mean Annual Temperature)", ylab = "Bio12 (Annual Precipitation)", main = "Background + occurrences + boundary") # Step 2: occurrence points on top of background add_data(occ_pts, x = "bio_1", y = "bio_12", pts_col = "#0004d5", pch = 19, cex = 1.2) # Step 3: ellipsoid boundary on top of everything add_ellipsoid(ref_ellipse, col_ell = "#e10000", lwd = 2) legend("topright", legend = c("Background", "Occurrences", "Ellipsoid boundary"), col = c("#c5c5c5", "#0004d5", "#e10000"), pch = c(16, 19, NA), lty = c(NA, NA, 1), lwd = c(NA, NA, 2), cex = 0.8, bty = "n") ## ----add_data_col_layer------------------------------------------------------- # Predict suitability at the occurrence points occ_pred <- predict(ref_ellipse, newdata = occ_pts, include_suitability = TRUE, include_mahalanobis = FALSE, verbose = FALSE) par(mar = mars) # Background in grey plot_ellipsoid(ref_ellipse, background = back_data[, ref_ellipse$var_names], col_bg = "#d4d4d4", col_ell = "#e10000", pch = ".", lwd = 2, xlab = "Bio1 (Mean Annual Temperature)", ylab = "Bio12 (Annual Precipitation)", main = "Occurrences colored by suitability") # Occurrence points colored by suitability add_data(occ_pred, x = "bio_1", y = "bio_12", col_layer = "suitability", pal = vir_pal, pch = 19, cex = 1.4) add_ellipsoid(ref_ellipse, col_ell = "#e10000", lwd = 2) legend("topright", legend = c("Background", "Ellipsoid boundary", "Low suitability", "High suitability"), col = c("#d4d4d4", "#e10000", vir_pal[5], vir_pal[95]), pch = c(16, NA, 19, 19), lty = c(NA, 1, NA, NA), lwd = c(NA, 2, NA, NA), cex = 0.8, bty = "n") ## ----pairs_background, fig.width=7, fig.height=4, out.width="95%"------------- # Build a 3D ellipsoid for a more interesting pairs example range_3d <- data.frame(bio_1 = c(27, 35), bio_12 = c(1000, 1500), bio_15 = c(60, 75)) ellipse_3d <- build_ellipsoid(range = range_3d) par(cex = 0.7) plot_ellipsoid_pairs(ellipse_3d, background = back_data[, ellipse_3d$var_names], col_ell = "#e10000", col_bg = "#9a9797", lwd = 2, pch = ".") ## ----pairs_prediction, fig.width=7, fig.height=4, out.width="95%"------------- suit_3d <- predict(ellipse_3d, newdata = back_data[, ellipse_3d$var_names], include_mahalanobis = FALSE, include_suitability = TRUE, suitability_truncated = TRUE, verbose = FALSE) par(cex = 0.7) plot_ellipsoid_pairs(ellipse_3d, prediction = suit_3d, col_layer = "suitability_trunc", pal = vir_pal, col_bg = "#d4d4d4", col_ell = "#e10000", lwd = 2, pch = 16, cex_bg = 0.3) ## ----par_reset---------------------------------------------------------------- par(original_par)