R/plot_base.R

In Crystal-YWu/abftools: ABF Tools: Toolbox for Visualising and Analysing Electrophysiology ABF2 Data

#' Plot abf objects in time domain.
#'
#' @details This is a low-level plotting function that returns a ggplot object
#' with plotting data generated by MeltAbf() and aesthetics properly mapped.
#'
#' If only one channel is provided, a "wide" format data.frame is generated and
#' y is mapped to the channel. If multiple channel is provided, a "long" data.frame
#' is generated and y is mapped to "value" column.
#'
#' Since this is a low-level function, there is no data validation or sanity
#' check performed. Use with caution.
#'
#' @param abf an abf object/list of abf objects.
#' @param intv an INDEX intv to sample abf.
#' @param channel channels to map.
#' @param episode episodes to group.
#' @param concat_epi wheter to concatenate all episodes.
#' @param sample_ratio sample ratio.
#' @param sample_func sample function.
#' @param sample_colFunc a sample column function.
#' @param ... passed to sample_func().
#' @param time_unit a time unit passed to TickToTime().
#' @param colour whether to plot in coloured mode.
#'
#' @return a ggplot object.
#' @export
#'
abf_plot_td <- function(abf, intv = NULL, channel, episode, concat_epi,
                        sample_ratio = 1L, sample_func = "mean", sample_colFunc = NULL, ...,
                        time_unit = "tick", colour = TRUE) {

  xcol <- "Time"
  if (length(channel) > 1) {
    format <- "long"
    ycol <- "value"
  } else {
    format <- "wide"
    ycol <- GetChanTag(channel)
  }

  if (IsAbfList(abf)) {
    n <- length(abf)
    intv <- MatchList(intv, n)
    dots <- list(...)
    df <- do.call(
      rbind,
      lapply(seq_len(n), function(idx) {
        args <- c(list(abf = abf[[idx]], intv = intv[[idx]], channel = channel, episode = episode,
                       concat_epi = concat_epi, along = "episode", format = format,
                       sample_ratio = sample_ratio, sample_func = sample_func, sample_colFunc = sample_colFunc,
                       abf_id_func = GetTitle, epi_id_func = GetEpiTag, chan_id_func = GetChanTag,
                       time_unit = time_unit),
                  dots)
        do.call(MeltAbf, args)
      })
    )
  } else {
    df <- MeltAbf(abf = abf, intv = intv, channel = channel, episode = episode,
                  concat_epi = concat_epi, along = "episode", format = format,
                  sample_ratio = sample_ratio, sample_func = sample_func, sample_colFunc = sample_colFunc,
                  abf_id_func = GetTitle, epi_id_func = GetEpiTag, chan_id_func = GetChanTag,
                  time_unit = time_unit, ...)
  }

  if (colour) {
    p <- ggplot(data = df,
                mapping = aes_string(x = xcol, y = ycol, colour = "Episode"))
  } else {
    p <- ggplot(data = df,
                mapping = aes_string(x = xcol, y = ycol, group = "Episode"))
  }

  p
}

#' Plot abf objects in channel domain.
#'
#' @details This is a low-level plotting function that returns a ggplot object
#' with plotting data generated by Wrap*() and aesthetics properly mapped.
#'
#' Since this is a low-level function, there is no data validation or sanity
#' check performed. Use with caution.
#'
#' @param abf an abf object/list of abf objects.
#' @param intv a TIME intv to sample abf.
#' @param channel channels to map, a two element integer vector, 1st element corresponds to x and 2nd corresponds to y.
#' @param map_func a function to map on abf.
#' @param pack_args whether to pack arguments for map_func().
#' @param ... passed to map_func()
#' @param colour wheter to plot in coloured mode.
#'
#' @return a ggplot object.
#' @export
#'
abf_plot_cd <- function(abf, intv = NULL, channel = c(2L, 1L),
                        map_func = "mean", pack_args = FALSE, ...,
                        colour = TRUE) {

  f <- WrapMappingFuncAlong(map_func = map_func, along = "time", pack_args = pack_args, ...,
                            abf_id_func = GetTitle,
                            epi_id_func = GetEpiTag,
                            chan_id_func = GetChanTag)

  if (IsAbfList(abf)) {
    n <- length(abf)
    intv <- MatchList(intv, n)
    df <- do.call(rbind, lapply(seq_len(n),
                                function(idx) f(abf[[idx]], intv = intv[[idx]], channel = channel)))
  } else {
    df <- f(abf, intv = intv, channel = channel)
  }

  xcol <- GetChanTag(channel[1L])
  ycol <- GetChanTag(channel[2L])

  if (colour) {
    p <- ggplot(data = df,
                mapping = aes_string(x = xcol, y = ycol, colour = "id"))
  } else {
    p <- ggplot(data = df,
                mapping = aes_string(x = xcol, y = ycol, group = "id"))
  }

  p
}