R/plotMmpCond.R

Defines functions plotMmpCond

Documented in plotMmpCond

#' Plot marker and quartile ellipse per condition
#' 
#' Plots the median and quartile ellipse per experimental condition
#' 
#' @param data Data frame containig the data to be plotted.
#' @param colNames Character vector naming the two columns with the x/y-Values
#'   to be plotted.
#' @param colNameCond Character vector with a single value containig the name 
#' of the stimulus type column of the data data-frame.
#' @param title Default is no title.
#' @param xlim Numeric vector of two elements defining the x-axis range of the 
#' plot. Per default the scaling is done automatically.
#' @param ylim Numeric vector of two elements defining the y-axis range of the 
#' plot. Per default the scaling is done automatically.
#' @param verbose Logical value. If TRUE, the function provides verbose 
#'   console output.
#'
#' @import stats
#' @import graphics
#'    
#' @return See vignette for example plots.
#'   
#' @author Axel Zinkernagel \email{zinkernagel@uni-wuppertal.de}
#'  
#' @import plotrix
#' @import utils
#'   
#' @examples
#' plotMmpCond(data = dataStdFCen, colNames = c("CL7_x", "CL7_y"), 
#'             colNameCond = "Stimulustype", title = "CL7")
#'    
#' @export
plotMmpCond <- function(data, colNames, colNameCond, title = "", xlim = NA, ylim = NA, verbose = FALSE) {
    # Error handling
    if (!(is.data.frame(data))) {
        stop("Argument data does not contain a data frame!")
    }
    if (!(is.character(colNames)) | length(colNames) != 2) {
        stop("Argument colNames is missing, not of type character, or contains not two names (x/y columns)!")
    }
    if (!(is.character(colNameCond)) | length(colNameCond) != 1) {
        stop("Argument colNameCond is not of type character!")
    }
    if (!(is.character(title))) {
        stop("Argument title is not of type character!")
    }
    if (!is.na(xlim[1]) & (!(is.numeric(xlim)) | length(xlim) != 2)) {
      stop("Argument xlim is not numeric or not containing two elements!")
    }
    if (!is.na(ylim[1]) & (!(is.numeric(ylim)) | length(ylim) != 2)) {
      stop("Argument ylim is not numeric or not containing two elements!")
    }
    if (!(is.logical(verbose))) {
        stop("Argument verbose is not of type logical!")
    }
    
    # Helper functions
    fcat <- function(...,newline=TRUE) {if (newline) cat(...,"\n") else cat(...); flush.console() }  # immediate console output
    
    # Hard coded constants
    ConstMin <- -0.005
    ConstMax <-  0.005
    
    tempData <- as.data.frame(cbind(data[colNames[1]],data[colNames[2]],data[colNameCond]))
    names(tempData) <- c("x","y","cond")
    
    # Extracting conditions
    cond <- unique(na.omit(unlist(tempData$cond)))
    cond <- cond[nchar(cond) > 0]
    
    # Compute mins and maxs for xlim/ylim of basic plot
    # This must be done for each stimulus condition for the addition of (medians + quantiles)
    # Preallocate minMaxData frame
    minMaxData <- as.data.frame(matrix(data = NA, nrow = length(cond), ncol = 5))
    names(minMaxData) <- c("minX","maxX","minY","maxY","cond")
    
    for (i in 1:length(cond)) {
      minMaxData$cond[i] <- cond[i]
      if (!is.infinite(min(tempData[tempData$cond == cond[i],"x"], na.rm = TRUE))) {
        minMaxData$minX[i] <- median(tempData[tempData$cond == cond[i],"x"], na.rm = TRUE) + as.numeric(quantile(tempData[tempData$cond == cond[i],"x"], .25, na.rm = TRUE))
      } else {
        minMaxData$minX[i] <- ConstMin
      }
      if (!is.infinite(max(tempData[tempData$cond == cond[i],"x"], na.rm = TRUE))) {
        minMaxData$maxX[i] <- median(tempData[tempData$cond == cond[i],"x"], na.rm = TRUE) + as.numeric(quantile(tempData[tempData$cond == cond[i],"x"], .75, na.rm = TRUE))
      } else {
        minMaxData$maxX[i] <- ConstMax
      }
      if (!is.infinite(min(tempData[tempData$cond == cond[i],"y"], na.rm = TRUE))) {
        minMaxData$minY[i] <- median(tempData[tempData$cond == cond[i],"y"], na.rm = TRUE) + as.numeric(quantile(tempData[tempData$cond == cond[i],"y"], .25, na.rm = TRUE))
      } else {
        minMaxData$minY[i] <- ConstMin
      }
      if (!is.infinite(max(tempData[tempData$cond == cond[i],"y"], na.rm = TRUE))) {
        minMaxData$maxY[i] <- median(tempData[tempData$cond == cond[i],"y"], na.rm = TRUE) + as.numeric(quantile(tempData[tempData$cond == cond[i],"y"], .75, na.rm = TRUE))
      } else {
        minMaxData$maxY[i] <- ConstMax
      }
    }
    # Overall min and max to achieve quadratic plots (no different scalings for x/y-axes; angles can be compared)
    min <- min(c(min(minMaxData$minX), min(minMaxData$minY)))
    max <- max(c(max(minMaxData$maxX), max(minMaxData$maxY)))
    
    # Make sure that 0 is contained in the min-max interval (0 is the origin of the movement -> use function centerCond first!)
    if(min > 0) {min <- 0}
    if(max < 0) {max <- 0}
    
    # if user-xlim or user-ylim are given, overwrite computed values
    if (!unique(is.na(xlim))) { # TRUE, if user presets given
      minX <- xlim[1]
      maxX <- xlim[2]
    } else {
      minX <- min
      maxX <- max
    }
    if (!unique(is.na(ylim))) { # TRUE, if user presets given
      minY <- ylim[1]
      maxY <- ylim[2]
    } else {
      minY <- min
      maxY <- max
    }
    
    # Generate basic plot
    plot(c(minX,maxX),c(minY,maxY), type = "n", xlab = "Median movement x-Axis", ylab = "Median movement y-Axis", main = title)
    legend("topright", cex = 0.7, inset = 0, cond, col = 1:length(cond), pch = 19, horiz = FALSE)
    points(0, 0, pch = 19, col = 1)
    # Draw points, lines and ellipses per condition
    for (j in 1:length(cond)) {
        if (verbose) {
            fcat(paste("Plotting condition '", cond[j], "'", sep = ""))
        }
        medianX <- median(subset(tempData$x, subset = (tempData$cond == cond[j])), na.rm = TRUE)
        medianY <- median(subset(tempData$y, subset = (tempData$cond == cond[j])), na.rm = TRUE)
        quantX <- quantile(subset(tempData$x, subset = (tempData$cond == cond[j])), c(0.25, 0.75), na.rm = TRUE)
        quantY <- quantile(subset(tempData$y, subset = (tempData$cond == cond[j])), c(0.25, 0.75), na.rm = TRUE)
        lines(c(0, medianX), c(0, medianY), type = "l", col = j)
        points(medianX, medianY, pch = 19, col = j)
        plotrix::draw.ellipse(medianX, medianY, a = abs(quantX[2]), b = abs(quantY[2]), segment = c(0, 90), arc.only = FALSE, border = j, lty = 1, lwd = 1, deg = TRUE)
        plotrix::draw.ellipse(medianX, medianY, a = abs(quantX[1]), b = abs(quantY[2]), segment = c(90, 180), arc.only = FALSE, border = j, lty = 1, lwd = 1, deg = TRUE)
        plotrix::draw.ellipse(medianX, medianY, a = abs(quantX[1]), b = abs(quantY[1]), segment = c(180, 270), arc.only = FALSE, border = j, lty = 1, lwd = 1, deg = TRUE)
        plotrix::draw.ellipse(medianX, medianY, a = abs(quantX[2]), b = abs(quantY[1]), segment = c(270, 360), arc.only = FALSE, border = j, lty = 1, lwd = 1, deg = TRUE)
    }
}
axzinker/blenderFace documentation built on Feb. 27, 2024, 10:25 a.m.