R/mgsplot.box.R

In michellegrace/mgs.dispersion: This reads and plots dispersion related inputs and outputs.

#' This function creates boxplots
#'
#' @param dfIN: dataframe ["X","Y"], ["X","Y","Z"],["X","Y","facet_var"], or ["X","Y","Z",facet_var"]. 
#' note:: Where "Z" is the color scale. Names of dataframe columns are used to label the axes, color scale, and facets. 
#' @param axisscale (opt): = 'linear'(default), can also use 'log10'
#' @param color (opt): logical = FALSE(default), = TRUE uses "Z" input to color points.
#' @param cbin (opt): logical = FALSE(default), = TRUE uses a binned color scale
#' @param colorbins (opt): =c(-1,0,1) which will be c(min, max, 0) sorted (default), can input any length vector to make bins of color
#'
#' @return ggplot object
#'
#' @import ggplot2
#' 
#' @export mgsplot.box
#########################################################################

mgsplot.box <- function(dfIN){  
  
  #### START: Check inputs & set up .local variables  
  #check required inputs
  if (missing(dfIN)){
    stop("Need to specify input data frame (dfIN).")
  }else{
    if((length(dfIN[1,])>4) | (length(dfIN[1,])<2)){
      stop("incorrect number of columns in input data frame (dfIN). Please input [X,Y], [X,Y,Z],[X,Y,facet_var], or [X,Y,Z,facet_var].")
    }
  }
  
  if (missing(file)){
    stop("Need to specify file name to save plot (file).")
  }else{
    file.local <- file
  }
  
  #set up variables for routine
  df.local <- dfIN
  num.col <- length(df.local[1,])
  num.row <- length(df.local[,1])
  titles <- colnames(df.local)
  axisscale.local <- axisscale
  color.logical <- colorpoints
  cbin.logical <- cbin
  
  #set up binned color
  if (cbin.logical){ #bin colors
    min.c <- min(df.local[,3],na.rm=TRUE)
    max.c <- max(df.local[,3],na.rm=TRUE)
    colorbins.local <- sort(colorbins,decreasing=FALSE)
    colorbins.local[1] <- min.c
    colorbins.local[length(colorbins.local)] <- max.c
    colorbins.local[which(colorbins.local<min.c)] <- NA
    colorbins.local<- colorbins.local[complete.cases(colorbins.local)]
    colorbins.local <- sort(colorbins.local,decreasing=FALSE)
    C.breaks <- colorbins.local
    n <- length(C.breaks)
    if(n>3){
      colorbins.labels <- c(paste("[",c(C.breaks[1:n-2]),'->',c(C.breaks[2:n-1]),")"), paste("[",C.breaks[n-1],"->",C.breaks[n],"]"))}
    else if(n==3){
      colorbins.labels <- c(paste("[",c(C.breaks[1]),'->',c(C.breaks[2]),")"), paste("[",C.breaks[2],"->",C.breaks[3],"]"))
    }else{
      stop("Please input a colorbin array that matches your data.")
    }
    df.local[,3]<- cut(x = df.local[,3],breaks = C.breaks,labels = colorbins.labels,right = FALSE,ordered_result = TRUE)
  }
  
  #set facet logical
  if((num.col==4)|(num.col==3 && color.logical==FALSE)){
    facet.logical <- TRUE
  }else{
    facet.logical <- FALSE
  }
  
  #set up number of facet_wrap columns: ["X","Y","facet_var"] or ["X","Y","Z",facet_var"]
  nc <- 1
  if (facet.logical){ 
    bins <- unique(df.local[,num.col]) #last column is facet
    num.bins <- length(bins) 
    if (num.col < 3){ #set number of columns in facet grid
      nc <- num.bins
    }else{
      nc <- ceiling(num.bins/3)
    }
  }
  #### END: Check inputs & set up .local variables 

  #set up df.plot
  df.plot <- data.frame(matrix(ncol=4,nrow=num.row))
  df.plot[,"Observed"] <- df.local[,1]
  df.plot[,"Modeled"] <- df.local[,2]
  
  #set colors 
  if(color.logical){ #["X","Y","Z"] or ["X","Y","Z",facet_var"]
    df.plot[,"c"] <- df.local[,3]
  }else{#["X","Y"] or ["X","Y","facet_var"]
    df.plot[,"c"] <- 1
  }
  #set facets
  if(facet.logical){ # ["X","Y","facet_var"] or ["X","Y","Z",facet_var"]
    df.plot[,"f"] <- df.local[,num.col]
  } else{#["X","Y","Z"] or ["X","Y"]
    df.plot[,"f"] <- ""
  }
  
  #clean up df to plot
  df.plot <- df.plot[,c("Observed","Modeled","f","c")]
  
p <- ggplot(plot.df,aes(x=X,y=Y,fill=f))+
  geom_boxplot()+
  theme_bw(base_size=12, base_family = "Helvetica")+
  guides(fill=FALSE)+
  scale_fill_discrete(name="Day of Week",labels=unique(plot.df$DOW))+
  scale_x_discrete(name="Measurement Location Relative to Roadway",breaks=x_ordered,labels=x_ordered)+
  ylab(expression(NO["2"]~'Mean (ppb)'))+
  theme(aspect.ratio=1)+
  facet_wrap(~DOW)

return(p)
} #end function