## ----setup, include = FALSE---------------------------------------------------
knitr::opts_chunk$set(
  collapse = TRUE,
  comment  = "#>",
  fig.width  = 7,
  fig.height = 5
)

## ----data---------------------------------------------------------------------
library(raretrans)

stage_names <- c("Dormant", "Smallest", "Small",
                 "Intermediate", "Large", "Extra Large")

# matU: survival and growth transitions only (matA = matU + matF + matC)
# Source: COMPADRE MatrixID 242623
# Shefferson et al. (2001) Conservation Biology
# DOI: 10.1111/j.1523-1739.2010.01466.x
matU <- matrix(
  c(0.78, 0.00, 0.00, 0.00, 0.00, 0.00,
    0.06, 0.42, 0.03, 0.00, 0.00, 0.00,
    0.00, 0.24, 0.62, 0.05, 0.00, 0.00,
    0.00, 0.00, 0.21, 0.73, 0.06, 0.00,
    0.00, 0.00, 0.00, 0.12, 0.74, 0.07,
    0.00, 0.00, 0.00, 0.00, 0.11, 0.83),
  nrow = 6, ncol = 6, byrow = TRUE,
  dimnames = list(stage_names, stage_names)
)

# Construct TF list (no fecundity in matU so F is all zeros)
F_mat <- matrix(0, nrow = 6, ncol = 6,
                dimnames = list(stage_names, stage_names))
TF <- list(T = matU, F = F_mat)

# Observed stage distribution (number of individuals per stage)
N <- c(15, 12, 28, 34, 22, 10)
names(N) <- stage_names

matU

## ----cri_default--------------------------------------------------------------
cri_uniform <- transition_CrI(TF, N, stage_names = stage_names)
head(cri_uniform, 10)

## ----plot_with_dead, fig.cap = "Posterior transition probabilities with 95% credible intervals for all fates including mortality."----
plot_transition_CrI(cri_uniform,
                    title = "Cypripedium calceolus — uniform prior")

## ----plot_no_dead, fig.cap = "Posterior transition probabilities excluding the dead fate."----
plot_transition_CrI(cri_uniform,
                    include_dead = FALSE,
                    title = "Cypripedium calceolus — transitions only")

## ----prior_comparison---------------------------------------------------------
# Uninformative prior (default)
cri_uninf <- transition_CrI(TF, N,
                             priorweight  = -1,
                             stage_names  = stage_names)

# Weakly informative prior (25% of sample size)
cri_weak  <- transition_CrI(TF, N,
                             priorweight  = 25,
                             stage_names  = stage_names)

# Strongly informative prior (100% of sample size)
cri_strong <- transition_CrI(TF, N,
                              priorweight = 100,
                              stage_names = stage_names)

# Compare interval widths for the Dormant stage
comp <- data.frame(
  prior      = c("Uninformative", "Weak (25%)", "Strong (100%)"),
  mean_width = c(
    mean(cri_uninf[cri_uninf$from_stage  == "Dormant", "upper"] -
         cri_uninf[cri_uninf$from_stage  == "Dormant", "lower"]),
    mean(cri_weak[cri_weak$from_stage    == "Dormant", "upper"] -
         cri_weak[cri_weak$from_stage    == "Dormant", "lower"]),
    mean(cri_strong[cri_strong$from_stage == "Dormant", "upper"] -
         cri_strong[cri_strong$from_stage == "Dormant", "lower"])
  )
)
comp

## ----plot_prior_comparison, fig.height = 10, fig.cap = "Effect of prior weight on credible interval width. Stronger priors narrow the intervals and pull means toward equal transition probabilities."----
library(ggplot2)

cri_uninf$prior  <- "Uninformative"
cri_weak$prior   <- "Weak (25%)"
cri_strong$prior <- "Strong (100%)"

cri_all <- rbind(cri_uninf, cri_weak, cri_strong)
cri_all$prior <- factor(cri_all$prior,
                        levels = c("Uninformative",
                                   "Weak (25%)",
                                   "Strong (100%)"))

ggplot(cri_all,
       aes(x = to_stage, y = mean, ymin = lower, ymax = upper,
           colour = prior)) +
  geom_pointrange(position = position_dodge(width = 0.5)) +
  facet_wrap(~from_stage, scales = "free_x") +
  scale_y_continuous(limits = c(0, 1)) +
  scale_colour_manual(values = c("Uninformative" = "grey40",
                                 "Weak (25%)"    = "steelblue",
                                 "Strong (100%)" = "firebrick")) +
  labs(x      = "Destination stage",
       y      = "Transition probability",
       colour = "Prior weight",
       title  = "Effect of prior weight on credible intervals",
       subtitle = "Cypripedium calceolus — matU") +
  theme_bw() +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))

## ----density_uninf, fig.width = 9, fig.height = 8, fig.cap = "Full posterior beta densities for all transitions with uninformative prior. Shaded region = 95% credible interval."----
plot_transition_density(TF, N,
                        stage_names  = stage_names,
                        title        = "Cypripedium calceolus — uninformative prior")

## ----density_strong, fig.width = 9, fig.height = 8, fig.cap = "Posterior beta densities with a strong prior (100% of sample size)."----
plot_transition_density(TF, N,
                        priorweight  = 100,
                        stage_names  = stage_names,
                        title        = "Cypripedium calceolus — strong prior (100%)")

## ----density_no_dead, fig.width = 9, fig.height = 7, fig.cap = "Posterior densities for survival transitions only (dead fate excluded)."----
plot_transition_density(TF, N,
                        stage_names  = stage_names,
                        include_dead = FALSE,
                        title        = "Cypripedium calceolus — transitions only")