R/breathtestfit_broom.R

In breathtestcore: Core Functions to Read and Fit 13c Time Series from Breath Tests

#' @title Broom-style tidying methods for breathtestfit
#' 
#' @description Broom-method \code{\link[generics]{tidy}} to streamline the results of class 
#' \code{breathttestfit}  as generated by  \code{nls_fit} or \code{nlme_fit}. Returns 
#' the fit  coefficients and half-emptying time t50 with the Maes/Ghoos method; 
#' additional parameters should be extracted with \code{\link[=coef.breathtestfit]{coef}}.
#' 
#' @param x Object of class \code{breathttestfit}
#' @param ... other parameters passed to methods
#' 
#' @return A tibble/data frame with columns
#' \describe{
#'   \item{patient_id}{Patient Id (character)}
#'   \item{group}{Treatment or patient group (character)}
#'   \item{m}{Fraction metabolized}
#'   \item{k}{Time constant (1/minutes)}
#'   \item{beta}{The so-called lag parameters, no dimension}
#'   \item{t50}{Emptying half time in minutes as calculated following Maes/Ghoos}
#' }
#'
#' @seealso \code{\link[generics]{tidy}}
#' @examples 
#' library(broom)
#' # Generate simulated data
#' data = cleanup_data(simulate_breathtest_data()$data)
#' # Fit with the population method
#' fit = nlme_fit(data)
#' # Output coefficients
#' tidy(fit)
#' # All coefficients in the long form
#' coef(fit)
#' @importFrom tidyr spread
#' @export 
#' 
tidy.breathtestfit = function(x, ...) {
  . = group = k = m = method = parameter = patient_id = t50 = value = NULL
  cf = coef(x)
  if (is.null(cf)) return(NULL)
  cf %>% 
    dplyr::filter(parameter %in% c("m", "k", "beta", "t50"), 
                  method %in% c("exp_beta", "maes_ghoos")) %>% 
    select(-method) %>% 
    tidyr::spread(parameter, value) %>% 
    select(patient_id, group, m, k, beta, t50) 
}

#' @title Augmented prediction for breathtest fit
#' 
#' @description Broom method \code{\link[generics]{augment}} to compute predicted values 
#' from  the results of class \code{breathttestfit}  as generated by  
#' \code{\link{nls_fit}} or \code{\link{nlme_fit}}.
#' 
#' @param x Object of class \code{breathttestfit}
#' @param by When \code{by} is NULL, predictions for the original data values
#' are returned.  When \code{by} is a positive number, it is used as a step 
#' size for a sequence of minutes from 0 to the maximum value of minute in data set. 
#' @param minute When a vector is passed, this overrides settings in \code{by},
#' and predictions are calculated at the requested minute values.
#' @param dose 13C acetate or octanoate dose
#' @param ... other parameters passed to methods
#' 
#' @return When \code{by} is NULL,  returns one row for each 
#' original observation pdr, and column \code{fitted}. If new data are given, 
#' i.e. when one of parameter \code{by} or \code{minute} is not null, 
#' only column \code{fitted} is added.
#' @seealso \code{\link[generics]{augment}}
#' @examples 
#' library(broom)
#' # Generate simulated data
#' data = cleanup_data(simulate_breathtest_data(n_records = 3)$data)
#' # Fit using the curves individually
#' fit = nls_fit(data)
#' # Predict values at t=60 and t=120
#' augment(fit, minute = c(60, 120))
#' 
#' @export
#' 
augment.breathtestfit = function(x, by = NULL, minute = NULL, dose = 100, ...) {
  # The ugly way to keep NOTES away
  . = group = k = m = method = parameter = patient_id = t50 = value = NULL
  if (is.null(coef(x))) return(NULL)
  
  assertthat::assert_that(is.null(by) || length(minute) > 1 || 
                          (length(by) == 1 && by > 1))
  if (is.null(by) && is.null(minute)) {
    tidy(x)  %>% 
      select(-t50) %>% 
      inner_join(x$data, by = c("patient_id", "group")) %>% 
      mutate(
        fitted = as.numeric(breathtestcore::exp_beta(minute, dose, m, k, beta ))
      ) %>% 
      select(-m, -k, -beta)
  } else {
    if (is.null(minute))
      minute = seq(0, max(x$data$minute), by = by)
    tidy(x) %>%  
      rowwise %>% 
      do( 
        tibble(
          patient_id = .$patient_id,
          group = .$group,
          minute = minute,
          fitted = as.numeric(breathtestcore::exp_beta(minute, dose, .$m, .$k, .$beta )))
      )
  }
}