R/rng_aggregator.R

In shinyHugePlot: Efficient Plotting of Large-Sized Data

#' Aggregation that returns ranges of the data.
#'
#' @export
#' @docType class
#' @format An \code{R6::R6Class} object
#' @description
#' A super class for describing \code{aggregator} that returns \code{x}, \code{y},
#' \code{ylwr} and \code{yupr} values based on given \code{x} and \code{y} data.
#'
rng_aggregator <- R6::R6Class(
  "rng_aggregator",
  inherit = aggregator,
  public = list(
    #' @description
    #' Constructor of the Aggregator.
    #' @param interleave_gaps,coef_gap,NA_position,...
    #' Arguments pass to the constructor of \code{aggregator} object.
    initialize = function(
      interleave_gaps, coef_gap, NA_position, ...
    ) {
      args <- c(as.list(environment()), list(...))
      do.call(super$initialize, args)
    },
    #' @description
    #' Compute a \code{plotly} trace to illustrate the range of the data.
    #' @param x,y,ylwr,yupr Outputs of the sub class of \code{rng_aggregator}.
    #' @param opacity Numeric, optional. Opacity of the range fill.
    #' By default, 0.5.
    #' @returns List of which elements represent the ranges.
    #' If there are no \code{NA}s, the length of the list is 1;
    #' multiple lists are obtained if there are \code{NA}s.
    #' Each element of list has \code{x} and \code{y} values that surround
    #' the range of values.
    as_plotly_range = function(x, y, ylwr, yupr, opacity = 0.5) {

      assertthat::assert_that(
        all(is.na(x) - is.na(y) == 0) &&
        all(is.na(x) - is.na(ylwr) == 0) && all(is.na(x) - is.na(yupr) == 0),
        msg = "Invalid NAs are included in the data"
      )

      if (is.null(ylwr) | is.null(yupr)) {
        return(NULL)
      }

      cmpt_na_sep <- function(x) {
        split(x[!is.na(x)], cumsum(is.na(x))[!is.na(x)])
      }

      xy_df <- tibble(
        x = cmpt_na_sep(x),
        y = cmpt_na_sep(y),
        yupr = cmpt_na_sep(yupr),
        ylwr = cmpt_na_sep(ylwr)
      )

      prng <- purrr::pmap(
        tibble(
          x = cmpt_na_sep(x),
          y = cmpt_na_sep(y),
          yupr = cmpt_na_sep(yupr),
          ylwr = cmpt_na_sep(ylwr)
        ),
        function(x, y, yupr, ylwr) {
          list(
            x = c(x, rev(x)),
            y = c(ylwr, rev(yupr)),
            text = paste(
              paste0("x: ",    x),
              paste0("y: ",    y),
              paste0("ylwr: ", c(ylwr, rev(ylwr))),
              paste0("yupr: ", c(yupr, rev(yupr))),
              sep = "<br>"
            ),
            fill = "toself",
            opacity = opacity,
            hoveron = "points"
          )
        }
      )

      return(prng)
    },
    #' @description
    #' Compute \code{x}, \code{ylwr} and \code{yupr} from a \code{plotly} trace
    #' made by \code{self$as_plotly_range}.
    #' @param prng List that represents range values, which
    #' must contains \code{x}, \code{y}.
    #' Note that the list may be an element of a list generated by
    #' \code{self$as_plotly_range}.
    as_range = function(prng) {

      assertthat::assert_that(inherits(prng, "list"))
      assertthat::assert_that(
        "x" %in% names(prng) && "y" %in% names(prng) &&
        length(prng$x) %% 2 == 0 && length(prng$y) %% 2 == 0,
        msg = "The given list does not represent the ranges of the values"
        )

      rng <- list(
          x = prng$x[seq_len(length(prng$x)/2)],
          y = prng$y[seq_len(length(prng$x)/2)]
      )

      return(rng)
    }


  ),
  private = list(
    accepted_datatype = c("numeric", "integer", "character", "factor", "logical")
  )
)