R/brms_segmentedForm.R

Defines functions .gumbelChngptForm .frechetChngptForm .weibullChngptForm .decayChngptForm .gamChngptForm .intChngptForm .logarithmicChngptForm .powerlawChngptForm .exponentialChngptForm .monomolecularChngptForm .gompertzChngptForm .logisticChngptForm .linearChngptForm .handleSplineSegments .brmsChangePointHelper

#' Helper function to put together formulae for brms changepoint growth models
#'
#' @param model A multi-part model passed from brmSS passed from \code{\link{growthSS}}
#' @param x The x variable from the pcvrForm argument in \code{\link{growthSS}}
#' @param y The y variable from the pcvrForm argument in \code{\link{growthSS}}
#' @param group The grouping variable from the pcvrForm argument in \code{\link{growthSS}}
#' @param dpar Logical, is this a distributional parameter formula (TRUE) or part of the main growth
#' formula (FALSE)?
#' @param nTimes a Number of times that are present in the data, only used for making splines have a
#' workable number of knots.
#' @param useGroup logical, should groups be used?
#' @param priors A list describing priors in the style of \code{\link{brmSS}}, \code{\link{growthSS}},
#' and \code{\link{growthSim}}. This is only used currently to identify fixed and estimated
#' changepoints. If a changepoint is called "changePointX" with X being its position in the formula
#' then it will be estimated as a parameter in the model, but if the changepoint is called
#' "fixedChangePointX" then it will be passed as a numeric in the growth model.
#' @param int logical, should an intercept be modeled?
#'
#' @examples
#' df1 <- do.call(rbind, lapply(1:30, function(i) {
#'   chngpt <- rnorm(2, 10, 1.5)
#'   A <- growthSim("linear", n = 1, t = chngpt[1], params = list("A" = c(1)))
#'   B <- growthSim("linear", n = 1, t = chngpt[2], params = list("A" = c(0.9)))
#'   B$group <- "b"
#'   x <- rbind(A, B)
#'   x$id <- paste0("id_", i)
#'   x
#' }))
#' df2 <- growthSim("linear", n = 30, t = 20, params = list("A" = c(4.1, 5)))
#' df2 <- do.call(rbind, lapply(unique(paste0(df2$id, df2$group)), function(int) {
#'   df1sub <- df1[paste0(df1$id, df1$group) == int, ]
#'   df2sub <- df2[paste0(df2$id, df2$group) == int, ]
#'   y_end <- df1sub[df1sub$time == max(df1sub$time), "y"]
#'   df2sub$time <- df2sub$time + max(df1sub$time)
#'   df2sub$y <- y_end + df2sub$y
#'   df2sub
#' }))
#' df <- rbind(df1, df2)
#' ggplot(df, aes(time, y, group = interaction(group, id))) +
#'   geom_line(aes(color = group)) +
#'   theme_minimal()
#'
#' .brmsChangePointHelper(model = "linear + linear", x = "time", y = "y", group = "group")
#'
#' @keywords internal
#' @noRd

.brmsChangePointHelper <- function(model, x, y, group, dpar = FALSE,
                                   nTimes = 25, useGroup, priors, int = FALSE) {
  component_models <- trimws(strsplit(model, "\\+")[[1]])
  models <- c(
    "logistic", "gompertz", "monomolecular", "exponential", "linear", "power law", "gam",
    "spline", "int", "homo", "weibull", "frechet", "gumbel", "logarithmic"
  )

  if (dpar) {
    prefix <- y
  } else {
    prefix <- NULL
  }

  mainGrowthModelPriorStrings <- paste(
    paste0("^", gsub(
      " ", "",
      c(models, "changePoint", "fixedChangePoint")
    )),
    collapse = "|"
  )
  if (dpar) {
    priors <- priors[grepl(prefix, names(priors))]
  } else {
    priors <- priors[grepl(mainGrowthModelPriorStrings, names(priors))]
  }
  # else should be any prior whose name starts with a model name,
  # with changePoint or with fixedChangePoint.

  formulae <- lapply(seq_along(component_models), function(i) {
    iter_model <- component_models[i]

    if (grepl("decay", iter_model)) {
      decay <- TRUE
      iter_model <- trimws(gsub("decay", "", iter_model))
    } else {
      decay <- FALSE
    }

    matched_iter_model <- match.arg(iter_model, models)
    matched_iter_model <- gsub("homo", "int", matched_iter_model) # recoding
    matched_iter_model <- gsub("spline", "gam", matched_iter_model) # recoding

    chngptFormFun <- get(paste0(".", gsub(" ", "", matched_iter_model), "ChngptForm"))
    iter <- chngptFormFun(x, i, dpar = prefix, priors)
    if (decay) {
      iter <- .decayChngptForm(iter)
    }
    return(iter)
  })

  params <- unique(unlist(lapply(formulae, function(f) {
    return(f$params)
  })))
  params <- params[-length(params)]

  if (int) { # for changepoint models with an intercept add I term to formula and params
    formula_starter_string <- paste0(y, " ~ ", prefix, "I + ")
    params <- append(params, paste0(prefix, "I"))
  } else {
    formula_starter_string <- paste0(y, " ~ ")
  }

  growthForm <- paste0(formula_starter_string, formulae[[1]]$form, " * ", formulae[[1]]$cp)
  #* Make cpInt cumulative
  for (i in 2:length(formulae)) {
    cumulativeCpInt <- do.call(paste, list(lapply(1:i, function(o) {
      return(formulae[[o]]$cpInt)
    }), collapse = " + "))
    formulae[[i]]$cpInt <- cumulativeCpInt
  }
  # assemble segments into complete formula
  for (i in 2:length(formulae)) {
    nextPhase <- paste0(
      "+ (", formulae[[(i - 1)]]$cpInt, " + ", formulae[[i]]$form, ") * ",
      formulae[[i]]$cp
    )
    growthForm <- paste0(growthForm, nextPhase)
  }
  tryCatch(
    expr = {
      growthForm <- stats::as.formula(growthForm)
    },
    error = function(err) {
      message(paste0(
        "Error while assembling changepoint formula, did you specify priors for ",
        paste(params, collapse = ", "), "? Changepoint priors must be named."
      ))
      message("The original Error message is:")
      stop(conditionMessage(err))
    }
  )
  growthForm <- stats::as.formula(growthForm)

  if (dpar) {
    growthForm <- brms::nlf(growthForm)
  }

  splineSegments <- which(unlist(lapply(formulae, function(fml) {
    return("splineVar" %in% names(fml))
  })))

  splineForm <- .handleSplineSegments(splineSegments, useGroup, group, nTimes, formulae, x)

  return(list("growthForm" = growthForm, "pars" = params, "splineHelperForm" = splineForm))
}

#* ****************************************
#* ***** `Handle Spline Segments` *****
#* ****************************************

#' spline formula helper function
#' @keywords internal
#' @noRd

.handleSplineSegments <- function(splineSegments, useGroup, group, nTimes, formulae, x) {
  if (length(splineSegments) > 0) {
    if (useGroup) {
      by <- paste0(", by = ", paste(group, collapse = ":"))
    } else {
      by <- ","
    }
    if (nTimes < 11) {
      k <- paste0(", k = ", nTimes)
    } else {
      k <- NULL
    }
    splineVars <- c()
    for (seg in splineSegments) {
      splineVars <- c(splineVars, formulae[[seg]]$splineVar)
    }
    lhs <- paste0(splineVars, collapse = "+")
    rhs <- paste0("s(", x, by, k, ")")
    splineForm <- paste0(lhs, "~", rhs)
  } else {
    splineForm <- NULL
  }
  return(splineForm)
}


#* ****************************************
#* ***** `Linear Changepoint Phase` *****
#* ****************************************

#' Linear changepoint section function
#'
#' @param x X variable name
#' @param position Position in growth formula ("1" + "2" + "3"... etc)
#' @param dpar string or NULL, if string should be the name of the distributional parameter
#' @param priors a list of prior distributions (used for fixed vs estimated changepoints)
#'
#' @examples
#'
#' .linearChngptForm(x = "time", 1)
#' .linearChngptForm(x = "time", 2)
#' .linearChngptForm(x = "time", 3)
#'
#' @return a list with form, cp, and cpInt elements. "form" is the growth formula
#' for this phase of the model. "cp" is the inv_logit function defining when this
#' phase should happen. "cpInt" is the value at the end of this growth phase and is
#' used in starting the next growth phase from the right y value.
#' @noRd

.linearChngptForm <- function(x, position = 1, dpar = NULL, priors) { # return f, cp, and cpInt

  prefix <- chngptPrefix <- dpar

  if (any(grepl(paste0("fixedChangePoint", position), names(priors)))) {
    changePointObj <- as.numeric(priors[[paste0(prefix, "fixedChangePoint", position)]])[1]
    fixed <- TRUE
    chngptPrefix <- NULL # never a prefix if the changepoint is a fixed value, even in sub model
  } else {
    fixed <- FALSE
  }

  if (position == 1) {
    if (!fixed) {
      changePointObj <- "changePoint1"
    }

    form <- paste0(prefix, "linear", position, "A * ", x)
    cp <- paste0("inv_logit((", chngptPrefix, changePointObj, " - ", x, ") * 5)")
    cpInt <- paste0("(", prefix, "linear", position, "A * ", chngptPrefix, changePointObj, ")")
  } else {
    all_chngpts <- names(priors)[grepl("fixedChangePoint*|changePoint*", names(priors))]
    prevChangePoints <- all_chngpts[which(as.numeric(sub(".*hangePoint", "", all_chngpts)) < position)]
    prevAndCurrentChangePoints <- all_chngpts[which(
      as.numeric(sub(".*hangePoint", "", all_chngpts)) %in% c(position, position - 1)
    )]
    #* per location where "fixed" is in the prior name, replace the name with that number.
    prev_fixed_index <- which(grepl("fixed", prevChangePoints))
    if (length(prev_fixed_index) > 0) {
      prevChangePoints[prev_fixed_index] <- as.numeric(priors[prevChangePoints[prev_fixed_index]])
    }
    pac_fixed_index <- which(grepl("fixed", prevAndCurrentChangePoints))
    if (length(pac_fixed_index) > 0) {
      prevAndCurrentChangePoints[pac_fixed_index] <- as.numeric(
        priors[prevAndCurrentChangePoints[pac_fixed_index]]
      )
    }

    form <- paste0(
      prefix, "linear", position, "A * (", x, "-",
      paste0(prevChangePoints, collapse = "-"), ")"
    )
    cp <- paste0("inv_logit((", x, "-", paste0(prevChangePoints, collapse = "-"), ") * 5)")
    cpInt <- paste0(
      prefix, "linear", position, "A * (", paste0(rev(prevAndCurrentChangePoints),
        collapse = "-"
      ),
      ")"
    )
    #* cpInt would be wrong for the last position but it isn't used.
  }

  pars <- paste0(prefix, "linear", position, "A")
  if (!fixed) {
    pars <- c(pars, paste0(chngptPrefix, "changePoint", position))
  }

  return(list(
    "form" = form,
    "cp" = cp,
    "cpInt" = cpInt,
    "params" = pars
  ))
}


#* ****************************************
#* ***** `Logistic Changepoint Phase` *****
#* ****************************************

#' Logistic changepoint section function
#'
#' @param x X variable name
#' @param position Position in growth formula ("1" + "2" + "3"... etc)
#' @param dpar string or NULL, if string should be the name of the distributional parameter
#' @param priors a list of prior distributions (used for fixed vs estimated changepoints)
#'
#' @examples
#'
#' .logisticChngptForm(x = "time", 1)
#' .logisticChngptForm(x = "time", 2)
#' .logisticChngptForm(x = "time", 3)
#'
#' @return a list with form, cp, and cpInt elements. "form" is the growth formula
#' for this phase of the model. "cp" is the inv_logit function defining when this
#' phase should happen. "cpInt" is the value at the end of this growth phase and is
#' used in starting the next growth phase from the right y value.
#'
#' @noRd

.logisticChngptForm <- function(x, position = 1, dpar = NULL, priors) { # return f, cp, and cpInt

  prefix <- chngptPrefix <- dpar

  if (any(grepl(paste0("fixedChangePoint", position), names(priors)))) {
    changePointObj <- as.numeric(priors[[paste0(prefix, "fixedChangePoint", position)]])[1]
    fixed <- TRUE
    chngptPrefix <- NULL # never a prefix if the changepoint is a fixed value
  } else {
    fixed <- FALSE
  }

  if (position == 1) {
    if (!fixed) {
      changePointObj <- "changePoint1"
    }

    form <- paste0(
      prefix, "logistic", position, "A / (1 + exp( (", prefix, "logistic", position,
      "B-(", x, "))/", prefix, "logistic", position, "C) )"
    )
    cp <- paste0("inv_logit((", chngptPrefix, changePointObj, " - ", x, ") * 5)")
    cpInt <- paste0(
      prefix, "logistic", position, "A / (1 + exp( (", prefix, "logistic", position,
      "B-(", chngptPrefix, changePointObj, "))/", prefix, "logistic", position, "C) )"
    )
  } else {
    all_chngpts <- names(priors)[grepl("fixedChangePoint*|changePoint*", names(priors))]
    prevChangePoints <- all_chngpts[which(as.numeric(sub(".*hangePoint", "", all_chngpts)) < position)]
    prevAndCurrentChangePoints <- all_chngpts[which(
      as.numeric(sub(".*hangePoint", "", all_chngpts)) %in% c(position, position - 1)
    )]
    #* per location where "fixed" is in the prior name, replace the name with that number.
    prev_fixed_index <- which(grepl("fixed", prevChangePoints))
    if (length(prev_fixed_index) > 0) {
      prevChangePoints[prev_fixed_index] <- as.numeric(priors[prevChangePoints[prev_fixed_index]])
    }
    pac_fixed_index <- which(grepl("fixed", prevAndCurrentChangePoints))
    if (length(pac_fixed_index) > 0) {
      prevAndCurrentChangePoints[pac_fixed_index] <- as.numeric(
        priors[prevAndCurrentChangePoints[pac_fixed_index]]
      )
    }

    form <- paste0(
      prefix, "logistic", position, "A / (1 + exp( (", prefix, "logistic", position,
      "B-(", x, "-", paste0(prevChangePoints, collapse = "-"),
      "))/", prefix, "logistic", position, "C) )"
    )
    cp <- paste0("inv_logit((", x, "-", paste0(prevChangePoints, collapse = "-"), ") * 5)")
    cpInt <- paste0(
      prefix, "logistic", position, "A / (1 + exp( (", prefix, "logistic", position,
      "B-(", paste0(rev(prevAndCurrentChangePoints), collapse = "-"), "))/", prefix, "logistic",
      position, "C) )"
    )
  }
  pars <- paste0(prefix, "logistic", position, c("A", "B", "C"))
  if (!fixed) {
    pars <- c(pars, paste0(chngptPrefix, "changePoint", position))
  }
  return(list(
    "form" = form,
    "cp" = cp,
    "cpInt" = cpInt,
    "params" = pars
  ))
}


#* ****************************************
#* ***** `Gompertz Changepoint Phase` *****
#* ****************************************

#' Gompertz changepoint section function
#'
#' @param x X variable name
#' @param position Position in growth formula ("1" + "2" + "3"... etc)
#' @param dpar string or NULL, if string should be the name of the distributional parameter
#' @param priors a list of prior distributions (used for fixed vs estimated changepoints)
#'
#' @examples
#'
#' .gompertzChngptForm(x = "time", 1)
#' .gompertzChngptForm(x = "time", 2)
#' .gompertzChngptForm(x = "time", 3)
#'
#' @return a list with form, cp, and cpInt elements. "form" is the growth formula
#' for this phase of the model. "cp" is the inv_logit function defining when this
#' phase should happen. "cpInt" is the value at the end of this growth phase and is
#' used in starting the next growth phase from the right y value.
#' @noRd

.gompertzChngptForm <- function(x, position = 1, dpar = NULL, priors) { # return f, cp, and cpInt

  prefix <- chngptPrefix <- dpar

  if (any(grepl(paste0("fixedChangePoint", position), names(priors)))) {
    changePointObj <- as.numeric(priors[[paste0(prefix, "fixedChangePoint", position)]])[1]
    fixed <- TRUE
    chngptPrefix <- NULL # never a prefix if the changepoint is a fixed value
  } else {
    fixed <- FALSE
  }

  if (position == 1) {
    if (!fixed) {
      changePointObj <- "changePoint1"
    }
    form <- paste0(
      prefix, "gompertz", position, "A * exp(-", prefix, "gompertz", position,
      "B * exp(-", prefix, "gompertz", position, "C * ", x, "))"
    )
    cp <- paste0("inv_logit((", prefix, changePointObj, " - ", x, ") * 5)")
    cpInt <- paste0(
      prefix, "gompertz", position, "A * exp(-", prefix, "gompertz", position,
      "B * exp(-", prefix, "gompertz", position, "C * ", chngptPrefix, changePointObj,
      "))"
    )
  } else {
    all_chngpts <- names(priors)[grepl("fixedChangePoint*|changePoint*", names(priors))]
    prevChangePoints <- all_chngpts[which(as.numeric(sub(".*hangePoint", "", all_chngpts)) < position)]
    prevAndCurrentChangePoints <- all_chngpts[which(
      as.numeric(sub(".*hangePoint", "", all_chngpts)) %in% c(position, position - 1)
    )]
    #* per location where "fixed" is in the prior name, replace the name with that number.
    prev_fixed_index <- which(grepl("fixed", prevChangePoints))
    if (length(prev_fixed_index) > 0) {
      prevChangePoints[prev_fixed_index] <- as.numeric(priors[prevChangePoints[prev_fixed_index]])
    }
    pac_fixed_index <- which(grepl("fixed", prevAndCurrentChangePoints))
    if (length(pac_fixed_index) > 0) {
      prevAndCurrentChangePoints[pac_fixed_index] <- as.numeric(
        priors[prevAndCurrentChangePoints[pac_fixed_index]]
      )
    }

    form <- paste0(
      prefix, "gompertz", position, "A * exp(-", prefix, "gompertz", position,
      "B * exp(-", prefix, "gompertz", position, "C * (", x, " - ",
      paste0(prevChangePoints, collapse = "-"), ")))"
    )

    cp <- paste0("inv_logit((", x, "-", paste0(prevChangePoints, collapse = "-"), ") * 5)")
    cpInt <- paste0(
      prefix, "gompertz", position, "A * exp(-", prefix, "gompertz", position, "B * exp(-", prefix,
      "gompertz", position,
      "C * (", paste0(rev(prevAndCurrentChangePoints), collapse = "-"), "))"
    )
  }
  pars <- paste0(prefix, "gompertz", position, c("A", "B", "C"))
  if (!fixed) {
    pars <- c(pars, paste0(chngptPrefix, "changePoint", position))
  }
  return(list(
    "form" = form,
    "cp" = cp,
    "cpInt" = cpInt,
    "params" = pars
  ))
}

#* ****************************************
#* ***** `monomolecular Changepoint Phase` *****
#* ****************************************

#' Monomolecular changepoint section function
#'
#' @param x X variable name
#' @param position Position in growth formula ("1" + "2" + "3"... etc)
#' @param dpar string or NULL, if string should be the name of the distributional parameter
#' @param priors a list of prior distributions (used for fixed vs estimated changepoints)
#'
#' @examples
#'
#' .monomolecularChngptForm(x = "time", 1)
#' .monomolecularChngptForm(x = "time", 2)
#' .monomolecularChngptForm(x = "time", 3)
#'
#' @return a list with form, cp, and cpInt elements. "form" is the growth formula
#' for this phase of the model. "cp" is the inv_logit function defining when this
#' phase should happen. "cpInt" is the value at the end of this growth phase and is
#' used in starting the next growth phase from the right y value.
#'
#' @noRd

.monomolecularChngptForm <- function(x, position = 1, dpar = NULL, priors) { # return f, cp, and cpInt

  prefix <- chngptPrefix <- dpar

  if (any(grepl(paste0("fixedChangePoint", position), names(priors)))) {
    changePointObj <- as.numeric(priors[[paste0(prefix, "fixedChangePoint", position)]])[1]
    fixed <- TRUE
    chngptPrefix <- NULL # never a prefix if the changepoint is a fixed value
  } else {
    fixed <- FALSE
  }

  if (position == 1) {
    if (!fixed) {
      changePointObj <- "changePoint1"
    }
    form <- paste0(
      prefix, "monomolecular", position, "A-", prefix, "monomolecular", position,
      "A * exp(-", prefix, "monomolecular", position, "B * ", x, ")"
    )
    cp <- paste0("inv_logit((", chngptPrefix, changePointObj, " - ", x, ") * 5)")
    cpInt <- paste0(
      prefix, "monomolecular", position, "A-", prefix, "monomolecular", position,
      "A * exp(-", prefix, "monomolecular", position, "B * ", chngptPrefix,
      changePointObj, ")"
    )
  } else {
    all_chngpts <- names(priors)[grepl("fixedChangePoint*|changePoint*", names(priors))]
    prevChangePoints <- all_chngpts[which(as.numeric(sub(".*hangePoint", "", all_chngpts)) < position)]
    prevAndCurrentChangePoints <- all_chngpts[which(
      as.numeric(sub(".*hangePoint", "", all_chngpts)) %in% c(position, position - 1)
    )]
    #* per location where "fixed" is in the prior name, replace the name with that number.
    prev_fixed_index <- which(grepl("fixed", prevChangePoints))
    if (length(prev_fixed_index) > 0) {
      prevChangePoints[prev_fixed_index] <- as.numeric(priors[prevChangePoints[prev_fixed_index]])
    }
    pac_fixed_index <- which(grepl("fixed", prevAndCurrentChangePoints))
    if (length(pac_fixed_index) > 0) {
      prevAndCurrentChangePoints[pac_fixed_index] <- as.numeric(
        priors[prevAndCurrentChangePoints[pac_fixed_index]]
      )
    }

    form <- paste0(
      prefix, "monomolecular", position, "A-", prefix, "monomolecular", position, "A * exp(-",
      prefix, "monomolecular", position, "B * ", x, "-",
      paste0(prevChangePoints, collapse = "-"), ")"
    )
    cp <- paste0("inv_logit((", x, "-", paste0(prevChangePoints, collapse = "-"), ") * 5)")
    cpInt <- paste0(
      prefix, "monomolecular", position, "A-", prefix, "monomolecular", position, "A * exp(-",
      prefix, "monomolecular", position, "B * ",
      paste0(rev(prevAndCurrentChangePoints), collapse = "-"), ")"
    )
  }
  pars <- paste0(prefix, "monomolecular", position, c("A", "B"))
  if (!fixed) {
    pars <- c(pars, paste0(chngptPrefix, "changePoint", position))
  }
  return(list(
    "form" = form,
    "cp" = cp,
    "cpInt" = cpInt,
    "params" = pars
  ))
}


#* ****************************************
#* ***** `Exponential Changepoint Phase` *****
#* ****************************************

#' Exponential changepoint section function
#'
#' @param x X variable name
#' @param position Position in growth formula ("1" + "2" + "3"... etc)
#' @param dpar string or NULL, if string should be the name of the distributional parameter
#' @param priors a list of prior distributions (used for fixed vs estimated changepoints)
#'
#' @examples
#'
#' .exponentialChngptForm(x = "time", 1)
#' .exponentialChngptForm(x = "time", 2)
#' .exponentialChngptForm(x = "time", 3)
#'
#' @return a list with form, cp, and cpInt elements. "form" is the growth formula
#' for this phase of the model. "cp" is the inv_logit function defining when this
#' phase should happen. "cpInt" is the value at the end of this growth phase and is
#' used in starting the next growth phase from the right y value.
#' @noRd

.exponentialChngptForm <- function(x, position = 1, dpar = NULL, priors) { # return f, cp, and cpInt

  prefix <- chngptPrefix <- dpar

  if (any(grepl(paste0("fixedChangePoint", position), names(priors)))) {
    changePointObj <- as.numeric(priors[[paste0(prefix, "fixedChangePoint", position)]])[1]
    fixed <- TRUE
    chngptPrefix <- NULL # never a prefix if the changepoint is a fixed value
  } else {
    fixed <- FALSE
  }

  if (position == 1) {
    if (!fixed) {
      changePointObj <- "changePoint1"
    }

    form <- paste0(
      prefix, "exponential", position, "A * exp(", prefix, "exponential", position,
      "B * ", x, ")"
    )
    cp <- paste0("inv_logit((", chngptPrefix, changePointObj, " - ", x, ") * 5)")
    cpInt <- paste0(
      prefix, "exponential", position, "A * exp(", prefix, "exponential", position,
      "B * ", chngptPrefix, changePointObj, ")"
    )
  } else {
    all_chngpts <- names(priors)[grepl("fixedChangePoint*|changePoint*", names(priors))]
    prevChangePoints <- all_chngpts[which(as.numeric(sub(".*hangePoint", "", all_chngpts)) < position)]
    prevAndCurrentChangePoints <- all_chngpts[which(
      as.numeric(sub(".*hangePoint", "", all_chngpts)) %in% c(position, position - 1)
    )]
    #* per location where "fixed" is in the prior name, replace the name with that number.
    prev_fixed_index <- which(grepl("fixed", prevChangePoints))
    if (length(prev_fixed_index) > 0) {
      prevChangePoints[prev_fixed_index] <- as.numeric(priors[prevChangePoints[prev_fixed_index]])
    }
    pac_fixed_index <- which(grepl("fixed", prevAndCurrentChangePoints))
    if (length(pac_fixed_index) > 0) {
      prevAndCurrentChangePoints[pac_fixed_index] <- as.numeric(
        priors[prevAndCurrentChangePoints[pac_fixed_index]]
      )
    }

    form <- paste0(
      prefix, "exponential", position, "A * exp(", prefix, "exponential", position, "B * (",
      x, "-", paste0(prevChangePoints, collapse = "-"), "))"
    )
    cp <- paste0("inv_logit((", x, "-", paste0(prevChangePoints, collapse = "-"), ") * 5)")
    cpInt <- paste0(
      prefix, "exponential", position, "A * exp(", prefix, "exponential", position, "B * (",
      paste0(rev(prevAndCurrentChangePoints), collapse = "-"), "))"
    )
  }
  pars <- paste0(prefix, "exponential", position, c("A", "B")) # this needs to be conditional on fixed
  if (!fixed) {
    pars <- c(pars, paste0(chngptPrefix, "changePoint", position))
  }
  return(list(
    "form" = form,
    "cp" = cp,
    "cpInt" = cpInt,
    "params" = pars
  ))
}

#* ****************************************
#* ***** `Power Law Changepoint Phase` *****
#* ****************************************

#' Power Law changepoint section function
#'
#' @param x X variable name
#' @param position Position in growth formula ("1" + "2" + "3"... etc)
#' @param dpar string or NULL, if string should be the name of the distributional parameter
#' @param priors a list of prior distributions (used for fixed vs estimated changepoints)
#'
#' @examples
#'
#' .powerlawChngptForm(x = "time", 1)
#' .powerlawChngptForm(x = "time", 2)
#' .powerlawChngptForm(x = "time", 3)
#'
#' @return a list with form, cp, and cpInt elements. "form" is the growth formula
#' for this phase of the model. "cp" is the inv_logit function defining when this
#' phase should happen. "cpInt" is the value at the end of this growth phase and is
#' used in starting the next growth phase from the right y value.
#'
#' @noRd

.powerlawChngptForm <- function(x, position = 1, dpar = NULL, priors) { # return f, cp, and cpInt

  prefix <- chngptPrefix <- dpar

  if (any(grepl(paste0("fixedChangePoint", position), names(priors)))) {
    changePointObj <- as.numeric(priors[[paste0(prefix, "fixedChangePoint", position)]])[1]
    fixed <- TRUE
    chngptPrefix <- NULL # never a prefix if the changepoint is a fixed value
  } else {
    fixed <- FALSE
  }

  if (position == 1) {
    if (!fixed) {
      changePointObj <- "changePoint1"
    }
    form <- paste0(prefix, "powerLaw", position, "A * ", x, "^(", prefix, "powerLaw", position, "B)")
    cp <- paste0("inv_logit((", chngptPrefix, changePointObj, " - ", x, ") * 5)")
    cpInt <- paste0(
      prefix, "powerLaw", position, "A * ", chngptPrefix, changePointObj, "^(", prefix,
      "powerLaw", position, "B)"
    )
  } else {
    all_chngpts <- names(priors)[grepl("fixedChangePoint*|changePoint*", names(priors))]
    prevChangePoints <- all_chngpts[which(as.numeric(sub(".*hangePoint", "", all_chngpts)) < position)]
    prevAndCurrentChangePoints <- all_chngpts[which(
      as.numeric(sub(".*hangePoint", "", all_chngpts)) %in% c(position, position - 1)
    )]
    #* per location where "fixed" is in the prior name, replace the name with that number.
    prev_fixed_index <- which(grepl("fixed", prevChangePoints))
    if (length(prev_fixed_index) > 0) {
      prevChangePoints[prev_fixed_index] <- as.numeric(priors[prevChangePoints[prev_fixed_index]])
    }
    pac_fixed_index <- which(grepl("fixed", prevAndCurrentChangePoints))
    if (length(pac_fixed_index) > 0) {
      prevAndCurrentChangePoints[pac_fixed_index] <- as.numeric(
        priors[prevAndCurrentChangePoints[pac_fixed_index]]
      )
    }

    form <- paste0(
      prefix, "powerLaw", position, "A * ", x, "-",
      paste0(prevChangePoints, collapse = "-"), "^(", prefix, "powerLaw", position, "B)"
    )
    cp <- paste0("inv_logit((", x, "-", paste0(prevChangePoints, collapse = "-"), ") * 5)")
    cpInt <- paste0(
      prefix, "powerLaw", position, "A * (", paste0(rev(prevAndCurrentChangePoints), collapse = "-"),
      ")^(", prefix, "powerLaw", position, "B)"
    )
  }
  pars <- paste0(prefix, "powerLaw", position, c("A", "B"))
  if (!fixed) {
    pars <- c(pars, paste0(chngptPrefix, "changePoint", position))
  }
  return(list(
    "form" = form,
    "cp" = cp,
    "cpInt" = cpInt,
    "params" = pars
  ))
}

#* ****************************************
#* ***** `Logarithmic Changepoint Phase` *****
#* ****************************************

#' Logarithmic changepoint section function
#'
#' @param x X variable name
#' @param position Position in growth formula ("1" + "2" + "3"... etc)
#' @param dpar string or NULL, if string should be the name of the distributional parameter
#' @param priors a list of prior distributions (used for fixed vs estimated changepoints)
#'
#' @examples
#'
#' .logarithmicChngptForm(x = "time", 1)
#' .logarithmicChngptForm(x = "time", 2)
#' .logarithmicChngptForm(x = "time", 3)
#'
#' @return a list with form, cp, and cpInt elements. "form" is the growth formula
#' for this phase of the model. "cp" is the inv_logit function defining when this
#' phase should happen. "cpInt" is the value at the end of this growth phase and is
#' used in starting the next growth phase from the right y value.
#'
#' @noRd

.logarithmicChngptForm <- function(x, position = 1, dpar = NULL, priors) { # return f, cp, and cpInt

  prefix <- chngptPrefix <- dpar

  if (any(grepl(paste0("fixedChangePoint", position), names(priors)))) {
    changePointObj <- as.numeric(priors[[paste0(prefix, "fixedChangePoint", position)]])[1]
    fixed <- TRUE
    chngptPrefix <- NULL # never a prefix if the changepoint is a fixed value
  } else {
    fixed <- FALSE
  }

  if (position == 1) {
    if (!fixed) {
      changePointObj <- "changePoint1"
    }
    form <- paste0(prefix, "logarithmic", position, "A * log(", x, ")")
    cp <- paste0("inv_logit((", chngptPrefix, changePointObj, " - ", x, ") * 5)")
    cpInt <- paste0(
      prefix, "logarithmic", position, "A * log(", chngptPrefix, changePointObj, ")"
    )
  } else {
    all_chngpts <- names(priors)[grepl("fixedChangePoint*|changePoint*", names(priors))]
    prevChangePoints <- all_chngpts[which(as.numeric(sub(".*hangePoint", "", all_chngpts)) < position)]
    prevAndCurrentChangePoints <- all_chngpts[which(
      as.numeric(sub(".*hangePoint", "", all_chngpts)) %in% c(position, position - 1)
    )]
    #* per location where "fixed" is in the prior name, replace the name with that number.
    prev_fixed_index <- which(grepl("fixed", prevChangePoints))
    if (length(prev_fixed_index) > 0) {
      prevChangePoints[prev_fixed_index] <- as.numeric(priors[prevChangePoints[prev_fixed_index]])
    }
    pac_fixed_index <- which(grepl("fixed", prevAndCurrentChangePoints))
    if (length(pac_fixed_index) > 0) {
      prevAndCurrentChangePoints[pac_fixed_index] <- as.numeric(
        priors[prevAndCurrentChangePoints[pac_fixed_index]]
      )
    }

    form <- paste0(
      prefix, "logarithmic", position, "A * log(", x, "-",
      paste0(prevChangePoints, collapse = "-"), ")"
    )
    cp <- paste0("inv_logit((", x, "-", paste0(prevChangePoints, collapse = "-"), ") * 5)")
    cpInt <- paste0(
      prefix, "logarithmic", position, "A * log(",
      paste0(rev(prevAndCurrentChangePoints), collapse = "-"),
      ")"
    )
  }
  pars <- paste0(prefix, "powerLaw", position, c("A"))
  if (!fixed) {
    pars <- c(pars, paste0(chngptPrefix, "changePoint", position))
  }
  return(list(
    "form" = form,
    "cp" = cp,
    "cpInt" = cpInt,
    "params" = pars
  ))
}

#* ****************************************
#* ***** `Intercept Changepoint Phase` *****
#* ****************************************

#' intercept only changepoint section function
#'
#'
#' @param x X variable name
#' @param position Position in growth formula ("1" + "2" + "3"... etc)
#' @param dpar string or NULL, if string should be the name of the distributional parameter
#' @param priors a list of prior distributions (used for fixed vs estimated changepoints)
#'
#' @examples
#'
#' .intChngptForm(x = "time", 1, nTimes = 20)
#' .intChngptForm(x = "time", 2, nTimes = 20)
#' .intChngptForm(x = "time", 3, nTimes = 5)
#'
#' @return a list with form, cp, and cpInt elements. "form" is the growth formula
#' for this phase of the model. "cp" is the inv_logit function defining when this
#' phase should happen. "cpInt" is the value at the end of this growth phase and is
#' used in starting the next growth phase from the right y value, for GAMs this is
#' undefined and GAMs should only be used at the end of a segmented model.
#' @noRd

.intChngptForm <- function(x, position = 1, dpar = NULL, priors) { # return f, cp, and cpInt

  prefix <- chngptPrefix <- dpar

  if (any(grepl(paste0("fixedChangePoint", position), names(priors)))) {
    changePointObj <- as.numeric(priors[[paste0(prefix, "fixedChangePoint", position)]])[1]
    fixed <- TRUE
    chngptPrefix <- NULL # never a prefix if the changepoint is a fixed value
  } else {
    fixed <- FALSE
  }

  if (position == 1) {
    if (!fixed) {
      changePointObj <- "changePoint1"
    }
    form <- paste0(prefix, "int", position)
    cp <- paste0("inv_logit((", chngptPrefix, changePointObj, " - ", x, ") * 5)")
    cpInt <- paste0(prefix, "int", position)
  } else {
    all_chngpts <- names(priors)[grepl("fixedChangePoint*|changePoint*", names(priors))]
    prevChangePoints <- all_chngpts[which(as.numeric(sub(".*hangePoint", "", all_chngpts)) < position)]
    prev_fixed_index <- which(grepl("fixed", prevChangePoints))
    if (length(prev_fixed_index) > 0) {
      prevChangePoints[prev_fixed_index] <- as.numeric(priors[prevChangePoints[prev_fixed_index]])
    }

    form <- paste0(prefix, "int", position)
    cp <- paste0("inv_logit((", x, "-", paste0(prevChangePoints, collapse = "-"), ") * 5)")
    cpInt <- paste0(prefix, "int", position)
  }

  pars <- paste0(prefix, "int", position)
  if (!fixed) {
    pars <- c(pars, paste0(chngptPrefix, "changePoint", position))
  }

  return(list(
    "form" = form,
    "cp" = cp,
    "cpInt" = cpInt,
    "params" = pars
  ))
}




#* ****************************************
#* ***** `Gam Changepoint Phase` *****
#* ****************************************

#' gam changepoint section function
#'
#' @param x X variable name
#' @param position Position in growth formula ("1" + "2" + "3"... etc)
#' @param dpar string or NULL, if string should be the name of the distributional parameter
#' @param priors a list of prior distributions (used for fixed vs estimated changepoints)
#'
#' @examples
#'
#' .gamChngptForm(x = "time", 1, nTimes = 20)
#' .gamChngptForm(x = "time", 2, nTimes = 20)
#' .gamChngptForm(x = "time", 3, nTimes = 5)
#'
#' @return a list with form, cp, cpInt, and splineForm elements. "form" is the growth formula
#' for this phase of the model. "cp" is the inv_logit function defining when this
#' phase should happen. "cpInt" is the value at the end of this growth phase and is
#' used in starting the next growth phase from the right y value, for GAMs this is
#' undefined and GAMs should only be used at the end of a segmented model.
#' "splineForm" is to use in making a spline for a predictor.
#' @noRd

.gamChngptForm <- function(x, position = 1, dpar = NULL, priors) { # return f, cp, and cpInt

  prefix <- chngptPrefix <- dpar

  if (any(grepl(paste0("fixedChangePoint", position), names(priors)))) {
    fixed <- TRUE
    chngptPrefix <- NULL # never a prefix if the changepoint is a fixed value
  } else {
    fixed <- FALSE
  }

  if (position == 1) {
    stop("GAMs are only supported as the last function of a multi-part formula")
  } else {
    all_chngpts <- names(priors)[grepl("fixedChangePoint*|changePoint*", names(priors))]
    prevChangePoints <- all_chngpts[which(as.numeric(sub(".*hangePoint", "", all_chngpts)) < position)]
    prev_fixed_index <- which(grepl("fixed", prevChangePoints))
    if (length(prev_fixed_index) > 0) {
      prevChangePoints[prev_fixed_index] <- as.numeric(priors[prevChangePoints[prev_fixed_index]])
    }

    form <- paste0(prefix, "spline")
    cp <- paste0("inv_logit((", x, "-", paste0(prevChangePoints, collapse = "-"), ") * 5)")
    cpInt <- NA
  }
  pars <- paste0(prefix, "spline")
  if (!fixed) {
    pars <- c(pars, paste0(chngptPrefix, "changePoint", position))
  }
  return(list(
    "form" = form,
    "cp" = cp,
    "cpInt" = cpInt,
    "params" = pars,
    "splineVar" = paste0(prefix, "spline")
  ))
}

#* ****************************************
#* ***** `Gam Changepoint Phase` *****
#* ****************************************

#' flip any model to a decay model
#'
#' @param phaseList A list returned from some *ChngptForm function
#'
#' @return a list with form, cp, cpInt and params for a decay segment to a model
#' @noRd

.decayChngptForm <- function(phaseList) {
  phaseList$form <- paste0("-", phaseList$form)
  return(phaseList)
}

#* ****************************************
#* ***** `Weibull Changepoint Phase` *****
#* ****************************************

#' Weibull changepoint section function
#'
#' @param x X variable name
#' @param position Position in growth formula ("1" + "2" + "3"... etc)
#' @param dpar string or NULL, if string should be the name of the distributional parameter
#' @param priors a list of prior distributions (used for fixed vs estimated changepoints)
#'
#' @examples
#'
#' .weibullChngptForm(x = "time", 1)
#' .weibullChngptForm(x = "time", 2)
#' .weibullChngptForm(x = "time", 3)
#'
#' @return a list with form, cp, and cpInt elements. "form" is the growth formula
#' for this phase of the model. "cp" is the inv_logit function defining when this
#' phase should happen. "cpInt" is the value at the end of this growth phase and is
#' used in starting the next growth phase from the right y value.
#'
#' @noRd

.weibullChngptForm <- function(x, position = 1, dpar = NULL, priors) { # return f, cp, and cpInt

  prefix <- chngptPrefix <- dpar

  if (any(grepl(paste0("fixedChangePoint", position), names(priors)))) {
    changePointObj <- as.numeric(priors[[paste0(prefix, "fixedChangePoint", position)]])[1]
    fixed <- TRUE
    chngptPrefix <- NULL # never a prefix if the changepoint is a fixed value
  } else {
    fixed <- FALSE
  }

  if (position == 1) {
    if (!fixed) {
      changePointObj <- "changePoint1"
    }
    form <- paste0(
      prefix, "weibull", position, "A * (1-exp(-(", x, "/", prefix,
      "weibull", position, "C)^", prefix, "weibull", position, "B))"
    )
    cp <- paste0("inv_logit((", chngptPrefix, changePointObj, " - ", x, ") * 5)")
    cpInt <- paste0(
      prefix, "weibull", position, "A * (1-exp(-(", chngptPrefix, changePointObj,
      "/", prefix, "weibull", position, "C)^", prefix, "weibull", position, "B))"
    )
  } else {
    all_chngpts <- names(priors)[grepl("fixedChangePoint*|changePoint*", names(priors))]
    prevChangePoints <- all_chngpts[which(as.numeric(sub(".*hangePoint", "", all_chngpts)) < position)]
    prevAndCurrentChangePoints <- all_chngpts[which(
      as.numeric(sub(".*hangePoint", "", all_chngpts)) %in% c(position, position - 1)
    )]
    #* per location where "fixed" is in the prior name, replace the name with that number.
    prev_fixed_index <- which(grepl("fixed", prevChangePoints))
    if (length(prev_fixed_index) > 0) {
      prevChangePoints[prev_fixed_index] <- as.numeric(priors[prevChangePoints[prev_fixed_index]])
    }
    pac_fixed_index <- which(grepl("fixed", prevAndCurrentChangePoints))
    if (length(pac_fixed_index) > 0) {
      prevAndCurrentChangePoints[pac_fixed_index] <- as.numeric(
        priors[prevAndCurrentChangePoints[pac_fixed_index]]
      )
    }
    form <- paste0(
      prefix, "weibull", position, "A * (1-exp(-(", x, "-", paste0(prevChangePoints, collapse = "-"),
      "/", prefix, "weibull", position, "C)^", prefix, "weibull", position, "B))"
    )
    cp <- paste0("inv_logit((", x, "-", paste0(prevChangePoints, collapse = "-"), ") * 5)")
    cpInt <- paste0(
      prefix, "weibull", position, "A * (1-exp(-(", paste0(rev(prevAndCurrentChangePoints),
        collapse = "-"
      ),
      "/", prefix, "weibull", position, "C)^", prefix, "weibull", position, "B))"
    )
  }
  pars <- paste0(prefix, "weibull", position, c("A", "B", "C"))
  if (!fixed) {
    pars <- c(pars, paste0(chngptPrefix, "changePoint", position))
  }
  return(list(
    "form" = form,
    "cp" = cp,
    "cpInt" = cpInt,
    "params" = pars
  ))
}


#* ****************************************
#* ***** `Frechet Changepoint Phase` *****
#* ****************************************

#' Frechet changepoint section function
#'
#' @param x X variable name
#' @param position Position in growth formula ("1" + "2" + "3"... etc)
#' @param dpar string or NULL, if string should be the name of the distributional parameter
#' @param priors a list of prior distributions (used for fixed vs estimated changepoints)
#'
#' @examples
#'
#' .frechetChngptForm(x = "time", 1)
#' .frechetChngptForm(x = "time", 2)
#' .frechetChngptForm(x = "time", 3)
#'
#' @return a list with form, cp, and cpInt elements. "form" is the growth formula
#' for this phase of the model. "cp" is the inv_logit function defining when this
#' phase should happen. "cpInt" is the value at the end of this growth phase and is
#' used in starting the next growth phase from the right y value.
#'
#' @noRd

.frechetChngptForm <- function(x, position = 1, dpar = NULL, priors) { # return f, cp, and cpInt

  prefix <- chngptPrefix <- dpar

  if (any(grepl(paste0("fixedChangePoint", position), names(priors)))) {
    changePointObj <- as.numeric(priors[[paste0(prefix, "fixedChangePoint", position)]])[1]
    fixed <- TRUE
    chngptPrefix <- NULL # never a prefix if the changepoint is a fixed value
  } else {
    fixed <- FALSE
  }

  if (position == 1) {
    if (!fixed) {
      changePointObj <- "changePoint1"
    }
    form <- paste0(
      prefix, "frechet", position, "A * exp(-((", x, "-0)/", prefix, "frechet",
      position, "C)^(-", prefix, "frechet", position, "B))"
    )
    cp <- paste0("inv_logit((", chngptPrefix, changePointObj, " - ", x, ") * 5)")
    cpInt <- paste0(
      prefix, "frechet", position, "A * exp(-((", chngptPrefix, changePointObj, "-0)/",
      prefix, "frechet", position, "C)^(-", prefix, "frechet", position, "B))"
    )
  } else {
    all_chngpts <- names(priors)[grepl("fixedChangePoint*|changePoint*", names(priors))]
    prevChangePoints <- all_chngpts[which(as.numeric(sub(".*hangePoint", "", all_chngpts)) < position)]
    prevAndCurrentChangePoints <- all_chngpts[which(
      as.numeric(sub(".*hangePoint", "", all_chngpts)) %in% c(position, position - 1)
    )]
    #* per location where "fixed" is in the prior name, replace the name with that number.
    prev_fixed_index <- which(grepl("fixed", prevChangePoints))
    if (length(prev_fixed_index) > 0) {
      prevChangePoints[prev_fixed_index] <- as.numeric(priors[prevChangePoints[prev_fixed_index]])
    }
    pac_fixed_index <- which(grepl("fixed", prevAndCurrentChangePoints))
    if (length(pac_fixed_index) > 0) {
      prevAndCurrentChangePoints[pac_fixed_index] <- as.numeric(
        priors[prevAndCurrentChangePoints[pac_fixed_index]]
      )
    }

    form <- paste0(
      prefix, "frechet", position, "A * exp(-((", x, "-", paste0(prevChangePoints, collapse = "-"),
      "-0)/", prefix, "frechet", position, "C)^(-", prefix, "frechet", position, "B))"
    )
    cp <- paste0("inv_logit((", x, "-", paste0(prevChangePoints, collapse = "-"), ") * 5)")
    cpInt <- paste0(
      prefix, "frechet", position, "A * exp(-((", paste0(rev(prevAndCurrentChangePoints),
        collapse = "-"
      ),
      "-0)/", prefix, "frechet", position, "C)^(-", prefix, "frechet", position, "B))"
    )
  }
  pars <- paste0(prefix, "frechet", position, c("A", "B", "C"))
  if (!fixed) {
    pars <- c(pars, paste0(chngptPrefix, "changePoint", position))
  }
  return(list(
    "form" = form,
    "cp" = cp,
    "cpInt" = cpInt,
    "params" = pars
  ))
}


#* ****************************************
#* ***** `Gumbel Changepoint Phase` *****
#* ****************************************

#' Gumbel changepoint section function
#'
#' @param x X variable name
#' @param position Position in growth formula ("1" + "2" + "3"... etc)
#' @param dpar string or NULL, if string should be the name of the distributional parameter
#' @param priors a list of prior distributions (used for fixed vs estimated changepoints)
#'
#' @examples
#'
#' .gumbelChngptForm(x = "time", 1)
#' .gumbelChngptForm(x = "time", 2)
#' .gumbelChngptForm(x = "time", 3)
#'
#' @return a list with form, cp, and cpInt elements. "form" is the growth formula
#' for this phase of the model. "cp" is the inv_logit function defining when this
#' phase should happen. "cpInt" is the value at the end of this growth phase and is
#' used in starting the next growth phase from the right y value.
#'
#' @noRd

.gumbelChngptForm <- function(x, position = 1, dpar = NULL, priors) { # return f, cp, and cpInt


  prefix <- chngptPrefix <- dpar

  if (any(grepl(paste0("fixedChangePoint", position), names(priors)))) {
    changePointObj <- as.numeric(priors[[paste0(prefix, "fixedChangePoint", position)]])[1]
    fixed <- TRUE
    chngptPrefix <- NULL # never a prefix if the changepoint is a fixed value
  } else {
    fixed <- FALSE
  }

  if (position == 1) {
    if (!fixed) {
      changePointObj <- "changePoint1"
    }
    form <- paste0(
      prefix, "gumbel", position, "A * exp(-exp(-(", x, "-",
      prefix, "gumbel", position, "B)/", prefix, "gumbel", position, "C))"
    )
    cp <- paste0("inv_logit((", chngptPrefix, changePointObj, " - ", x, ") * 5)")
    cpInt <- paste0(
      prefix, "gumbel", position, "A * exp(-exp(-(", chngptPrefix, changePointObj, "-",
      prefix, "gumbel", position, "B)/", prefix, "gumbel", position, "C))"
    )
  } else {
    all_chngpts <- names(priors)[grepl("fixedChangePoint*|changePoint*", names(priors))]
    prevChangePoints <- all_chngpts[which(as.numeric(sub(".*hangePoint", "", all_chngpts)) < position)]
    prevAndCurrentChangePoints <- all_chngpts[which(
      as.numeric(sub(".*hangePoint", "", all_chngpts)) %in% c(position, position - 1)
    )]
    #* per location where "fixed" is in the prior name, replace the name with that number.
    prev_fixed_index <- which(grepl("fixed", prevChangePoints))
    if (length(prev_fixed_index) > 0) {
      prevChangePoints[prev_fixed_index] <- as.numeric(priors[prevChangePoints[prev_fixed_index]])
    }
    pac_fixed_index <- which(grepl("fixed", prevAndCurrentChangePoints))
    if (length(pac_fixed_index) > 0) {
      prevAndCurrentChangePoints[pac_fixed_index] <- as.numeric(
        priors[prevAndCurrentChangePoints[pac_fixed_index]]
      )
    }

    form <- paste0(
      prefix, "gumbel", position, "A * exp(-exp(-(", x, "-", paste0(prevChangePoints, collapse = "-"),
      "-", prefix, "gumbel", position, "B)/", prefix, "gumbel", position, "C))"
    )
    cp <- paste0("inv_logit((", x, "-", paste0(prevChangePoints, collapse = "-"), ") * 5)")
    cpInt <- paste0(
      prefix, "gumbel", position, "A * exp(-exp(-(", paste0(rev(prevAndCurrentChangePoints),
        collapse = "-"
      ),
      "-", prefix, "gumbel", position, "B)/", prefix, "gumbel", position, "C))"
    )
  }
  pars <- paste0(prefix, "gumbel", position, c("A", "B", "C"))
  if (!fixed) {
    pars <- c(pars, paste0(chngptPrefix, "changePoint", position))
  }
  return(list(
    "form" = form,
    "cp" = cp,
    "cpInt" = cpInt,
    "params" = pars
  ))
}

Try the pcvr package in your browser

Any scripts or data that you put into this service are public.

pcvr documentation built on April 16, 2025, 5:12 p.m.