testing.R

# Testing

library("ggplot2")
library("cowplot")
library(devtools)
library("scales")
library("lubridate")
#install_github("BigelowLab/ndfd")

library("ndfd")

zips <- "32311"

zipReturnDF <- function(zip, unitConvert){
  inputQuery <- query_this(what = 'zipcodes', zipCodeList = zip, element = c('rh','temp','wspd'))
  outputQuery <- NDFD(inputQuery)
  
  ws <- outputQuery$data$get_data(name = "wind-speed")
  rh <- outputQuery$data$get_data(name = "humidity")
  tmp <- outputQuery$data$get_data(name = "temperature")
  
  names(ws)[3] <- "windspeed"
  names(rh)[3] <- "rh"
  names(tmp)[3] <- "temp"
  
  returnDF <- data.frame("dt" = ws$start_valid_time,"windspeed" = ws$windspeed,"rh" = rh$rh,"temp" = tmp$temp)
  
  if(unitConvert == TRUE)
  {
    returnDF$windspeed <- returnDF$windspeed * 2.236936
    returnDF$temp <- returnDF$temp * 1.8 + 32
  }
  
  return(returnDF)
}

test <- zipReturnDF(zips,unitConvert = TRUE)

interpolateTime <- function(DF,type){
  if(type == "spline"){
    rh <- data.frame(spline(DF$dt,DF$rh,method = "fmm", n = 2000))
    temp <- data.frame(spline(DF$dt,DF$temp,method = "fmm", n = 2000))
    ws <- data.frame(spline(DF$dt,DF$windspeed,method = "fmm", n = 2000))
    
  }
  
  if(type == "linear"){
  rh <- data.frame(approx(DF$dt,DF$rh,rule = 2, method = "linear", ties = mean, n = 2000))
  temp <- data.frame(approx(DF$dt,DF$temp,rule = 2, method = "linear", ties = mean, n = 2000))
  ws <- data.frame(approx(DF$dt,DF$windspeed,rule = 2, method = "linear", ties = mean, n = 2000))
  }
  
  names(rh) <- c("dt","rh")
  names(temp) <- c("dt","temp")
  names(ws) <- c("dt","windspeed")
  
  returnDF <- merge(rh,temp,by="dt")
  returnDF <- merge(returnDF, ws, by = "dt")
  
  returnDF$dt <- as.POSIXct(returnDF$dt,origin = "1970-01-01")
  
  return(returnDF)
}

testOutput <- interpolateTime(test,type = "spline")


testOutput$dt <- with_tz(testOutput$dt, tzone = "MST")

diagPlot <- function(df,origDF){
  library("cowplot")
  
  RH <- ggplot(data = df, aes(x = dt, y = rh))+
    geom_point(color = "gray")+
    geom_point(data = origDF, aes(x = dt, y = rh), color="red")+
    xlab("Date / Time")+
    ylab("Relative Humidity (%)")
  
  
  WS <- ggplot(data = df, aes(x = dt, y = windspeed))+
    geom_point(color = "gray")+
    geom_point(data = origDF, aes(x = dt, y = windspeed),color="red")+
    xlab("Date / Time")+
    ylab("Wind Speed (mph)")
  
  tmp <- ggplot(data = df, aes(x = dt, y = temp))+
    geom_point(color = "gray")+
    geom_point(data = origDF, aes(x = dt, y = temp),color="red")+
    xlab("Date / Time")+
    ylab("Temperature (F)")
  
  returnGrid <- plot_grid(RH, WS, tmp, labels = c('A', 'B', 'C'), label_size = 12)
  
  return(returnGrid)  
}

diagPlot(testOutput,test)

prescription <- function(df,tempHi = 75,tempLo = 50, windHi = 8, windLo = 3,rhHi = 40, rhLo = 20){
  df$tempRx <- NA
  df$windRx <- NA
  df$rhRx <- NA
  
  try(df[which(df$windspeed <= windHi & df$windspeed >= windLo),]$windRx <- "In Prescription")
  df[which(is.na(df$windRx)),]$windRx <- "Out of Prescription"
  
  try(df[which(df$temp <= tempHi & df$temp >= tempLo),]$tempRx <- "In Prescription")
  df[which(is.na(df$tempRx)),]$tempRx <- "Out of Prescription"
  
  try(df[which(df$rh <= rhHi & df$rh >= rhLo),]$rhRx <- "In Prescription")
  df[which(is.na(df$rhRx)),]$rhRx <- "Out of Prescription"
  
  return(df)
}

test4 <- prescription(df = testOutput)

rxPlot <- function(df){
  library("cowplot")
  
  cols <- c("In Prescription" = "darkgreen", "Out of Prescription" = "gray")
  
  
  RH <- ggplot(data = df, aes(x = dt, y = rh, color = rhRx))+
    scale_colour_manual("RH Prescription", values = cols)+
    geom_point()+
    xlab("")+
    ylab("Relative Humidity (%)")+
    scale_x_datetime(labels = date_format("%F %H%M"),
                     date_breaks = "4 hours")+
    theme(axis.text.x=element_blank())
 
  
  
  WS <- ggplot(data = df, aes(x = dt, y = windspeed, color = windRx))+
    scale_colour_manual("Wind Prescription", values = cols)+
    geom_point()+
    xlab("")+
    ylab("Wind Speed (mph)")+
    scale_x_datetime(labels = date_format("%F %H%M"),
                     date_breaks = "4 hours")+
    theme(axis.text.x=element_blank())
  
  tmp <- ggplot(data = df, aes(x = dt, y = temp, color = tempRx))+
    scale_colour_manual("Temperature Prescription", values = cols)+
    geom_point()+
    xlab("Date / Time")+
    ylab("Temperature (F)")+
    scale_x_datetime(labels = date_format("%F %H%M"),
                     date_breaks = "4 hours")+
    theme(axis.text.x = element_text(size = 8, angle = 60, hjust = 1)) 
  
  returnGrid <- plot_grid(RH, WS, tmp, label_size = 12,align = "v",ncol=1)
  
  return(returnGrid)  
}

rxPlot(test4)