## ----include = FALSE----------------------------------------------------------
knitr::opts_chunk$set(collapse = TRUE, comment = "#>", fig.align = "center")

## -----------------------------------------------------------------------------
library(climniche)

sim <- simulate_climniche(n = 200, p = 6, seed = 7)
fit <- fit_climniche(
  current = sim[["current"]],
  future = sim[["future_away"]],
  occupied = sim[["occupied"]],
  sensitivity = sim[["sensitivity"]]
)

head(climniche_table(fit))

## -----------------------------------------------------------------------------
current <- matrix(
  rep(c(1, 0), 4),
  ncol = 2,
  byrow = TRUE,
  dimnames = list(
    c("unchanged", "towards centre", "away from centre", "same niche distance"),
    c("climate 1", "climate 2")
  )
)
future <- rbind(
  unchanged = c(1, 0),
  `towards centre` = c(0, 0),
  `away from centre` = c(2, 0),
  `same niche distance` = c(0, 1)
)
colnames(future) <- colnames(current)

geometry_fit <- fit_climniche(
  current = current,
  future = future,
  occupied = rep(1, nrow(current)),
  center = c(0, 0),
  A = diag(2),
  scale = FALSE,
  preprocess = FALSE,
  boundary = 0.95,
  tolerance = 0
)

geometry_table <- data.frame(
  path = rownames(current),
  `Climatic Displacement` = geometry_fit[["climate_change_amount"]],
  `Niche Distance Shift` = geometry_fit[["niche_distance_change"]],
  `Climatic Reconfiguration` =
    geometry_fit[["climate_reconfiguration"]],
  `Niche Boundary Exceedance` =
    geometry_fit[["niche_boundary_exceedance"]],
  check.names = FALSE
)

knitr::kable(geometry_table, digits = 3)

## -----------------------------------------------------------------------------
identity_error <- with(
  geometry_fit,
  climate_change_amount^2 -
    niche_distance_change^2 -
    climate_reconfiguration^2
)
max(abs(identity_error))