R/visual.R

In davnovak/qctoy: Synthetic QC data generator

#' Plot signal data
#'
#' Plots signal data. The data can be binned into segments spanning equal time parts.
#'
#' @param data baseline, as generated by function \code{sim.baseline}, possibly perturbed by other functions.
#' @param bin_width number of time points per bin. If \code{NULL}, no binning.
#' @param avg measure of average. Can be \code{"mean"} (then, measure of deviation is SD) or \code{"median"} (then, measure of deviation is MAD).
#' @param point_size size of points.
#' @param y.lim y-axis (values) limits (vector of length 2).
#' @param title plot title.
#' @param y.lab y-axis (values) label.
#' @param x.lab x-axis (time) label.
#'
#' @return Modified \code{baseline} input.
#'
#' @seealso See functions beginning with \code{sim.sample.} for examples of usage.
#'
#' @export
sim.plot <- function(data,
                     bin_width = NULL,
                     plot_avg_and_dev = FALSE,
                     avg = c("mean", "median"),
                     point_size = 1,
                     y.lim = NULL,
                     title = "Flow rate",
                     y.lab = "flow rate",
                     x.lab = "time") {
  require(ggplot2)

  if (class(data) == "list") {
    data <- data$df
  } else if (class(data) != "data.frame") {
    stop("Invalid data")
  }

  N <- nrow(data)

  if (!is.null(bin_width)) {
    bins.vec <- cut(data$time, N/bin_width, labels = FALSE)
    bins.u <- sort(unique(bins.vec))

    if (plot_avg_and_dev) {
      stats <- lapply(bins.u, function(bin, values = data$value) {
        idcs <- bins.vec == bin

        len <- length(which(idcs))

        if (avg[1] == "mean") {
          return(list(
            average = rep(mean(values[idcs], na.rm = TRUE), len),
            deviation = rep(sd(values[idcs], na.rm = TRUE), len),
            bin = rep(bin, len)))
        } else if (avg[1] == "median") {
          return(list(
            average = rep(median(values[idcs], na.rm = TRUE), len),
            deviation = rep(mad(values[idcs], na.rm = TRUE), len),
            bin = rep(bin, len)))
        } else {
          stop("Invalid avg")
        }})

      stats <- do.call(rbind,
                       lapply(stats, function(stat) {
                         cbind(stat$bin, stat$average, stat$deviation)
                       }))
      stats <- cbind(seq_len(nrow(stats)), stats)
      stats <- data.frame(stats); colnames(stats) <- c("event", "bin", "average", "deviation")
    }


  } else {
    bins.vec = rep(1, N)
  }

  if (is.null(y.lim)) {
    y.lim[1] <- min(0, min(data$value, na.rm = TRUE) - abs(min(data$value, na.rm = TRUE))/10)
    y.lim[2] <- max(data$value, na.rm = TRUE) + abs(max(data$value, na.rm = TRUE))/10
  }

  if (!is.null(bin_width)) {
    palette <- as.factor(bins.vec)
  } else {
    palette <- "darkblue"
  }


  g <- ggplot(data, aes(x = time, y = value)) +
    geom_point(stat = "identity", size = point_size, color = palette) +
    ylim(y.lim) +
    ggtitle(title) +
    theme_minimal() +
    theme(legend.position = "none", plot.title = element_text(size = 16)) +
    ylab(y.lab) + xlab(x.lab)


  if (plot_avg_and_dev) {
    g <- g + geom_line(data = stats, aes(x = event, y = average), color = "black", size = 1)
    g <- g + geom_line(data = stats, aes(x = event, y = average-deviation), color = "black", linetype = "dashed")
    g <- g + geom_line(data = stats, aes(x = event, y = average+deviation), color = "black", linetype = "dashed")
  }

  return(g)
}