weirdness: Computes ecological weirdness for a fitted model or it...

In NINAnor/oneimpact: Tools for the assessment of the cumulative impacts of anthropogenic features in ecological studies

Computes ecological weirdness for a fitted model or it estimated coefficients

Description

Computes ecological weirdness for a fitted model or it estimated coefficients

Usage

weirdness(
  x,
  measure = c("coef_sign", "n_crosses", "response_auc"),
  wmean = TRUE,
  which_coef_sign = c("count", "sum")[1],
  expected_sign = -1,
  zero_coefficient_limit = 1e-08,
  response = c("mean", "mid")[1],
  radii = c(100, 250, 500, 1000, 2500, 5000, 10000),
  type = c("circle", "Gauss", "rectangle", "exp_decay", "bartlett", "threshold",
    "mfilter")[1],
  radius_max = 10000,
  ...
)

Arguments

x	Bag.
measure	⁠[string(1)]{""coef_sign", "n_crosses", "response_auc""}⁠ Measure used to quantify "weirdness" in the model or coefficients, based on the coeffcients and the response plots for each type of covariate with zone of influence in a model. It can be one or multiple of these options: "coef_sign": counts the number of coefficients whose signal is opposite to the ecologically expected signal; "n_crosses": counting the number of crosses in signal for the coefficients of the same covariate; "response_auc": computing the area under the response plot curve which is in the unexpected direction.
expected_sign	⁠[numeric(1)=-1]⁠ Expected sign of the coefficient. Either -1 (negative), +1 (positive), or 0 (no effect).
zero_coefficient_limit	⁠[numeric(1)=1e8]⁠ Value above which an estimated coefficient is considered non-zero. Default is 1e-8. Useful for comparing coefficients which are expected to be zero (i.e. to have no effect).
which_coef	Which measure to use for the coefficients, when measure = "coef_sign". If count (default), only the sign matterns and we count the number of coefficients with unexpected sign. If sum, we count the sum of the (standardized) coefficients, to also account for their magnitude.

Examples

#-------
# weirdness for vector of coefficients

# weirdness for coefficients for one type of ZOI variable

# set coefficients
coefs <- c(-1, -0.5, -0.1, 0.8, 0.3, -0.1)
expected_sign <- -1
weirdness(coefs, expected_sign = expected_sign)
weirdness(coefs, expected_sign = expected_sign, which_coef = "sum")

#-------
# weirdness for data.frame with (x,y) for line

# checking for lines crossing zero
x <- seq(0, 10, 0.01)
y <- -8 + 10 * x - 1.5 * x**2
df <- data.frame(x = x, y = y)
plot(x, y); abline(h = 0, col = "red")

# n crosses
weirdness(df, response = "y", measure = "n_crosses")
# auc on the opposite side of the expected sign
weirdness(df, response = "y", measure = "response_auc_opposite")
# ratio between auc above and auc on the expected sign
weirdness(df, response = "y", measure = "response_auc_ratio")

#-------
# weirdness for bag

#---
# fit a bag to be tested

# load packages
library(glmnet)

# load data
data("reindeer_rsf")
# rename it just for convenience
dat <- reindeer_rsf

# formula initial structure
f <- use ~ private_cabins_cumulative_XXX + public_cabins_high_cumulative_XXX +
  trails_cumulative_XXX +
  NORUTreclass +
  # poly(norway_pca_klima_axis1, 2, raw = TRUE) +
  # poly(norway_pca_klima_axis2, 2, raw = TRUE) +
  norway_pca_klima_axis1 + norway_pca_klima_axis1_sq +
  norway_pca_klima_axis2 + norway_pca_klima_axis2_sq +
  norway_pca_klima_axis3 + norway_pca_klima_axis4

# add ZOI terms to the formula
zois <- c(100, 250, 500, 1000, 2500, 5000, 10000, 20000)
ff <- add_zoi_formula(f, zoi_radius = zois, pattern = "XXX",
                      cumulative = "",
                      type = c("exp_decay"),#, "nearest_exp_decay"),
                      separator = "", predictor_table = TRUE)
f <- ff$formula
pred_table <- ff$predictor_table

# sampling - random sampling
set.seed(1234)
samples <- create_resamples(y = dat$use,
                            p = c(0.2, 0.2, 0.2),
                            times = 20,
                            colH0 = NULL)

# fit multiple models
fittedl <- bag_fit_net_logit(f,
                             data = dat,
                             samples = samples,
                             standardize = "internal", # glmnet does the standardization of covariates
                             metric = "AUC",
                             method = "AdaptiveLasso",
                             predictor_table = pred_table,
                             parallel = "mclapply",
                             mc.cores = 8) #2)

# bag models in a single object
bag_object <- bag_models(fittedl, dat, score_threshold = 0.7)

bag_object$coef %*% bag_object$weights

sapply(fittedl, function(x) x$train_score)

#---
# plot to check

# ZOI public cabins cumulative
dfvar = data.frame(trails_cumulative = 1e3*seq(0.2, 20, length.out = 100))

# look into curve
plot_response(bag_object,
              dfvar = dfvar,
              data = dat,
              type = "linear", zoi = TRUE,
              type_feature =  "line",
              type_feature_recompute = TRUE,
              resolution = 300,
              ci = FALSE, indiv_pred = TRUE)
# with no line, just as an example
plot_response(bag_object,
              dfvar = dfvar,
              data = dat,
              type = "linear", zoi = TRUE,
              ci = FALSE, indiv_pred = TRUE)

# we try the function with the curve above, but then test how we could work with the more correct one below
# weirdness measures
weirdness(bag_object,
          data = dat)

# for each individual model
weirdness(bag_object,
          data = dat,
          wmean = FALSE)

NINAnor/oneimpact documentation built on June 14, 2025, 12:27 a.m.