R/invert.R

In tidysynthesis: A Common API for Synthesizing Data

#' An S3 method for inverting a step
#'
#' @rdname invert
#' @aliases invert invert.recipe
#' @concept postprocessing
#' 
#' @param object A recipe after fitting a model
#' @param predictions A data frame with .pred
#' @param ... Other arguments 
#' 
#' @return A tibble with inverted model-generated values
#' 
#' @examples
#' 
#' data <- tibble::tibble(
#'   y = rlnorm(n = 1000, meanlog = 0, sdlog = 1),
#'   x = rnorm(n = 1000)
#' )
#' 
#' adj <- recipes::recipe(y ~ x, data = data) |>
#'   recipes::step_BoxCox(recipes::all_outcomes()) |>
#'   recipes::prep()
#'   
#' invert(
#'   object = adj$steps[[1]], 
#'   predictions = tibble::tibble(.pred = adj[["template"]][["y"]])
#' )
#' 
#' @export
invert <- function(object, predictions, ...)
  UseMethod("invert")

#' Invert a Box-Cox transformation
#'
#' @param object A recipe after fitting a model
#' @param predictions A data frame with .pred
#' @param ... Other arguments 
#'
#' @return A tibble with the Box-Cox transformation inverted for .pred
#' 
#' @examples
#' 
#' data <- tibble::tibble(
#'   y = rlnorm(n = 1000, meanlog = 0, sdlog = 1),
#'   x = rnorm(n = 1000)
#' )
#' 
#' adj <- recipes::recipe(y ~ x, data = data) |>
#'   recipes::step_BoxCox(recipes::all_outcomes()) |>
#'   recipes::prep()
#'   
#' invert(
#'   object = adj$steps[[1]], 
#'   predictions = tibble::tibble(.pred = adj[["template"]][["y"]])
#' )
#' 
#' @export
invert.step_BoxCox <- function(object, predictions, ...) {
  
  lambda <- object$lambdas
  eps <- 0.001
  
  if (length(lambda) > 1) stop("Too many lambdas for invert.step_BoxCox()")
  
  if (length(lambda) > 0) {
    
    if (is.na(lambda))
      predictions[, ".pred"] <- predictions[, ".pred"]
    else if (abs(lambda) < eps)
      predictions[, ".pred"] <- exp(predictions[, ".pred"])
    else
      predictions[, ".pred"] <- (lambda * predictions[, ".pred"] + 1) ^ (1 / lambda)
    
  }
  
  return(predictions)
  
}

#' Invert a log transformation
#'
#' @param object A recipe after fitting a model
#' @param predictions A data frame with .pred
#' @param ... Other arguments 
#'
#' @return A tibble with the log transformation inverted for .pred 
#'
#' @examples
#' 
#' data <- tibble::tibble(
#'   y = rlnorm(n = 1000, meanlog = 0, sdlog = 1),
#'   x = rnorm(n = 1000)
#' )
#' 
#' adj <- recipes::recipe(y ~ x, data = data) |>
#'   recipes::step_log(recipes::all_outcomes()) |>
#'   recipes::prep()
#'   
#' invert(
#'   object = adj$steps[[1]], 
#'   predictions = tibble::tibble(.pred = adj[["template"]][["y"]])
#' )
#'
#' @export
invert.step_log <- function(object, predictions, ...) {

  predictions[, ".pred"] <- exp(predictions[, ".pred"])

  return(predictions)

}

#' Invert a Yeo-Johnson transformation
#'
#' @param object A recipe after fitting a model
#' @param predictions A data frame with .pred
#' @param ... Other arguments
#'
#' @return A tibble with the Yeo_johnson transformation inverted for .pred 
#' 
#' @examples 
#' 
#' data <- tibble::tibble(
#'   y = rlnorm(n = 1000, meanlog = 0, sdlog = 1),
#'   x = rnorm(n = 1000)
#' )
#' 
#' adj <- recipes::recipe(y ~ x, data = data) |>
#'   recipes::step_YeoJohnson(recipes::all_outcomes()) |>
#'   recipes::prep()
#'   
#' invert(
#'   object = adj$steps[[1]], 
#'   predictions = tibble::tibble(.pred = adj[["template"]][["y"]])
#' )
#' 
#' @export
invert.step_YeoJohnson <- function(object, predictions, ...) {

  # get lambdas
  lambda <- object$lambdas
  
  if (length(lambda) > 1) stop("Too many lambdas for invert.step_YeoJohnson()")
  
  if (length(lambda) > 0) {
    
    if (is.na(lambda)) {
      
      predictions[, ".pred"] <- predictions[, ".pred"]
      
    } else {
      
      predictions[, ".pred"] <- VGAM::yeo.johnson(y = predictions[, ".pred", drop = TRUE], 
                                                  lambda = lambda,
                                                  inverse = TRUE)
      
    }
    
  }
  
  return(predictions)
  
}