diff --git a/R/log_lik.R b/R/log_lik.R index 950d3b614..849c7adeb 100644 --- a/R/log_lik.R +++ b/R/log_lik.R @@ -963,7 +963,11 @@ log_lik_mixture <- function(i, prep, mix = TRUE, zihu = FALSE) { families <- family_names(prep$family) - n_zi <- sum(is.zihufamily(families)) + sum(families == "zero_one_inflated_beta") + if (zihu) { + n_zi <- sum(is.zihufamily(families)) + sum(families == "zero_one_inflated_beta") + } else { + n_zi <- 0 + } if (!mix & zihu) { out <- array(NA, dim = c(prep$ndraws, 1 + n_zi)) diff --git a/R/pp_mixture.R b/R/pp_mixture.R index b5c940b7b..75626eb77 100644 --- a/R/pp_mixture.R +++ b/R/pp_mixture.R @@ -95,6 +95,7 @@ pp_mixture.brmsfit <- function(x, newdata = NULL, re_formula = NULL, if (z_mix & !any_zihu) { stop2("Method 'pp_mixture(..., z_mix = TRUE)' can only be applied to zero-inflated and hurdle models.") } + if (!is.mixfamily(family) & !z_mix) { stop2("Method 'pp_mixture' can only be applied to mixture models.") } @@ -141,66 +142,6 @@ pp_mixture <- function(x, ...) { UseMethod("pp_mixture") } -# -# latent_zi_state_prob <- function (brmsfit, ...) { -# fam <- brmsfit$family$family -# if(!is.zifamily(fam)) { -# stop2(paste0( -# "latent zi probs available only for discrete zero-inflated families (", -# paste(zi_families(), collapse = ", "), -# "). Supplied brmsfit has family: ", -# fam -# )) -# } -# lik <- exp(log_lik(brmsfit, ...)) -# zi_lik_given_obs_zero <- posterior_linpred( -# brmsfit, -# dpar = "zi", -# transform = TRUE, -# ... -# ) -# resp_name <- brmsfit$formula$resp -# resp_data <- brmsfit$data[[resp_name]] -# resp_is_zero <- as.integer(resp_data == 0) -# zi_lik <- sweep(zi_lik_given_obs_zero, MARGIN=2, resp_is_zero, `*`) -# zi_lik / lik -# } -# -# -# latent_hu_state_prob <- function (brmsfit) { -# fam <- brmsfit$family$family -# if(!is.hufamily(fam)) { -# stop2(paste0( -# "latent hu probs available only for hurdle and zero-inflated continuous families (", -# paste(hu_families(), collapse = ", "), -# "). Supplied brmsfit has family: ", -# fam -# )) -# } -# -# resp_name <- brmsfit$formula$resp -# -# if (is.null(newdata)) { -# the_data <- brmsfit$data -# } else { -# the_data <- newdata -# } -# -# if (fam == "zero_one_inflated_beta") { -# out <- data.frame( -# ni = as.integer(!(the_data[[resp]] %in% c(0, 1))), -# zi = as.integer(the_data[[resp]] == 0), -# oi = as.integer(the_data[[resp]] == 1) -# } else { -# out <- data.frame( -# ni = as.integer(the_data != 0), -# zi = as.integer(the_data == 0) -# ) -# } -# out -# } -# - #' List of all hurdle families, where "hurdle" means anything where observed #' zeros are guaranteed to be due to the zero-inflation component. hu_families <- function() { diff --git a/man/hu_families.Rd b/man/hu_families.Rd new file mode 100644 index 000000000..41c3d0481 --- /dev/null +++ b/man/hu_families.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/pp_mixture.R +\name{hu_families} +\alias{hu_families} +\title{List of all hurdle families, where "hurdle" means anything where observed +zeros are guaranteed to be due to the zero-inflation component.} +\usage{ +hu_families() +} +\description{ +List of all hurdle families, where "hurdle" means anything where observed +zeros are guaranteed to be due to the zero-inflation component. +} diff --git a/man/pp_mixture.brmsfit.Rd b/man/pp_mixture.brmsfit.Rd index 14225530c..96ac59f8e 100644 --- a/man/pp_mixture.brmsfit.Rd +++ b/man/pp_mixture.brmsfit.Rd @@ -16,6 +16,7 @@ summary = TRUE, robust = FALSE, probs = c(0.025, 0.975), + z_mix = FALSE, ... ) @@ -59,6 +60,14 @@ Only used if \code{summary} is \code{TRUE}.} \item{probs}{The percentiles to be computed by the \code{quantile} function. Only used if \code{summary} is \code{TRUE}.} +\item{z_mix}{Logical. If TRUE, returns the mixture component +memberships for the hurdle/zero-inflation state in hurdle +and zero-inflated models. For an explicit mixture model +including a zero-inflated model in the mixture, probabilities +are returned for each mixture component, treating the +zero-inflation state and the non-zero-inflation state as +separate mixture components.} + \item{...}{Further arguments passed to \code{\link{prepare_predictions}} that control several aspects of data validation and prediction.} } diff --git a/man/zi_families.Rd b/man/zi_families.Rd new file mode 100644 index 000000000..c556c0705 --- /dev/null +++ b/man/zi_families.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/pp_mixture.R +\name{zi_families} +\alias{zi_families} +\title{List of all true zero-inflated families, where observed zeros may arise +either from the zero-inflation component or from the other component.} +\usage{ +zi_families() +} +\description{ +List of all true zero-inflated families, where observed zeros may arise +either from the zero-inflation component or from the other component. +}