cond_diff: Extract Conditional Ahistorical Difference Matrices

In lefko3: Historical and Ahistorical Population Projection Matrix Analysis

Extract Conditional Ahistorical Difference Matrices

Description

Function cond_diff() takes a set of historical difference matrices resulting from function diff_lM() and decomposes them into ahistorical difference matrices conditional upon stage in time t-1.

Usage

cond_diff(lDiff, ref = 1L, matchoice = NULL, err_check = NULL)

Arguments

lDiff	An object of class lefkoDiff.
ref	Choice of mpm to use as reference. Defaults to 1, which means that the ahstages, hstages, and labels elements for mpm1 will be used for all calculations. Only 1 amd 2 are possible inputs.
matchoice	A character denoting whether to use A, U, or F matrices. Defaults to A matrices.
err_check	A logical value denoting whether to include a data frame of element equivalence from the conditional matrices to the original matrices. Used only for debugging purposes. Defaults to FALSE.

Value

A lefkoCondDiff object, with the following elements:

Mcond	A multi-level list holding the conditional matrices derived from the input lefkoDiff object. The top level of the list corresponds to each historical difference matrix in turn, and the lower level corresponds to each stage in time t-1, with individual conditional matrices named for the latter.
hstages	A data frame matrix showing the pairing of ahistorical stages used to create historical stage pairs.
ahstages	A data frame detailing the characteristics of associated ahistorical stages.
labels	A data frame showing the patch and year of each input full A matrix in order.
err_check	An optional data frame showing the order of used element indices to create conditional matrices.

Examples

sizevector <- c(0, 0, 0, 0, 0, 0, 1, 3, 6, 11, 19.5)
stagevector <- c("SD", "P1", "P2", "P3", "SL", "D", "XSm", "Sm", "Md", "Lg",
  "XLg")
repvector <- c(0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1)
obsvector <- c(0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1)
matvector <- c(0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1)
immvector <- c(0, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0)
propvector <- c(1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)
indataset <- c(0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1)
binvec <- c(0, 0, 0, 0, 0, 0.5, 0.5, 1.5, 1.5, 3.5, 5)
comments <- c("Dormant seed", "1st yr protocorm", "2nd yr protocorm",
  "3rd yr protocorm", "Seedling", "Dormant adult",
  "Extra small adult (1 shoot)", "Small adult (2-4 shoots)",
  "Medium adult (5-7 shoots)", "Large adult (8-14 shoots)",
  "Extra large adult (>14 shoots)")
cypframe_raw <- sf_create(sizes = sizevector, stagenames = stagevector, 
  repstatus = repvector, obsstatus = obsvector, matstatus = matvector,
  propstatus = propvector, immstatus = immvector, indataset = indataset, 
  binhalfwidth = binvec, comments = comments)

cypraw_v1 <- verticalize3(data = cypdata, noyears = 6, firstyear = 2004, 
  patchidcol = "patch", individcol = "plantid", blocksize = 4,
  sizeacol = "Inf2.04", sizebcol = "Inf.04", sizeccol = "Veg.04",
  repstracol = "Inf.04", repstrbcol = "Inf2.04", fecacol = "Pod.04",
  stageassign = cypframe_raw, stagesize = "sizeadded", NAas0 = TRUE,
  NRasRep = TRUE)

seeds_per_pod <- 5000

cypsupp2_raw <- supplemental(stage3 = c("SD", "P1", "P2", "P3", "SL", "SL", "D", 
    "XSm", "SD", "P1"),
  stage2 = c("SD", "SD", "P1", "P2", "P3", "SL", "SL", "SL", "rep", "rep"),
  eststage3 = c(NA, NA, NA, NA, NA, NA, "D", "XSm", NA, NA),
  eststage2 = c(NA, NA, NA, NA, NA, NA, "XSm", "XSm", NA, NA),
  givenrate = c(0.03, 0.15, 0.1, 0.1, 0.1, 0.05, NA, NA, NA, NA),
  multiplier = c(NA, NA, NA, NA, NA, NA, NA, NA, (0.5 * seeds_per_pod),
    (0.5 * seeds_per_pod)),
  type =c(1, 1, 1, 1, 1, 1, 1, 1, 3, 3),
  stageframe = cypframe_raw, historical = FALSE)
cypsupp3_raw <- supplemental(stage3 = c("SD", "SD", "P1", "P1", "P2", "P3", "SL",
    "D", "XSm", "Sm", "D", "XSm", "Sm", "mat", "mat", "mat", "SD", "P1"),
  stage2 = c("SD", "SD", "SD", "SD", "P1", "P2", "P3", "SL", "SL", "SL", "SL",
    "SL", "SL", "D", "XSm", "Sm", "rep", "rep"),
  stage1 = c("SD", "rep", "SD", "rep", "SD", "P1", "P2", "P3", "P3", "P3",
    "SL", "SL", "SL", "SL", "SL", "SL", "mat", "mat"),
  eststage3 = c(NA, NA, NA, NA, NA, NA, NA, "D", "XSm", "Sm", "D", "XSm", "Sm",
    "mat", "mat", "mat", NA, NA),
  eststage2 = c(NA, NA, NA, NA, NA, NA, NA, "XSm", "XSm", "XSm", "XSm", "XSm",
    "XSm", "D", "XSm", "Sm", NA, NA),
  eststage1 = c(NA, NA, NA, NA, NA, NA, NA, "XSm", "XSm", "XSm", "XSm", "XSm",
    "XSm", "XSm", "XSm", "XSm", NA, NA),
  givenrate = c(0.1, 0.1, 0.2, 0.2, 0.2, 0.2, 0.25, NA, NA, NA, NA, NA, NA,
    NA, NA, NA, NA, NA),
  multiplier = c(NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,
    NA, 0.5, 0.5),
  type = c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 3, 3),
  type_t12 = c(1, 2, 1, 2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1),
  stageframe = cypframe_raw, historical = TRUE)

cypmatrix2rp <- rlefko2(data = cypraw_v1, stageframe = cypframe_raw,
  year = "all", patch = "all", stages = c("stage3", "stage2"),
  size = c("size3added", "size2added"), supplement = cypsupp2_raw, 
  yearcol = "year2", patchcol = "patchid", indivcol = "individ")

cypmatrix2r <- rlefko2(data = cypraw_v1, stageframe = cypframe_raw,
  year = "all", stages = c("stage3", "stage2"),
  size = c("size3added", "size2added"), supplement = cypsupp2_raw, 
  yearcol = "year2", patchcol = "patchid", indivcol = "individ")

cypmatrix3rp <- rlefko3(data = cypraw_v1, stageframe = cypframe_raw,
  year = "all", patch = "all", stages = c("stage3", "stage2", "stage1"), 
  size = c("size3added", "size2added", "size1added"), supplement = cypsupp3_raw, 
  yearcol = "year2", patchcol = "patchid", indivcol = "individ")

cypmatrix3r <- rlefko3(data = cypraw_v1, stageframe = cypframe_raw,
  year = "all", stages = c("stage3", "stage2", "stage1"), 
  size = c("size3added", "size2added", "size1added"), supplement = cypsupp3_raw, 
  yearcol = "year2", patchcol = "patchid", indivcol = "individ")

cypmatrix2r_3 <- hist_null(cypmatrix2r)
cypmatrix2r_3 <- delete_lM(cypmatrix2r_3, year = 2004)
diff_r <- diff_lM(cypmatrix3r, cypmatrix2r_3)

cypmatrix2rp_3 <- hist_null(cypmatrix2rp)
cypmatrix2rp_3 <- delete_lM(cypmatrix2rp_3, year = 2004)
diff_rp <- diff_lM(cypmatrix3rp, cypmatrix2rp_3)

condr1 <- cond_diff(diff_r, ref = 1)
condr2 <- cond_diff(diff_r, ref = 2)

condrp1 <- cond_diff(diff_rp, matchoice = "U", ref = 1)
condrp2 <- cond_diff(diff_rp, matchoice = "F", ref = 2)

lefko3 documentation built on Oct. 14, 2023, 1:07 a.m.