R/verb-slice_left.R

In vincenzocoia/distplyr: Manipulation of Univariate Distributions

#' Conditional Distributions
#'
#' `slice_left()` removes probability to the left of some breakpoint,
#' conditioning the random variable to be bigger than the breakpoint.
#' `slice_right()` does the opposite: removes probability to the right,
#' conditioning to be smaller than the breakpoint.
#'
#' @param distribution Distribution to slice.
#' @param breakpoint Point at which to slice (single numeric).
#' @param include Logical; should the breakpoint be removed as well?
#' This is only realistically relevant if the
#' breakpoint has a non-zero probability of occurrence.
#' @param ... Other arguments to pass to specific methods. Currently unused.
#' @return A conditional distribution.
#' @examples
#' library(magrittr)
#' distionary::dst_norm(0, 1) %>%
#'   slice_left(-2) %>%
#'   slice_right(2) %>%
#'   distionary::enframe_cdf(at = -3:3)
#'
#' d <- distionary::dst_empirical(c(2, 5, 6, 9, 11))
#' d %>%
#'   slice_left(5) %>%
#'   distionary::eval_pmf(at = 5)
#' d %>%
#'   slice_left(5, include = TRUE) %>%
#'   distionary::eval_pmf(at = 5)
#' @rdname slice
#' @export
slice_left <- function(distribution, breakpoint, include = TRUE, ...) {
	UseMethod("slice_left")
}

#' @export
slice_left.dst <- function(distribution, breakpoint, include = TRUE, ...) {
	rng <- range(distribution)
	left <- rng[1L]
	right <- rng[2L]
	if (breakpoint < left) {
		return(distribution)
	}
	all_sliced <- FALSE
	if (breakpoint > right) {
		all_sliced <- TRUE
	}
	if (breakpoint == right) {
		if (include) {
			all_sliced <- TRUE
		} else {
			p <- distionary::eval_pmf(
				distribution, at = breakpoint, strict = FALSE
			)
			if (p == 0) {
				all_sliced <- TRUE
			} else {
				return(distionary::dst_degenerate(breakpoint))
			}
		}
	}
	if (all_sliced) {
	  warning("Sliced off entire distribution. Returning NULL.")
	  return(NULL)
	}
	# slope_of_cdf <- eval_density(distribution, at = breakpoint, strict = FALSE)
	# if (slope_of_cdf == 0) {
	#   value_of_cdf <- eval_cdf(distribution, at = breakpoint)
	#   high <- next_discrete(distribution, from = breakpoint)
	#   if (is.infinite(high)) {
	#     p_high <- (1 + value_of_cdf) / 2
	#     high <- eval_quantile(distribution, at = p_high)
	#   }
	#   breakpoint_new <- distionary:::directional_inverse(
	#     distribution, p = value_of_cdf, low = breakpoint, high = high,
	#     tol = 1e-9, maxiter = 200, direction = "right"
	#   )
	#   if (breakpoint_new != breakpoint) {
	#     breakpoint <- breakpoint_new
	#     include <- FALSE
	#   }
	# }
	l <- list(
	  distribution = distribution,
	  breakpoint = breakpoint,
	  include = include
	)
	v <- distionary::variable(distribution)
	if (v == "mixed") {
	  v <- "unknown" # For now. Need to evaluate cumulative discrete probs.
	}
	distionary::new_distribution(l, variable = v, class = "slice_left")
}

#' @export
slice_left.finite <- function(distribution, breakpoint, include = TRUE, ...) {
	right_discretes <- distionary::next_discrete(
		distribution, from = breakpoint, n = Inf, include_from = !include
	)
	if (!length(right_discretes)) {
		warning("Sliced off entire distribution. Returning NULL.")
	  return(NULL)
	}
	right_probs <- distionary::eval_pmf(distribution, at = right_discretes)
	distionary::dst_empirical(right_discretes, weights = right_probs)
}