Uncertainty tools

.Rbuildignore

@@ -28,3 +28,5 @@
 ^tests/vignettes$
 ^tests/vignettes/*$
 ^collaborations/*$
+^doc$
+^Meta$

.gitignore

@@ -31,3 +31,5 @@ src-i386/*
 paper/Drafts/submitted_revision*
 paper/Drafts/*.pdf
 collaborations/*
+/doc/
+/Meta/

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: ipmr
 Title: Integral Projection Models
-Version: 0.0.7
+Version: 0.0.8
 Authors@R: c( 
     person(given = "Sam",
            family = "Levin",
@@ -69,7 +69,12 @@ Imports:
     rlang (>= 0.3.0),
     stats,
     utils,
-    Rcpp
+    Rcpp,
+    dplyr,
+    ggplot2,
+    patchwork,
+    reshape2,
+    stringr
 Depends: R (>= 3.4)
 Config/testthat/parallel: true
 Config/testthat/edition: 3

NAMESPACE

@@ -56,6 +56,7 @@ S3method(parameters,default)
 S3method(parameters,proto_ipm)
 S3method(plot,general_di_det_ipm)
 S3method(plot,ipmr_matrix)
+S3method(plot,ipmr_uncertainty)
 S3method(plot,simple_di_det_ipm)
 S3method(plot,simple_di_stoch_kern_ipm)
 S3method(plot,simple_di_stoch_param_ipm)
@@ -73,6 +74,7 @@ S3method(print,ipmr_matrix)
 S3method(print,ipmr_mp_mesh)
 S3method(print,ipmr_parameters)
 S3method(print,ipmr_pop_state)
+S3method(print,ipmr_uncertainty)
 S3method(print,ipmr_vital_rate_exprs)
 S3method(print,ipmr_vital_rate_funs)
 S3method(print,proto_ipm)
@@ -138,80 +140,97 @@ export(quo_name)
 export(quos)
 export(right_ev)
 export(right_mult)
+export(sensitivity)
 export(sym)
 export(syms)
 export(truncated_distributions)
+export(uncertainty)
 export(use_vr_model)
 export(vital_rate_exprs)
 export(vital_rate_funs)
-importFrom(Rcpp,
-  evalCpp,
-  sourceCpp
-)
-importFrom(grDevices,
-  grey,
-  rainbow
-)
-importFrom(graphics,
-  abline,
-  axis,
-  contour,
-  image,
-  layout,
-  par
-)
+importFrom(Rcpp,evalCpp)
+importFrom(Rcpp,sourceCpp)
+importFrom(dplyr,bind_rows)
+importFrom(dplyr,group_by)
+importFrom(dplyr,join_by)
+importFrom(dplyr,left_join)
+importFrom(dplyr,rename)
+importFrom(dplyr,summarize)
+importFrom(ggplot2,aes)
+importFrom(ggplot2,element_blank)
+importFrom(ggplot2,element_text)
+importFrom(ggplot2,geom_col)
+importFrom(ggplot2,geom_point)
+importFrom(ggplot2,geom_rect)
+importFrom(ggplot2,geom_segment)
+importFrom(ggplot2,geom_vline)
+importFrom(ggplot2,ggplot)
+importFrom(ggplot2,guide_legend)
+importFrom(ggplot2,guides)
+importFrom(ggplot2,labs)
+importFrom(ggplot2,margin)
+importFrom(ggplot2,scale_color_manual)
+importFrom(ggplot2,scale_fill_manual)
+importFrom(ggplot2,theme)
+importFrom(ggplot2,theme_minimal)
+importFrom(grDevices,grey)
+importFrom(grDevices,rainbow)
+importFrom(graphics,abline)
+importFrom(graphics,axis)
+importFrom(graphics,contour)
+importFrom(graphics,image)
+importFrom(graphics,layout)
+importFrom(graphics,par)
 importFrom(magrittr,"%>%")
 importFrom(methods,hasArg)
-importFrom(purrr,
-  flatten,
-  map,
-  map2,
-  map_chr,
-  map_dbl
-)
-importFrom(rlang,
-  ":=",
-  .data,
-  as_environment,
-  call_args,
-  caller_env,
-  child_env,
-  empty_env,
-  enexpr,
-  enexprs,
-  enquo,
-  enquos,
-  ensym,
-  ensyms,
-  env_names,
-  env_parents,
-  eval_bare,
-  expr,
-  expr_text,
-  exprs,
-  is_empty,
-  is_quosure,
-  list2,
-  new_function,
-  parse_expr,
-  parse_exprs,
-  quo,
-  quo_is_null,
-  quo_name,
-  quo_text,
-  quos,
-  sym,
-  syms
-)
-importFrom(stats,
-  bw.nrd0,
-  dnorm,
-  na.omit,
-  runif,
-  setNames
-)
-importFrom(utils,
-  globalVariables,
-  packageDescription
-)
+importFrom(patchwork,plot_layout)
+importFrom(purrr,flatten)
+importFrom(purrr,map)
+importFrom(purrr,map2)
+importFrom(purrr,map_chr)
+importFrom(purrr,map_dbl)
+importFrom(reshape2,melt)
+importFrom(rlang,":=")
+importFrom(rlang,.data)
+importFrom(rlang,as_environment)
+importFrom(rlang,call_args)
+importFrom(rlang,caller_env)
+importFrom(rlang,child_env)
+importFrom(rlang,empty_env)
+importFrom(rlang,enexpr)
+importFrom(rlang,enexprs)
+importFrom(rlang,enquo)
+importFrom(rlang,enquos)
+importFrom(rlang,ensym)
+importFrom(rlang,ensyms)
+importFrom(rlang,env_names)
+importFrom(rlang,env_parents)
+importFrom(rlang,eval_bare)
+importFrom(rlang,expr)
+importFrom(rlang,expr_text)
+importFrom(rlang,exprs)
+importFrom(rlang,is_empty)
+importFrom(rlang,is_quosure)
+importFrom(rlang,list2)
+importFrom(rlang,new_function)
+importFrom(rlang,parse_expr)
+importFrom(rlang,parse_exprs)
+importFrom(rlang,quo)
+importFrom(rlang,quo_is_null)
+importFrom(rlang,quo_name)
+importFrom(rlang,quo_text)
+importFrom(rlang,quos)
+importFrom(rlang,sym)
+importFrom(rlang,syms)
+importFrom(stats,bw.nrd0)
+importFrom(stats,cov)
+importFrom(stats,dnorm)
+importFrom(stats,na.omit)
+importFrom(stats,runif)
+importFrom(stats,sd)
+importFrom(stats,setNames)
+importFrom(stats,var)
+importFrom(stringr,str_wrap)
+importFrom(utils,globalVariables)
+importFrom(utils,packageDescription)
 useDynLib(ipmr, .registration=TRUE)

NEWS.md

@@ -1,3 +1,15 @@
+# ipmr 0.0.8
+
+This release adds methods for quantifying how parameter uncertainty propagates through IPMs.
+
+## Features
+
+- Adds 'uncertainty()' to quantify the contribution of parameter uncertainty to variance in population growth rate ('lambda').
+
+- Adds 'sensitivity()' to calculate model sensitivity and elasticity to changes in parameter values.
+
+- Adds a new vignette demonstrating uncertainty analysis in 'ipmr'.
+
 # ipmr 0.0.7
 
 Fixes a test that was failing for `r-devel` on CRAN. There are no other changes.

R/generics.R

@@ -1018,6 +1018,49 @@ print.ipmr_vital_rate_funs <- function(x, ...) {
 
 }
 
+#' Print method for ipmr uncertainty objects
+#'
+#' @param x An object of class `ipmr_uncertainty`
+#' @param ... Unused
+#'
+#' @return \code{x} invisibly.
+#'
+#' @export
+print.ipmr_uncertainty <- function(x, ...) {
+
+  cat("\n")
+  cat("====================================\n")
+  cat(" ipmr_uncertainty object\n")
+  cat("====================================\n\n")
+
+  ## ---- Basic info
+  cat("Number of parameter samples:", nrow(x$lambdas), "\n")
+  cat("Number of parameters:", nrow(x$params_uncert), "\n\n")
+
+  ## ---- Lambda uncertainty
+  cat("Lambda variance:\n")
+  print(x$mod_uncert)
+  cat("\n")
+
+  ## ---- Parameter-level summary
+  cat("Top contributing parameters (by variance contribution):\n")
+  top <- x$params_uncert[order(-x$params_uncert$variance_prop), ]
+  print(utils::head(top[, c("parameter", "vital_rate", "variance_prop")], 5))
+  cat("\n")
+
+  ## ---- Vital-rate summary
+  if (!is.null(x$vr_uncert)) {
+    cat("Vital-rate contributions:\n")
+    print(x$vr_uncert)
+    cat("\n")
+  }
+
+  cat("Use `plot()` to visualize uncertainty decomposition.\n")
+  cat("====================================\n")
+
+  invisible(x)
+}
+
 # Lambda------------
 #' @title Compute the per-capita growth rate for an IPM object
 #' @rdname lambda
@@ -1880,6 +1923,83 @@ plot.general_di_det_ipm <- function(x = NULL, y = NULL,
 
 }
 
+#' Plot method for ipmr uncertainty objects
+#'
+#' @param x An object of class `ipmr_uncertainty`
+#' @param type Type of plot:
+#'   \itemize{
+#'     \item "param" - parameter-level 3-panel plot
+#'     \item "vr" - vital-rate aggregated contributions
+#'     \item "stacked" - stacked contributions vs lambda variance
+#'     \item "all" - returns all plots as a list
+#'   }
+#' @param vr_colors A named character vector of colors used to represent
+#'   vital rate categories in plots. Names must match the values in the
+#'   \code{vital_rate} column of the uncertainty output. If \code{NULL},
+#'   a default colorblind-friendly palette is used.
+#' @param ... Additional arguments passed to plotting functions
+#'
+#' @return A \code{ggplot} object or a list of plots.
+#'
+#' @export
+plot.ipmr_uncertainty <- function(x,
+                                  type = c("all", "param", "vr", "stacked"),
+                                  vr_colors = NULL,
+                                  ...) {
+
+  type <- match.arg(type)
+
+  if (!inherits(x, "ipmr_uncertainty")) {
+    stop("`x` must be an object of class 'ipmr_uncertainty'.")
+  }
+
+  default_cols <- c(
+    "#D0873C", # soft orange
+    "#8FB339", # olive green
+    "#7A5195", # muted purple
+    "#88CCEE", # light blue
+    "#332288", # deep blue
+    "#44AA99", # teal
+    "#882255", # dark red
+    "#DDCC77", # sand
+    "#C94C4C", # muted red
+    "#6C757D"  # grey
+  )
+
+  vr_levels <- unique(x$params_uncert$vital_rate)
+
+  if (is.null(vr_colors)) {
+    vr_colors <- setNames(
+      rep(default_cols, length.out = length(vr_levels)),
+      vr_levels
+    )
+  } else {
+    if (is.null(names(vr_colors))) {
+      stop("`vr_colors` must be a named vector with names matching vital rates.")
+    }
+
+    missing_cols <- setdiff(vr_levels, names(vr_colors))
+    if (length(missing_cols) > 0) {
+      stop("Missing colors for vital rates: ",
+           paste(missing_cols, collapse = ", "))
+    }
+  }
+
+  # Route to internal plotting helpers
+  plots <- list(
+    param   = .plot_uncert_param(x, vr_colors = vr_colors, ...),
+    vr      = .plot_uncert_vr(x, vr_colors = vr_colors, ...),
+    stacked = .plot_uncert_stacked(x, vr_colors = vr_colors, ...)
+  )
+
+  switch(type,
+         param   = plots$param,
+         vr      = plots$vr,
+         stacked = plots$stacked,
+         all     = plots
+  )
+}
+
 # right_ev ----------------
 
 #' @rdname eigenvectors

R/globals.R

@@ -0,0 +1,9 @@
+utils::globalVariables(
+  c(
+    "par1",
+    "parameter",
+    "variance_part",
+    "variance_sum",
+    "vital_rate"
+  )
+)