Nothing
#' @keywords ws_monitor
#' @title Create Daily Barplot
#'
#' @description
#' Creates a bar plot showing daily average PM 2.5 values for a specific monitor
#' in a \emph{ws_monitor} object. Each bar is colored according to its AQI
#' category.
#'
#' This function is a wrapper around \code{base::barplot} and any arguments to
#' that function may be used.
#'
#' Each 'day' is the midnight-to-midnight period in the monitor local timezone.
#' When \code{tlim} is used, it is converted to the monitor local timezone.
#'
#' @param ws_monitor \emph{ws_monitor} object
#' @param monitorID monitor ID for a specific monitor in \code{ws_monitor}
#' (optional if \code{ws_monitor} only has one monitor)
#' @param tlim optional vector with start and end times (integer or character
#' representing YYYYMMDD[HH] or \code{POSIXct})
#' @param minHours minimum number of valid data hours required to calculate each
#' daily average
#' @param gridPos position of grid lines either 'over', 'under' ('' for no grid
#' lines)
#' @param gridCol color of grid lines (see graphical parameter 'col')
#' @param gridLwd line width of grid lines (see graphical parameter 'lwd')
#' @param gridLty type of grid lines (see graphical parameter 'lty')
#' @param labels_x_nudge nudge x labels to the left
#' @param labels_y_nudge nudge y labels down
#' @param ... additional arguments to be passed to \code{barplot()}
#'
#'
#' @details
#' The \code{labels_x_nudge} and \code{labels_y_nudge} can be used to tweak the
#' date labeling. Units used are the same as those in the plot.
#'
#' @import graphics
#' @export
#'
#' @examples
#' library(PWFSLSmoke)
#'
#' N_M <- monitor_subset(Northwest_Megafires, tlim = c(20150715, 20150930))
#' main <- "Daily Average PM2.5 for Omak, WA"
#' monitor_dailyBarplot(N_M, monitorID = "530470013_01", main = main,
#' labels_x_nudge = 1)
#' addAQILegend(fill = rev(AQI$colors), pch = NULL)
monitor_dailyBarplot <- function(
ws_monitor,
monitorID = NULL,
tlim = NULL,
minHours = 18,
gridPos = "",
gridCol = "black",
gridLwd = 0.5,
gridLty = "solid",
labels_x_nudge = 0,
labels_y_nudge = 0,
...
) {
# Sanity check
if (monitor_isEmpty(ws_monitor)) {
stop("ws_monitor object contains zero monitors")
}
# Data Preparation ----------------------------------------------------------
# Allow single monitor objects to be used without specifying monitorID
if (is.null(monitorID)) {
if (nrow(ws_monitor$meta) == 1) {
monitorID <- ws_monitor$meta$monitorID[1]
} else {
stop(
paste0(
"ws_monitor object contains data for > 1 monitor. Please specify a monitorID from: '",
paste(ws_monitor$meta$monitorID, collapse = "', '"), "'"
)
)
}
}
# When tlim is specified in whole days we should add hours to get the requsted full days
if ( !is.null(tlim) ) {
if ( "POSIXct" %in% class(tlim) ) {
tlimStrings <- strftime(tlim, "%Y%m%d", tz = "UTC")
} else {
tlimStrings <- as.character(tlim)
}
if ( stringr::str_length(tlimStrings)[1] == 8 ) {
tlimStrings[1] <- paste0(tlimStrings[1], "00")
}
if ( stringr::str_length(tlimStrings)[2] == 8 ) {
tlimStrings[2] <- paste0(tlimStrings[2], "23")
}
# Recreate tlim
tlim <- tlimStrings
}
# Subset to a single monitor
timezone <- as.character(ws_monitor$meta[monitorID, "timezone"])
mon <- monitor_subset(ws_monitor, monitorIDs = monitorID, tlim = tlim, timezone = timezone)
# Calculate the daily mean
mon_dailyMean <- monitor_dailyStatistic(mon, FUN = get("mean"), dayStart = "midnight",
na.rm = TRUE, minHours = minHours)
localTime <- mon_dailyMean$data$datetime
pm25 <- as.numeric(mon_dailyMean$data[, monitorID])
# Plot command default arguments ---------------------------------------------
argsList <- list(...)
argsList$height <- pm25
# Default colors come from pm25Daily means
if ( !("col" %in% names(argsList)) ) {
argsList$col <- aqiColors(pm25)
}
# X axis labeling is handled after the plot
# NOTE: For mathematical notation in R see:
# NOTE: http://vis.supstat.com/2013/04/mathematical-annotation-in-r/
# Y axis labeling
if ( !("ylab" %in% names(argsList)) ) {
argsList$ylab <- expression(paste("PM"[2.5] * " (", mu, "g/m"^3 * ")"))
}
# Additional small tweaks
argsList$las <- ifelse("las" %in% names(argsList), argsList$las, 1)
# Title
if ( !("main" %in% names(argsList)) ) {
argsList$main <- expression(paste("Daily Average PM"[2.5]))
}
# Explicitly declare defaults for use in creating the x axis
argsList$axes <- ifelse("axes" %in% names(argsList), argsList$axes, TRUE)
argsList$space <- ifelse("space" %in% names(argsList), argsList$space, 0.2)
argsList$cex.names <-
ifelse("cex.names" %in% names(argsList), argsList$cex.names, par("cex.axis"))
# Plotting ------------------------------------------------------------------
if ( gridPos == "under" ) {
do.call(barplot, argsList)
abline(h = axTicks(2)[-1], col = gridCol, lwd = gridLwd, lty = gridLty)
argsList$add <- TRUE
}
do.call(barplot, argsList)
# Add default X axis
if ( argsList$axes && !("names.arg" %in% names(argsList)) ) {
barCount <- length(argsList$height)
allIndices <- 1:barCount
allLabels <- strftime(localTime, "%b %d", tz = timezone)
maxLabelCount <- 16
stride <- round(barCount / maxLabelCount)
if ( stride == 0 ) {
indices <- allIndices
labels <- allLabels
} else {
indices <- allIndices[seq(1, barCount, by = stride)]
labels <- allLabels[seq(1, barCount, by = stride)]
}
labels_x <- (indices - 0.5) + (indices * argsList$space)
labels_y <- -0.06 * (par("usr")[4] - par("usr")[3])
# Add tilted dates
text(
labels_x - labels_x_nudge, labels_y - labels_y_nudge,
labels, srt = 45, cex = argsList$cex.names, xpd = NA
)
# Now add tick marks
axis(1, at = labels_x, labels = FALSE, lwd = 0, lwd.ticks = 1)
}
# Add horizontal bars
if ( gridPos == "over" ) {
abline(h = axTicks(2)[-1], col = gridCol, lwd = gridLwd, lty = gridLty)
}
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.