R/mgsplot.scatter.R

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

#' create scatter plots
#' 
#' @param dfIN: dataframe ["X","Y"], ["X","Y","Z"],["X","Y","facet_var"], or ["X","Y","Z",facet_var"]. Where "Z" is the color scale. Names of dataframe columns are used to label the axes, color scale, and facets. 
#' @param file: is the name of the png file that is generated.
#'
#' optional:
#' @param axisscale: = 'linear'(default), can also use 'log10'
#' @param color: logical = FALSE(default), = TRUE uses "Z" input to color points.
#' @param cbin: logical = FALSE(default), = TRUE uses a binned color scale
#' @param colorbins: =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.scatter
#########################################################################

mgsplot.scatter <- function(dfIN,file,axisscale='linear',colorpoints=FALSE,cbin=FALSE,colorbins=c(-1,0,1)){
  #axisscale,color,colorbins
#### 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")]
  
  #actually plot
  p <- ggplot(df.plot,aes(x=Observed,y=Modeled)) + 
    geom_abline(intercept = 0, slope = 1, linetype = 1, size = 1.0,colour = "blue")+
    geom_abline(intercept = 0, slope = 0.5, linetype = 2, size = 1.0,colour = "blue")+
    geom_abline(intercept = 0, slope = 2, linetype = 2, size = 1.0,colour = "blue")+
    theme_bw(base_size = 12, base_family = "Helvetica")+
    xlab(titles[1])+
    ylab(titles[2])
    
  #colored points
    if(color.logical){
      #color scale title  is  title[3]
      if(cbin.logical){ #binned colors
        p <- p+geom_point(aes(fill = factor(c)),size=2,pch=21,size=5,alpha=I(0.2))+
          scale_fill_discrete(name = titles[3], labels = colorbins.labels)
      }else{ #continuous color scale
        p <- p+geom_point(aes(fill = c),size=2,pch=21,size=5,alpha=I(0.2))+
          scale_fill_discrete(name = titles[3], labels = colorbins.labels)
      }
    }else{
      p <- p+geom_point(size=2,fill="grey",colour="black",pch=21,size=5,alpha=I(0.2))
    }

    # axis scale  
    if(axisscale.local=="log10"){
      p <- p+scale_y_log10()+scale_x_log10()
    }
    
    #set square plots & facets
    p<- p+coord_equal()+
    facet_wrap(~f,ncol = nc)+
    theme(aspect.ratio = 1) #end p
  
return(p)
    
} #end function