R/santaR_plot.R

In santaR: Short Asynchronous Time-Series Analysis

#' Plot a SANTAObj
#'
#' Plot a \emph{SANTAObj} generated by \code{\link{santaR_fit}}. Returns a \code{ggplot2} \emph{plotObject} that can be further modified using \code{ggplot2} grammar.
#'
#' @param SANTAObj A fitted \emph{SANTAObj} as generated by \code{\link{santaR_fit}}.
#' @param title (str) A plot title. The default title is empty.
#' @param legend (bool) If TRUE a legend panel is added to the right. Default is TRUE. \emph{Note: the legend cannot be generated if only the Confidence Bands or the Total Mean Curve are plotted.}
#' @param showIndPoint (bool) If TRUE plot each input measurements (in group color). Default is TRUE.
#' @param showIndCurve (bool) If TRUE plot each individual's curve (in group color). Default is TRUE.
#' @param showGroupMeanCurve (bool) If TRUE plot the mean curve for each group (in group color). Default is TRUE.
#' @param showTotalMeanCurve (bool) If TRUE plot the mean curve across all measurements and groups (in grey). Default is FALSE.
#' @param showConfBand If TRUE plot the confidence bands calculated with \code{\link{santaR_CBand}}.
#' @param colorVect Vector of \code{ggplot2} colors. The number of colors must match the number of groups \emph{(ex:\code{colorVect=c("deepskyblue","red")})}.
#' @param sampling (int) Number of data points to use when plotting each spline (sub-sampling). Default is 250.
#' @param xlab (str) x-axis label. Default is 'x'.
#' @param ylab (str) y-axis label. Default is 'y'.
#' @param shortInd if TRUE individual trajectories are only plotted on the range on which they are defined. Default is FALSE.
#'
#' @return A \code{ggplot2} \emph{plotObject}.
#'
#' @examples
#' ## 56 measurements, 8 subjects, 7 unique time-points
#' Yi          <- acuteInflammation$data$var_3
#' ind         <- acuteInflammation$meta$ind
#' time        <- acuteInflammation$meta$time
#' group       <- acuteInflammation$meta$group
#' grouping    <- get_grouping(ind, group)
#' inputMatrix <- get_ind_time_matrix(Yi, ind, time)
#' SANTAObj    <- santaR_fit(inputMatrix, df=5, grouping=grouping, verbose=TRUE)
#' SANTAObj    <- santaR_CBand(SANTAObj, nBoot=100)
#' p           <- santaR_plot(SANTAObj, title='Example')
#' print(p)
#'
#' @family Analysis
#' @family AutoProcess
#'
#' @export
santaR_plot               <- function(SANTAObj,title='',legend=TRUE,showIndPoint=TRUE,showIndCurve=TRUE,showGroupMeanCurve=TRUE,showTotalMeanCurve=FALSE,showConfBand=TRUE,colorVect=NA,sampling=250,xlab='x',ylab='y',shortInd=FALSE) {
  
  ## COMMENT
  # could treat all possible ellipsisArgs by just looping on them and adding them p <- p +

  #ellipsisArgs <- as.list(substitute(list(...)))[-1L] #mainly to pass args to plotting function
  time         <- as.numeric(colnames(SANTAObj$general$inputData)) 
  grpName      <- names(SANTAObj$groups)
  if(is.null(grpName)) {    grpName <- as.character( seq(1:length(SANTAObj$groups)) ) } # can arise if groups haven't been set, or only one group
  # default color
  if (any(is.na(colorVect))) {
    colorVect=c("blue", "red", "green", "orange", "purple", "seagreen", "darkturquoise", "violetred", "saddlebrown", "black")
  }
  
  ## Initialisation of plot properties
  p     <- ggplot2::ggplot(NULL, ggplot2::aes(x), environment = environment()) + ggplot2::theme_bw() + ggplot2::xlab(xlab) + ggplot2::ylab(ylab)
  
  # insert title
  if( title!='' ) {
    p   <- p + ggplot2::ggtitle(title) + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
  }
  
  # # insert ellipsis arguments
  # # xlabel
  # if ( !is.null(ellipsisArgs[['xlab']]) ) {
  #   p   <- p + xlab( ellipsisArgs$xlab )
  # }
  
  ## Iterate over groups  
  for (j in 1: length(SANTAObj$groups)) {
    # points
    if(showIndPoint && !any(is.na(SANTAObj$groups[[j]]$point.in))) {         # no NA here without reason
      p   <- p + ggplot2::geom_point(data=data.frame(SANTAObj$groups[[j]]$point.in,grp=rep(grpName[j],dim(SANTAObj$groups[[j]]$point.in)[1])), ggplot2::aes_string(x="x", y="y", col="grp"), shape=1, size=4 )
    }
    # mean curve
    if (showGroupMeanCurve) {
      if ( any(!is.na(SANTAObj$groups[[j]]$groupMeanCurve))) {          # otherwise it was replaced by NA
        tmpPt <- data.frame(stats::predict(SANTAObj$groups[[j]]$groupMeanCurve, seq( min(SANTAObj$groups[[j]]$groupMeanCurve$x), max(SANTAObj$groups[[j]]$groupMeanCurve$x), ((max(SANTAObj$groups[[j]]$groupMeanCurve$x)-min(SANTAObj$groups[[j]]$groupMeanCurve$x))/sampling) ) ), grp=rep(grpName[j],sampling+1))
        p     <- p + ggplot2::geom_line(data=tmpPt, ggplot2::aes_string(x="x", y="y", col="grp"), linetype=1, size=1 )
      }
    }
    # ind curve
    if(showIndCurve && is.list(SANTAObj$groups[[j]]$curveInd)) {     # if not list, has been detected as empty
      for ( ind in 1 : length(SANTAObj$groups[[j]]$curveInd) ) {
        if(!is.null( SANTAObj$groups[[j]]$curveInd[[ind]] )) {       # check it isn't one of the rejected individual
          if(shortInd) {
            tmpPt <- data.frame(stats::predict(SANTAObj$groups[[j]]$curveInd[[ind]], seq( min(SANTAObj$groups[[j]]$curveInd[[ind]]$x), max(SANTAObj$groups[[j]]$curveInd[[ind]]$x), ((max(SANTAObj$groups[[j]]$curveInd[[ind]]$x)-min(SANTAObj$groups[[j]]$curveInd[[ind]]$x))/sampling) ) ), grp=rep(grpName[j],sampling+1) )
          } else {
            tmpPt <- data.frame(stats::predict(SANTAObj$groups[[j]]$curveInd[[ind]], seq( min(SANTAObj$groups[[j]]$point.in$x), max(SANTAObj$groups[[j]]$point.in$x), ((max(SANTAObj$groups[[j]]$point.in$x)-min(SANTAObj$groups[[j]]$point.in$x))/sampling) ) ), grp=rep(grpName[j],sampling+1) )
          }
          p     <- p + ggplot2::geom_line(data=tmpPt, ggplot2::aes_string(x="x", y="y", col="grp"), linetype=2 )          
        }
      }
    }
    # confidence band
    if(showConfBand && SANTAObj$properties$CBand$status && !any(is.na(SANTAObj$groups[[j]]$groupCBand$lowerFit)) && !any(is.na(SANTAObj$groups[[j]]$groupCBand$lowerFit))) {
      rng               <- range(time)
      lower.band        <- data.frame( stats::predict(SANTAObj$groups[[j]]$groupCBand$lowerFit, seq( rng[1], rng[2], (rng[2]-rng[1])/sampling)) )
      upper.band        <- data.frame( stats::predict(SANTAObj$groups[[j]]$groupCBand$upperFit, seq( rng[1], rng[2], (rng[2]-rng[1])/sampling)) )
      col.meanCurve.rgb <- grDevices::col2rgb(colorVect[j])
      p                 <- p + ggplot2::geom_polygon(data=data.frame(x=c(upper.band$x, rev(lower.band$x)), y=c(upper.band$y, rev(lower.band$y))), ggplot2::aes(x=x, y=y), fill=grDevices::rgb(col.meanCurve.rgb[1],col.meanCurve.rgb[2],col.meanCurve.rgb[3],alpha=50,maxColorValue=255), colour=NA)
    }
  }
  
  # all points mean curve
  if(showTotalMeanCurve) {
    if (any(!is.na(SANTAObj$general$meanCurve))) {
      tmpPt <- data.frame(stats::predict(SANTAObj$general$meanCurve, seq( min(SANTAObj$general$meanCurve$x), max(SANTAObj$general$meanCurve$x), ((max(SANTAObj$general$meanCurve$x)-min(SANTAObj$general$meanCurve$x))/sampling) ) ))
      p     <- p + ggplot2::geom_line(data=tmpPt, ggplot2::aes(x=x, y=y), linetype=4, size=1, col='grey40' )
    }
  }
  
  # set color scale
  colScale        <- colorVect[1:length(SANTAObj$groups)]
  names(colScale) <- names(SANTAObj$groups) 
  p     <- p + ggplot2::scale_color_manual( name='Group', values=colScale )
  
  # optional legend panel
  if(legend==FALSE) {
    p   <- p + ggplot2::theme(legend.position="none")
  }
  
  return(p)
}