#' @keywords raw
#' @export
#' @import graphics
#' @title Create Time of Day Spaghetti Plot from a Raw Dataframe
#' @param df enhanced, raw dataframe as created by the \code{raw_enhance()} function
#' @param parameter variable to be plotted
#' @param tlim optional vector with start and end times (integer or character representing YYYYMMDD[HH])
#' @param shadedNight add nighttime shading
#' @param meanCol color used for the mean line (use \code{NA} to omit the mean)
#' @param meanLwd line width used for the mean line
#' @param meanLty line type used for the mean line
#' @param highlightDates dates to be highlighted in YYYYMMDD format
#' @param highlightCol color used for highlighted days
#' @param ... additional graphical parameters are passed to the \code{lines()} function for day lines
#' @description Spaghetti Plot that shows data by hour-of-day.
#' @examples
#' \dontrun{
#' # Fail gracefully if any resources are not available
#' try({
#'
#' raw <- airsis_createRawDataframe(20160901, 20161015, 'USFS', 1012)
#' raw <- raw_enhance(raw)
#' rawPlot_timeOfDaySpaghetti(raw,parameter="temperature")
#'
#' }, silent = FALSE)
#' }
rawPlot_timeOfDaySpaghetti <- function(
df,
parameter = 'pm25',
tlim = NULL,
shadedNight = TRUE,
meanCol = 'black',
meanLwd = 4,
meanLty = 1,
highlightDates = c(),
highlightCol = 'dodgerblue',
...
) {
# Initial Style
dayCol <- 'salmon' #default; can be overwritten with col, e.g. col='blue'
col_shadedNight <- 'gray90'
# Data Preparation ----------------------------------------------------------
# Sanity check -- 'datetime' must exist
if ( !'datetime' %in% names(df) ) {
stop(paste0("Dataframe has no 'datetime' column."))
}
# Pull out timezone and lat/lon
if( length(unique(df$timezone)) > 1 ) {
stop("More than one timezone in the data -- please subset as necessary and try again.")
} else {
tzone <- df$timezone[1]
lat <- df$latitude[1]
lon <- df$longitude[1]
}
# Create new dataframe
df$localTime <- lubridate::with_tz(df$datetime, tzone = tzone)
df$datestamp <- strftime(df$localTime, "%Y%m%d", tz = tzone)
df$hour <- lubridate::hour(df$localTime)
# Create a subset dataframe for local use
df <- df[,c('localTime',parameter,'datestamp','hour')]
names(df) <- c('localTime','data','datestamp','hour')
# Subset dataframe by tlim
if ( !is.null(tlim) ) {
# Chop tlim to full days unless hours included in argument
tlimStrings <- as.character(tlim)
if ( stringr::str_length(tlimStrings)[1] == 8 ) {
tlim[1] <- paste0(tlim[1],'00')
}
if ( stringr::str_length(tlimStrings)[2] == 8 ) {
tlim[2] <- paste0(tlim[2],'23')
}
tlim <- as.POSIXct(tlim, format='%Y%m%d%H', tz = tzone)
df <- df[(df$localTime>=tlim[1] & df$localTime <= tlim[2]),]
}
# Style --------------------------------------------------------------------
argsList <- list(...)
if ( !('col' %in% names(argsList)) ) {
argsList$col <- dayCol
}
if ( !('ylim' %in% names(argsList)) ) {
argsList$ylim <- c(min(df$data,na.rm = TRUE),max(df$data,na.rm = TRUE))
}
if ( !('ylab' %in% names(argsList)) ) {
if ( parameter=='pm25' ) {
argsList$ylab <- "PM2.5"
} else {
argsList$ylab <- parameter
}
}
if ( !('xlab' %in% names(argsList)) ) {
argsList$xlab <- "Hour"
}
# Plotting ------------------------------------------------------------------
# Define data for plot bounds
argsList$x <- df$hour
argsList$y <- df$data
# Set up duplicate argsList for blank plot
argsListBlank <- argsList
# Assign blankness to duplicate argsList
argsListBlank$col <- 'transparent'
argsListBlank$axes <- FALSE
# Plot blank plot
do.call(plot,argsListBlank)
# Add Shaded Night
if ( shadedNight ) {
# Get the sunrise/sunset information
ti <- timeInfo(df$localTime, longitude=lon, latitude=lat, timezone=tzone)
# Extract the middle row
ti <- ti[round(nrow(ti)/2),]
# Get sunrise and sunset in units of hours
sunrise <- lubridate::hour(ti$sunrise) + lubridate::minute(ti$sunrise)/60
sunset <- lubridate::hour(ti$sunset) + lubridate::minute(ti$sunset)/60
# Left edge to sunrise
rect(par('usr')[1], ybottom=par('usr')[3],
xright=sunrise, ytop=par('usr')[4],
col=col_shadedNight, border=NA)
# Sunset to right edge
rect(xleft=sunset, ybottom=par('usr')[3],
xright=par('usr')[2], ytop=par('usr')[4],
col=col_shadedNight, border=NA)
}
# Annotations
axis(1,at=seq(0,23,3))
axis(2,las=1)
# Simple line plot for each day
for ( singleDay in unique(df$datestamp) ) {
dayDF <- dplyr::filter(df, df$datestamp == singleDay)
argsList$x <- dayDF$hour
argsList$y <- dayDF$data
if ( singleDay %in% highlightDates ) {
argsList$col <- highlightCol
do.call(lines,argsList)
argsList$col <- dayCol
} else {
do.call(lines,argsList)
}
}
# Add mean line
hourMeanDF <- data.frame(hour=seq(0,23))
for (hr in 0:23) {
hourMeanDF$data[hr+1] <- mean(df$data[which(df$hour==hr)],na.rm = TRUE)
}
lines(hourMeanDF$data ~ hourMeanDF$hour, col=meanCol, lwd=meanLwd, lty=meanLty)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.