R/ps_extra.R

In david-barnett/microViz: Microbiome Data Analysis and Visualization

#' ps_extra S3 class
#'
#' S3 class to store a list of "extras" alongside a phyloseq object
#' @examples
#' data("dietswap", package = "microbiome")
#'
#' new_ps_extra_info()
#' print(new_ps_extra_info(), all = TRUE)
#' ps_extra <- new_ps_extra(dietswap)
#' ps_extra
#' @export
#' @noRd
print.ps_extra <- function(x, ...) {
  stopif_ps_extra(x)
}

#' @export
#' @noRd
print.ps_extra_info <- function(x, ..., all = TRUE) {
  stop("ps_extra class is defunct")
}

#' Convert old format "ps_extra" objects to new "psExtra" objects
#'
#' This will only be necessary if you have saved old format "ps_extra" objects
#' generated by an old microViz version (< 0.10.0), and you cannot or do not
#' want to regenerate these old format objects from your original phyloseq object.
#'
#' @param ps_extra
#' an old format "ps_extra" object,
#' as generated by old microViz versions (< 0.10.0)
#'
#' @return new format "psExtra" S4 object
#' @export
#'
#' @examples
#' # read your old saved 'ps_extra' object that you want to keep using
#' # oldObject <- readRDS("old-object-path.rds")
#' # newObject <- upgrade_ps_extra_to_psExtra(oldObject)
#' # continue with your next analysis or plotting steps...
upgrade_ps_extra_to_psExtra <- function(ps_extra) {
  if (is(ps_extra, "phyloseq")) stop("object does not need conversion!")
  if (!inherits(ps_extra, "ps_extra")) stop("object is not a 'ps_extra'")
  newInfo <- upgrade_ps_extra_info_to_psExtraInfo(ps_extra[["info"]])

  psX <- psExtra(
    ps = ps_extra[["ps"]], info = newInfo, counts = ps_extra[["counts"]],
    dist = ps_extra[["dist"]], ord = ps_extra[["ord"]],
    permanova = ps_extra[["permanova"]],
    bdisp = ps_extra[["bdisp"]],
    taxatree_models = ps_extra[["taxatree_models"]],
    taxatree_stats = ps_extra[["taxatree_stats"]],
    tax_models = ps_extra[["tax_models"]],
    tax_stats = ps_extra[["tax_stats"]]
  )
  return(psX)
}

upgrade_ps_extra_info_to_psExtraInfo <- function(ps_extra_info) {
  stopifnot(is.null(ps_extra_info) || inherits(ps_extra_info, "ps_extra_info"))
  if (!is.null(ps_extra_info)) {
    return(new_psExtraInfo())
  }
  LIST <- as.list(ps_extra_info) # so missing element selection returns NULL
  NEW <- new_psExtraInfo(
    tax_agg = naOrNull2zeroLenChr(LIST[["tax_agg"]]),
    tax_trans = naOrNull2zeroLenChr(LIST[["tax_transform"]]),
    tax_scale = naOrNull2zeroLenChr(LIST[["tax_scale"]]),
    dist_method = naOrNull2zeroLenChr(LIST[["distMethod"]]),
    ord_info = new_psExtraOrdInfo(
      method = naOrNull2zeroLenChr(LIST[["ordMethod"]]),
      constraints = naOrNull2zeroLenChr(LIST[["constraints"]]),
      conditions = naOrNull2zeroLenChr(LIST[["conditions"]])
    )
  )
  return(NEW)
}


naOrNull2zeroLenChr <- function(x) {
  if (rlang::is_null(x) || rlang::is_na(x)) x <- character()
  return(x)
}

stopif_ps_extra <- function(object, argName = NULL, Ncallers = 1) {
  if (!inherits(object, "ps_extra")) {
    return(object)
  }
  rlang::abort(call = rlang::caller_env(n = Ncallers), message = c(
    "x" = paste("argument", argName, "is a deprecated 'ps_extra' object"),
    "!" = "If possible, regenerate the object with the current microViz version",
    "i" = paste(
      "Or convert your ps_extra object to the new psExtra class",
      "with {.help [{.fun upgrade_ps_extra_to_psExtra}](microViz::upgrade_ps_extra_to_psExtra)}"
    )
  ))
}