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

