R/mgsplot.windrose.R

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

#' create wind rose
#'
#' @param data
#' 
#' @return ggplot object
#' 
#' @import ggplot2
#' @import scales
#' @import RColorBrewer
#'
#' @export mgsplot.windrose
#########################################################################
mgsplot.windrose <- function(data,
                          spd,
                          dir,
                          spdres = 2,
                          dirres = 30,
                          spdmin = 2,
                          spdmax = 20,
                          spdseq = NULL,
                          #palette = "YlGnBu", #MGS changed this color palette
                          palette = "Spectral",
                          #countmax = NA,#MGS commented out this option
                          prctmax = 15, #MGS
                          prctseq = NULL, #MGS
                          bin = NULL, #MGS
                          debug = 0){
  
  
  # Look to see what data was passed in to the function
  if (is.numeric(spd) & is.numeric(dir)){
    if (missing(bin)){
      # assume that we've been given vectors of the speed and direction vectors
    data <- data.frame(spd = spd,
                       dir = dir)
    spd = "spd"
    dir = "dir"
    }else{
      # assume that we've been given vectors of the speed and concentration vectors
      data <- data.frame(spd = spd,
                         dir = dir,
                         bin = bin)
      spd = "spd"
      dir = "dir"
      bin = "bin"
      nc = ceiling(length(unique(data$bin))/3)
    }
  } else if (exists("data")){
    # Assume that we've been given a data frame, and the name of the speed 
    # and direction columns. This is the format we want for later use.    
  }  
  
  # Tidy up input data ----
  n.in <- NROW(data)
  dnu <- (is.na(data[[spd]]) | is.na(data[[dir]]))
  data[[spd]][dnu] <- NA
  data[[dir]][dnu] <- NA
  
  # figure out the wind speed bins ----
  if (missing(spdseq)){
    spdseq <- seq(spdmin,spdmax,spdres)
  } else {
    if (debug >0){
      cat("Using custom speed bins \n")
    }
  }
  # get some information about the number of bins, etc.
  n.spd.seq <- length(spdseq)
  n.colors.in.range <- n.spd.seq - 1
  
  # create the color map
  spd.colors <- colorRampPalette(brewer.pal(min(max(3,
                                                    n.colors.in.range),
                                                min(9,
                                                    n.colors.in.range)),                                               
                                            palette))(n.colors.in.range)
  
  #spd.colors <- colorRampPalette(c("blue","red"))(n.colors.in.range)
  
  if (max(data[[spd]],na.rm = TRUE) > spdmax){    
    spd.breaks <- c(spdseq,
                    max(data[[spd]],na.rm = TRUE))
    spd.labels <- c(paste(c(spdseq[1:n.spd.seq-1]),
                          '-',
                          c(spdseq[2:n.spd.seq])),
                    paste(spdmax,
                          "-",
                          max(data[spd],na.rm = TRUE)))
    spd.colors <- c(spd.colors, "grey50")
  } else{
    spd.breaks <- c(seq(spdseq))
    spd.labels <- paste(c(spdseq[1:n.spd.seq-1]),
                        '-',
                        c(spdseq[2:n.spd.seq]))    
  }
  data$spd.binned <- cut(x = data[[spd]],
                         breaks = spd.breaks,
                         labels = spd.labels,
                         ordered_result = TRUE)
  
  # figure out the wind direction bins
  dir.breaks <- c(-dirres/2,
                  seq(dirres/2, 360-dirres/2, by = dirres),
                  360+dirres/2)  
  #dir.labels <- c(paste(360-dirres/2,"-",dirres/2),
  #                paste(seq(dirres/2, 360-3*dirres/2, by = dirres),
  #                      "-",
  #                      seq(3*dirres/2, 360-dirres/2, by = dirres)),
  #                paste(360-dirres/2,"-",dirres/2))
  
  dir.labels <- c("N","NNE","ENE","E","ESE","SSE","S","SSW","WSW","W","WNW","NNW","N") #MGS
  
  # assign each wind direction to a bin
  dir.binned <- cut(data[[dir]],
                    breaks = dir.breaks,
                    ordered_result = TRUE)
  levels(dir.binned) <- dir.labels
  data$dir.binned <- dir.binned
  
  # Run debug if required ----
  if (debug>0){    
    cat(dir.breaks,"\n")
    cat(dir.labels,"\n")
    cat(levels(dir.binned),"\n")
    cat(speedcuts.colors, "\n")    
  }  
  
  # create the plot ----
  if (missing(prctseq)){
    if (!is.na(prctmax)){
      ybreaks <- seq(5,prctmax,2.5)
    }else{
      ybreaks <- seq(5,15,2.5)
    }
  }else{
    ybreaks <- prctseq
  }
  
  ybreaks.prct <- ybreaks/100
  
  p.windrose <- ggplot(data = data,
                       aes(x = dir.binned,y = (..count..)/sum(..count..),
                           fill = spd.binned)) +
                            geom_bar()+
    scale_y_continuous(breaks = ybreaks.prct,labels=percent)+
    ylab("")+
    scale_x_discrete(drop = FALSE,
                     labels = waiver()) +
    xlab("")+
    coord_polar(start = -((dirres/2)/360) * 2*pi) +
    scale_fill_manual(name = "Wind Speed (m/s)", 
                      values = spd.colors,
                      drop = FALSE)+
    theme_bw(base_size = 12, base_family = "Helvetica")
  
  if (!missing(bin)){
    p.windrose <- p.windrose+facet_wrap(~bin,ncol = nc)
  }
  
  # return the handle to the wind rose
  return(p.windrose)
}