R/compare_two_elements.R

In USGS-R/wateRuse: wateRuse data analysis functions

#' compare_two_elements
#'
#' Returns scatter plot for 2 data elements for years of interest.
#' Option to narrow down data geographically
#' 
#' @param w.use dataframe, the water use data 
#' @param data.elements.x.y chr, 2-element vector of data elements to be plotted 
#' @param areas chr, codes indicating HUCs, counties, states, aquifers, etc. 
#' @param years int, vector specifying the years to be plotted (1 plot per year)
#' @param area.column chr, defines which column to use to specify area
#' @param legend is a logical function to include list of counties in a legend if manageable, default is FALSE
#' @param c.palette color palette to use for points
#' 
#' @export
#' 
#' @import ggplot2 
#' @importFrom tidyr gather_
#' 
#' @examples 
#' w.use <- wUseSample
#' data.elements.x.y <- c("TP.TotPop", "PS.WSWFr")
#' areas <- "10" # NA uses all areas
#' area.column <- "STATECODE"
#' years <- c(2000, 2005, 2010)
#' compare_two_elements(w.use, data.elements.x.y, years, area.column, areas)
#' compare_two_elements(w.use, data.elements.x.y, years, area.column)
#' compare_two_elements(w.use, data.elements.x.y, "2010", area.column)
compare_two_elements <- function(w.use, data.elements.x.y, years, area.column, 
                                 areas=NA, legend= FALSE,
                                 c.palette = c("#999999", "#E69F00", "#56B4E9", "#009E73", "#F0E442", "#0072B2", "#D55E00", "#CC79A7")){ 
  
  w.use.sub <- subset_wuse(w.use, data.elements.x.y, area.column, areas)
  
  w.use.sub <-  w.use.sub[w.use.sub$YEAR %in% years,] 
  
  x <- gather_(w.use.sub, "Element", "Value", data.elements.x.y)
  
  for(i in years){
    df <- data.frame(
      x = x[x$Element == data.elements.x.y[1] & x$YEAR == i,][["Value"]],
      y = x[x$Element == data.elements.x.y[2] & x$YEAR == i,][["Value"]],
      site = x[x$Element == data.elements.x.y[2] & x$YEAR == i,][[area.column]],
      stringsAsFactors = FALSE)
    
    df$YEAR <- i
    
    if(i == years[1]){
      df_full <- df
    } else {
      df_full <- rbind(df_full, df)
    }
  }
  
  if(all(is.na(df_full$x))){
    df_full$x <- 0
    message("No data reported for:",data.elements.x.y[1])
  }
  
  if(all(is.na(df_full$y))){
    df_full$y <- 0
    message("No data reported for:",data.elements.x.y[2])
  }
  
  if(length(unique(df_full$site)) > length(c.palette)){
    c.palette.ramp <- colorRampPalette(c.palette)
    c.palette <- c.palette.ramp(length(unique(df_full$site)))
  }
  
  fix.labs <- gsub("\\,","\\,\n",dataelement$NAME)
  names(fix.labs) <- dataelement$DATAELEMENT
  
  compare.plot <- ggplot(data = df_full) +
    geom_point(aes_string(x = "x", y = "y", color = "site"), 
               show.legend = legend, size = 3) +
    facet_wrap(~ YEAR, ncol = 1) +
    xlab(fix.labs[gsub(pattern = "\\.", replacement = "-", x = data.elements.x.y[1])]) +
    ylab(fix.labs[gsub(pattern = "\\.", replacement = "-", x = data.elements.x.y[2])]) 
    # scale_colour_manual(values=c.palette) 
  
  if(!legend){
    compare.plot <- compare.plot + theme(legend.position = "none")
  }
  
  return(compare.plot)
  
}# compare_two_elements