R/shinyPlot_HUC_Time_Series_and_Differences.R
In ssaxe-usgs/METsteps: Aggregate Data to the HUC 2-10 Levels (one line, title case)
Defines functions
shinyPlot_HUC_Time_Series_and_Difference
Documented in
shinyPlot_HUC_Time_Series_and_Difference
#' Primary Time Series and Difference Plot after HUC Click
#'
#' Description goes here.
#' @param x Numeric; The values to be plotted.
#' @param col Character; The plot color.
#' @export
#' @return Numeric vector.
#' @examples
#' shinyPlot_HUC_Time_Series_and_Difference()
shinyPlot_HUC_Time_Series_and_Difference <- function(default. = FALSE,
feederList. = NULL,
x = subToHUC,
iv = oShinyValues,
ptSP. = ptSP.trim,
timeStep. = timeStep,
path.obs. = path.obs,
col = cbPalette,
ablCol = 'darkgrey',
colDif = 'firebrick',
HCU. = HCU,
dataCategory. = dataCategory,
multiplot.cex = 1.4,
multiplot.lab = 1.4,
cex.main = 1.2,
...){
# Extract sliderTime. from feederList
if (!is.null(feederList.)){
sliderTime. <- feederList.$slider_time
}else{
sliderTime. <- NULL
}
# Create plot
if (default.){
if (is.null(sliderTime.)){
drange <- NULL
}else{
#drange <- lubridate::decimal_date(as.Date(sliderTime.))
drange <- as.Date(ISOdate(year = sliderTime.,
month = c(1,12),
day = c(1,31)))
}
layout(mat = matrix(data = c(1,2,3,4),
nrow = 4,
ncol = 1,
byrow = T),
widths = 1,
heights = c(2, 1, 0.5, 0.75))
par(mar = c(0,0,0,0), oma = c(3,6,3,3))
#-- ET direct data plot
plot(x = 1,
type = 'n',
main = '',
xaxs = "i",
ylab = '(mm)',
xlim = drange,
xlab = '',
xaxt = 'n',
cex.axis = multiplot.cex,
cex.lab = multiplot.lab)
mtext(text = paste('HUC'),
line = 1,
font = 2,
cex = cex.main)
mtext(text = paste0(' ','\n(mm)'),
side = 2,
line = 3)
#-- Difference plot
plot(x = 1,
type = 'n',
main = '',
xaxs = "i",
ylab = 'Diff (mm)',
xlab = '',
xlim = drange,
xaxt = 'n',
yaxt = 'n',
cex.lab = multiplot.lab)
axis(side = 4,
cex.axis = multiplot.cex)
mtext(text = 'Diff\n(mm)',
side = 2,
line = 3)
#-- sd plot
plot(x = 1,
type = 'n',
main = '',
xaxs = "i",
ylab = 'Standard\nDev',
xlab = 'Time',
xlim = drange,
cex.axis = multiplot.cex,
cex.lab = multiplot.lab)
mtext(text = 'Standard\nDev',
side = 2,
line = 3)
#-- legend
frame()
}else{
if (is.null(sliderTime.)){
drange <- NULL
}else{
drange <- as.Date(sliderTime.)
}
layout(mat = matrix(data = c(1,2,3,4),
nrow = 4,
ncol = 1,
byrow = T),
widths = 1,
heights = c(2, 1, 0.5, 0.75))
par(mar = c(0,0,0,0), oma = c(3,6,3,3))
#------ ET direct data plot
# start plot with first dataset
if (!is.null(drange)){
y <- x[((as.Date(zoo::index(x)) >= as.Date(drange[1])) & (as.Date(zoo::index(x)) <= as.Date(drange[2]))),]
if (is.null(dim(y))) {
x <- zoo::as.zoo(as.data.frame(y))
zoo::index(x) <- as.Date(zoo::index(y))
}else{
x <- y
}
}
# Set background color
if (!is.null(ptSP.)){
if (feederList.$showObs_InvEnvColors){
man.bg <- 'lightgrey'
man.abl <- 'white'
man.minmax <- 'white'
man.2575 <- 'darkgrey'
}else{
man.bg <- 'white'
man.abl <- ablCol
man.minmax <- 'lightgrey'
man.2575 <- 'darkgrey'
}
}else{
man.bg <- 'white'
man.abl <- ablCol
man.minmax <- 'lightgrey'
man.2575 <- 'darkgrey'
}
if ((!is.null(ptSP.))){
if (!is.null(iv)){
if (feederList.$showObs_quantEnv){
ylimRange <- range(c(min(iv$envInput$y25, na.rm = T), max(iv$envInput$y75, na.rm = T),
range(range(x, na.rm = T))),
na.rm = T)
}
if (feederList.$showObs_minmaxEnv){
ylimRange <- range(c(min(iv$envInput$yMin, na.rm = T), max(iv$envInput$yMax, na.rm = T),
range(range(x, na.rm = T))),
na.rm = T)
}
}else{
ylimRange <- range(range(x, na.rm = T))
}
}else{
ylimRange <- range(range(x, na.rm = T))
}
plot(x = x[,1],
col = col[1],
main = '',
xaxs = "i",
ylab = paste0(dataCategory.,'\n(mm)'),
#xlim = drange,
type = 'n',
ylim = ylimRange,
xlab = '',
xaxt = 'n',
cex.axis = multiplot.cex,
cex.lab = multiplot.lab,
cex.main = cex.main,
lwd = 2,
yaxs = 'i')
rect(par("usr")[1],par("usr")[3],par("usr")[2],par("usr")[4],col = man.bg)
# Calc and include obs data as necessary
if (!is.null(ptSP.)){
# if (feederList.$showObs_minmaxEnv || feederList.$showObs_quantEnv || feederList.$showObs){
# iv <- METsteps::zooEnvParameters(zoo.fnames = paste0(path.obs., ptSP.@data$OurID, '.csv'),
# timeStep2 = timeStep.)
# }else{
# iv <- NULL
# }
if (feederList.$showObs_minmaxEnv & !is.null(iv)){
envelope(xall = iv$envInput$xMinMax,
y1 = iv$envInput$yMax,
y2 = iv$envInput$yMin,
col = man.minmax,
border = man.minmax)
}
if (feederList.$showObs_quantEnv & !is.null(iv)){
envelope(xall = iv$envInput$x2575,
y1 = iv$envInput$y75,
y2 = iv$envInput$y25,
col = man.2575,
border = man.2575)
}
if (feederList.$showObs & !is.null(iv)){
lines(iv$envZoo$envMean, lty=2)
}
}else{
iv <- NULL
}
lines(x = x[,1],
col = col[1],
lwd = 2)
mtext(text = paste('HUC', HCU.),
line = 1,
font = 2,
cex = cex.main)
mtext(text = paste0(dataCategory.,'\n(mm)'),
side = 2,
line = 3)
# add remaining datasets with line() function and calculate ensemble mean
if (ncol(x) > 1){
for (i in 2:ncol(x)){
lines(x = x[,i],
col = cbPalette[i],
xaxs = "i",
lwd = 2)
}
# Calculate ensemble means and add to plot
ensembleMeans <- zoo::zoo(rowMeans(x), stats::time(x))
points(x = ensembleMeans,
col = 'black',
xaxs = 'i',
lwd = 2,
pch = 16)
lines(x = ensembleMeans,
col = 'black',
xaxs = 'i',
lwd = 1,
lty = 1)
}
# abline(v = unique(as.integer(zoo::index(x))),
# col = ablCol,
# lty = 2)
yrs <- as.Date(ISOdate(year = unique(lubridate::year(index(x))),
month = 1,
day = 1))
abline(v = yrs,
col = man.abl,
lty = 2)
#------ Difference Plot
#par(mar = c(0, 6.2, 0, 2.1))
if (ncol(x) == 1){
plot(x = x,
type = 'n',
main = '',
xaxs = 'i',
ylab = 'Diff (mm)',
xlab = '',
xaxt = 'n',
yaxt = 'n',
#xlim = drange,
cex.axis = multiplot.cex,
cex.lab = multiplot.lab)
axis(side = 4,
cex.axis = multiplot.cex)
yrs <- as.Date(ISOdate(year = unique(lubridate::year(index(x))),
month = 1,
day = 1))
abline(v = yrs,
col = ablCol,
lty = 2)
# abline(v = unique(lubridate::year(zoo::index(x))),
# col = ablCol,
# lty = 2)
abline(h = 0,
col = ablCol,
lty = 1)
mtext(text = 'Diff\n(mm)',
side = 2,
line = 3)
}
if (ncol(x) == 2){
plot(x = x[,2] - x[,1],
col = colDif,
main = '',
xaxs = "i",
ylab = 'Diff (mm)',
xlab = '',
xaxt = 'n',
yaxt = 'n',
#xlim = drange,
cex.axis = multiplot.cex,
cex.lab = multiplot.lab,
lwd = 2)
axis(side = 4,
cex.axis = multiplot.cex)
# abline(v = unique(as.integer(zoo::index(x))),
# col = ablCol,
# lty = 2)
yrs <- as.Date(ISOdate(year = unique(lubridate::year(index(x))),
month = 1,
day = 1))
abline(v = yrs,
col = ablCol,
lty = 2)
abline(h = 0,
col = ablCol,
lty = 1)
mtext(text = 'Diff\n(mm)',
side = 2,
line = 3)
}
if (ncol(x) > 2){
combinations <- t(combn(x = ncol(x),
m = 2))
combFUNdif <- function(combrow, x){
x[, combrow[2]] - x[, combrow[1]]
}
difmat <- zoo::as.zoo(apply(X = combinations,
MARGIN = 1,
FUN = combFUNdif,
x = x))
zoo::index(difmat) <- zoo::index(x)
plot(x = difmat[,1],
col = colDif,
main = '',
xaxs = "i",
ylab = 'Diff (mm)',
xlab = '',
#xlim = drange,
xaxt = 'n',
yaxt = 'n',
cex.axis = multiplot.cex,
cex.lab = multiplot.lab,
lwd = 2,
ylim = c(min(difmat, na.rm = T),
max(difmat, na.rm = T)))
axis(side = 4,
cex.axis = multiplot.cex)
for (i in 2:ncol(difmat)){
lines(x = difmat[,i],
xaxs = 'i',
col = colDif,
lwd = 2,
lty = i)
}
# abline(v = unique(as.integer(index(x))),
# col = ablCol,
# lty = 2)
yrs <- as.Date(ISOdate(year = unique(lubridate::year(index(x))),
month = 1,
day = 1))
abline(v = yrs,
col = ablCol,
lty = 2)
abline(h = 0,
col = ablCol,
lty = 1)
mtext(text = 'Diff\n(mm)',
side = 2,
line = 3)
}
#------ sd Plot
if (ncol(x) > 1){
#Calculate standard deviation
sdZoo <- apply(X = x,
MARGIN = 1,
FUN = sd,
na.rm = T)
sdZoo <- zoo::zoo(sdZoo)
zoo::index(sdZoo) <- zoo::index(x)
plot(x = sdZoo,
type = 'l',
main = '',
xaxs = "i",
ylab = 'Standard\nDev',
xlab = 'Time',
#xlim = drange,
cex.axis = multiplot.cex,
cex.lab = multiplot.lab)
# abline(v = unique(as.integer(index(x))),
# col = ablCol,
# lty = 2)
yrs <- as.Date(ISOdate(year = unique(lubridate::year(index(x))),
month = 1,
day = 1))
abline(v = yrs,
col = ablCol,
lty = 2)
abline(h = 0,
col = ablCol,
lty = 1)
mtext(text = 'Standard\nDev',
side = 2,
line = 3)
}else{
plot(x = x,
type = 'n',
main = '',
xaxs = "i",
ylab = 'Standard\nDev',
xlab = 'Time',
#xlim = drange,
cex.axis = multiplot.cex,
cex.lab = multiplot.lab)
# abline(v = unique(as.integer(index(x))),
# col = ablCol,
# lty = 2)
yrs <- as.Date(ISOdate(year = unique(lubridate::year(index(x))),
month = 1,
day = 1))
abline(v = yrs,
col = ablCol,
lty = 2)
abline(h = 0,
col = ablCol,
lty = 1)
mtext(text = 'Standard\nDev',
side = 2,
line = 3)
}
#------ legend
plot(1, type = 'n', bty = 'n', xaxt = 'n', yaxt = 'n', xlim = c(0,1), ylim = c(0,1))
# add legend
if (feederList.$showObs & !is.null(iv)){
if (ncol(x) > 1){
legend(x = 'bottom',
legend = c(dnames, 'Ens. Mean', 'Mean Obs'),
pch = c(rep(15, length(dnames)), 15, NA),
lty = c(rep(NA, length(dnames)), NA, 2),
col = c(cbPalette[1:ncol(x)], 'black', 'black'),
pt.cex = 2,
cex = 1.2,
horiz = F,
bty = 'n',
ncol = floor(length(c(dnames, 'Ens. Mean', 'Mean Obs'))/2),
x.intersp = 1,
y.intersp = 1,
inset = 0
)
}else{
legend(x = 'bottom',
legend = c(dnames, 'Mean Obs'),
pch = c(rep(15, length(dnames)), NA),
lty = c(rep(NA, length(dnames)), 2),
col = c(cbPalette[1:ncol(x)], 'black'),
pt.cex = 2,
cex = 1.2,
horiz = T,
bty = 'n',
ncol = floor(length(c(dnames, 'Mean Obs'))/2),
x.intersp = 1,
y.intersp = 1,
inset = 0
)
}
}else{
if (ncol(x) > 1){
legend(x = 'bottom',
legend = c(dnames, 'Ens. Mean'),
pch = 15,
col = c(cbPalette[1:ncol(x)], 'black'),
pt.cex = 2,
cex = 1.2,
horiz = T,
bty = 'n',
ncol = floor(length(c(dnames, 'Ens. Mean'))/2),
x.intersp = 1,
y.intersp = 1,
inset = 0
)
}else{
legend(x = 'bottom',
legend = dnames,
pch = 15,
col = cbPalette[1:ncol(x)],
pt.cex = 2,
cex = 1.2,
horiz = T,
bty = 'n',
ncol = floor(length(c(dnames))/2),
x.intersp = 1,
y.intersp = 1,
inset = 0
)
}
}
}
}
ssaxe-usgs/METsteps documentation built on May 5, 2019, 5:54 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Defines functions shinyPlot_HUC_Time_Series_and_Difference
Documented in shinyPlot_HUC_Time_Series_and_Difference
#' Primary Time Series and Difference Plot after HUC Click
#'
#' Description goes here.
#' @param x Numeric; The values to be plotted.
#' @param col Character; The plot color.
#' @export
#' @return Numeric vector.
#' @examples
#' shinyPlot_HUC_Time_Series_and_Difference()
shinyPlot_HUC_Time_Series_and_Difference <- function(default. = FALSE,
feederList. = NULL,
x = subToHUC,
iv = oShinyValues,
ptSP. = ptSP.trim,
timeStep. = timeStep,
path.obs. = path.obs,
col = cbPalette,
ablCol = 'darkgrey',
colDif = 'firebrick',
HCU. = HCU,
dataCategory. = dataCategory,
multiplot.cex = 1.4,
multiplot.lab = 1.4,
cex.main = 1.2,
...){
# Extract sliderTime. from feederList
if (!is.null(feederList.)){
sliderTime. <- feederList.$slider_time
}else{
sliderTime. <- NULL
}
# Create plot
if (default.){
if (is.null(sliderTime.)){
drange <- NULL
}else{
#drange <- lubridate::decimal_date(as.Date(sliderTime.))
drange <- as.Date(ISOdate(year = sliderTime.,
month = c(1,12),
day = c(1,31)))
}
layout(mat = matrix(data = c(1,2,3,4),
nrow = 4,
ncol = 1,
byrow = T),
widths = 1,
heights = c(2, 1, 0.5, 0.75))
par(mar = c(0,0,0,0), oma = c(3,6,3,3))
#-- ET direct data plot
plot(x = 1,
type = 'n',
main = '',
xaxs = "i",
ylab = '(mm)',
xlim = drange,
xlab = '',
xaxt = 'n',
cex.axis = multiplot.cex,
cex.lab = multiplot.lab)
mtext(text = paste('HUC'),
line = 1,
font = 2,
cex = cex.main)
mtext(text = paste0(' ','\n(mm)'),
side = 2,
line = 3)
#-- Difference plot
plot(x = 1,
type = 'n',
main = '',
xaxs = "i",
ylab = 'Diff (mm)',
xlab = '',
xlim = drange,
xaxt = 'n',
yaxt = 'n',
cex.lab = multiplot.lab)
axis(side = 4,
cex.axis = multiplot.cex)
mtext(text = 'Diff\n(mm)',
side = 2,
line = 3)
#-- sd plot
plot(x = 1,
type = 'n',
main = '',
xaxs = "i",
ylab = 'Standard\nDev',
xlab = 'Time',
xlim = drange,
cex.axis = multiplot.cex,
cex.lab = multiplot.lab)
mtext(text = 'Standard\nDev',
side = 2,
line = 3)
#-- legend
frame()
}else{
if (is.null(sliderTime.)){
drange <- NULL
}else{
drange <- as.Date(sliderTime.)
}
layout(mat = matrix(data = c(1,2,3,4),
nrow = 4,
ncol = 1,
byrow = T),
widths = 1,
heights = c(2, 1, 0.5, 0.75))
par(mar = c(0,0,0,0), oma = c(3,6,3,3))
#------ ET direct data plot
# start plot with first dataset
if (!is.null(drange)){
y <- x[((as.Date(zoo::index(x)) >= as.Date(drange[1])) & (as.Date(zoo::index(x)) <= as.Date(drange[2]))),]
if (is.null(dim(y))) {
x <- zoo::as.zoo(as.data.frame(y))
zoo::index(x) <- as.Date(zoo::index(y))
}else{
x <- y
}
}
# Set background color
if (!is.null(ptSP.)){
if (feederList.$showObs_InvEnvColors){
man.bg <- 'lightgrey'
man.abl <- 'white'
man.minmax <- 'white'
man.2575 <- 'darkgrey'
}else{
man.bg <- 'white'
man.abl <- ablCol
man.minmax <- 'lightgrey'
man.2575 <- 'darkgrey'
}
}else{
man.bg <- 'white'
man.abl <- ablCol
man.minmax <- 'lightgrey'
man.2575 <- 'darkgrey'
}
if ((!is.null(ptSP.))){
if (!is.null(iv)){
if (feederList.$showObs_quantEnv){
ylimRange <- range(c(min(iv$envInput$y25, na.rm = T), max(iv$envInput$y75, na.rm = T),
range(range(x, na.rm = T))),
na.rm = T)
}
if (feederList.$showObs_minmaxEnv){
ylimRange <- range(c(min(iv$envInput$yMin, na.rm = T), max(iv$envInput$yMax, na.rm = T),
range(range(x, na.rm = T))),
na.rm = T)
}
}else{
ylimRange <- range(range(x, na.rm = T))
}
}else{
ylimRange <- range(range(x, na.rm = T))
}
plot(x = x[,1],
col = col[1],
main = '',
xaxs = "i",
ylab = paste0(dataCategory.,'\n(mm)'),
#xlim = drange,
type = 'n',
ylim = ylimRange,
xlab = '',
xaxt = 'n',
cex.axis = multiplot.cex,
cex.lab = multiplot.lab,
cex.main = cex.main,
lwd = 2,
yaxs = 'i')
rect(par("usr")[1],par("usr")[3],par("usr")[2],par("usr")[4],col = man.bg)
# Calc and include obs data as necessary
if (!is.null(ptSP.)){
# if (feederList.$showObs_minmaxEnv || feederList.$showObs_quantEnv || feederList.$showObs){
# iv <- METsteps::zooEnvParameters(zoo.fnames = paste0(path.obs., ptSP.@data$OurID, '.csv'),
# timeStep2 = timeStep.)
# }else{
# iv <- NULL
# }
if (feederList.$showObs_minmaxEnv & !is.null(iv)){
envelope(xall = iv$envInput$xMinMax,
y1 = iv$envInput$yMax,
y2 = iv$envInput$yMin,
col = man.minmax,
border = man.minmax)
}
if (feederList.$showObs_quantEnv & !is.null(iv)){
envelope(xall = iv$envInput$x2575,
y1 = iv$envInput$y75,
y2 = iv$envInput$y25,
col = man.2575,
border = man.2575)
}
if (feederList.$showObs & !is.null(iv)){
lines(iv$envZoo$envMean, lty=2)
}
}else{
iv <- NULL
}
lines(x = x[,1],
col = col[1],
lwd = 2)
mtext(text = paste('HUC', HCU.),
line = 1,
font = 2,
cex = cex.main)
mtext(text = paste0(dataCategory.,'\n(mm)'),
side = 2,
line = 3)
# add remaining datasets with line() function and calculate ensemble mean
if (ncol(x) > 1){
for (i in 2:ncol(x)){
lines(x = x[,i],
col = cbPalette[i],
xaxs = "i",
lwd = 2)
}
# Calculate ensemble means and add to plot
ensembleMeans <- zoo::zoo(rowMeans(x), stats::time(x))
points(x = ensembleMeans,
col = 'black',
xaxs = 'i',
lwd = 2,
pch = 16)
lines(x = ensembleMeans,
col = 'black',
xaxs = 'i',
lwd = 1,
lty = 1)
}
# abline(v = unique(as.integer(zoo::index(x))),
# col = ablCol,
# lty = 2)
yrs <- as.Date(ISOdate(year = unique(lubridate::year(index(x))),
month = 1,
day = 1))
abline(v = yrs,
col = man.abl,
lty = 2)
#------ Difference Plot
#par(mar = c(0, 6.2, 0, 2.1))
if (ncol(x) == 1){
plot(x = x,
type = 'n',
main = '',
xaxs = 'i',
ylab = 'Diff (mm)',
xlab = '',
xaxt = 'n',
yaxt = 'n',
#xlim = drange,
cex.axis = multiplot.cex,
cex.lab = multiplot.lab)
axis(side = 4,
cex.axis = multiplot.cex)
yrs <- as.Date(ISOdate(year = unique(lubridate::year(index(x))),
month = 1,
day = 1))
abline(v = yrs,
col = ablCol,
lty = 2)
# abline(v = unique(lubridate::year(zoo::index(x))),
# col = ablCol,
# lty = 2)
abline(h = 0,
col = ablCol,
lty = 1)
mtext(text = 'Diff\n(mm)',
side = 2,
line = 3)
}
if (ncol(x) == 2){
plot(x = x[,2] - x[,1],
col = colDif,
main = '',
xaxs = "i",
ylab = 'Diff (mm)',
xlab = '',
xaxt = 'n',
yaxt = 'n',
#xlim = drange,
cex.axis = multiplot.cex,
cex.lab = multiplot.lab,
lwd = 2)
axis(side = 4,
cex.axis = multiplot.cex)
# abline(v = unique(as.integer(zoo::index(x))),
# col = ablCol,
# lty = 2)
yrs <- as.Date(ISOdate(year = unique(lubridate::year(index(x))),
month = 1,
day = 1))
abline(v = yrs,
col = ablCol,
lty = 2)
abline(h = 0,
col = ablCol,
lty = 1)
mtext(text = 'Diff\n(mm)',
side = 2,
line = 3)
}
if (ncol(x) > 2){
combinations <- t(combn(x = ncol(x),
m = 2))
combFUNdif <- function(combrow, x){
x[, combrow[2]] - x[, combrow[1]]
}
difmat <- zoo::as.zoo(apply(X = combinations,
MARGIN = 1,
FUN = combFUNdif,
x = x))
zoo::index(difmat) <- zoo::index(x)
plot(x = difmat[,1],
col = colDif,
main = '',
xaxs = "i",
ylab = 'Diff (mm)',
xlab = '',
#xlim = drange,
xaxt = 'n',
yaxt = 'n',
cex.axis = multiplot.cex,
cex.lab = multiplot.lab,
lwd = 2,
ylim = c(min(difmat, na.rm = T),
max(difmat, na.rm = T)))
axis(side = 4,
cex.axis = multiplot.cex)
for (i in 2:ncol(difmat)){
lines(x = difmat[,i],
xaxs = 'i',
col = colDif,
lwd = 2,
lty = i)
}
# abline(v = unique(as.integer(index(x))),
# col = ablCol,
# lty = 2)
yrs <- as.Date(ISOdate(year = unique(lubridate::year(index(x))),
month = 1,
day = 1))
abline(v = yrs,
col = ablCol,
lty = 2)
abline(h = 0,
col = ablCol,
lty = 1)
mtext(text = 'Diff\n(mm)',
side = 2,
line = 3)
}
#------ sd Plot
if (ncol(x) > 1){
#Calculate standard deviation
sdZoo <- apply(X = x,
MARGIN = 1,
FUN = sd,
na.rm = T)
sdZoo <- zoo::zoo(sdZoo)
zoo::index(sdZoo) <- zoo::index(x)
plot(x = sdZoo,
type = 'l',
main = '',
xaxs = "i",
ylab = 'Standard\nDev',
xlab = 'Time',
#xlim = drange,
cex.axis = multiplot.cex,
cex.lab = multiplot.lab)
# abline(v = unique(as.integer(index(x))),
# col = ablCol,
# lty = 2)
yrs <- as.Date(ISOdate(year = unique(lubridate::year(index(x))),
month = 1,
day = 1))
abline(v = yrs,
col = ablCol,
lty = 2)
abline(h = 0,
col = ablCol,
lty = 1)
mtext(text = 'Standard\nDev',
side = 2,
line = 3)
}else{
plot(x = x,
type = 'n',
main = '',
xaxs = "i",
ylab = 'Standard\nDev',
xlab = 'Time',
#xlim = drange,
cex.axis = multiplot.cex,
cex.lab = multiplot.lab)
# abline(v = unique(as.integer(index(x))),
# col = ablCol,
# lty = 2)
yrs <- as.Date(ISOdate(year = unique(lubridate::year(index(x))),
month = 1,
day = 1))
abline(v = yrs,
col = ablCol,
lty = 2)
abline(h = 0,
col = ablCol,
lty = 1)
mtext(text = 'Standard\nDev',
side = 2,
line = 3)
}
#------ legend
plot(1, type = 'n', bty = 'n', xaxt = 'n', yaxt = 'n', xlim = c(0,1), ylim = c(0,1))
# add legend
if (feederList.$showObs & !is.null(iv)){
if (ncol(x) > 1){
legend(x = 'bottom',
legend = c(dnames, 'Ens. Mean', 'Mean Obs'),
pch = c(rep(15, length(dnames)), 15, NA),
lty = c(rep(NA, length(dnames)), NA, 2),
col = c(cbPalette[1:ncol(x)], 'black', 'black'),
pt.cex = 2,
cex = 1.2,
horiz = F,
bty = 'n',
ncol = floor(length(c(dnames, 'Ens. Mean', 'Mean Obs'))/2),
x.intersp = 1,
y.intersp = 1,
inset = 0
)
}else{
legend(x = 'bottom',
legend = c(dnames, 'Mean Obs'),
pch = c(rep(15, length(dnames)), NA),
lty = c(rep(NA, length(dnames)), 2),
col = c(cbPalette[1:ncol(x)], 'black'),
pt.cex = 2,
cex = 1.2,
horiz = T,
bty = 'n',
ncol = floor(length(c(dnames, 'Mean Obs'))/2),
x.intersp = 1,
y.intersp = 1,
inset = 0
)
}
}else{
if (ncol(x) > 1){
legend(x = 'bottom',
legend = c(dnames, 'Ens. Mean'),
pch = 15,
col = c(cbPalette[1:ncol(x)], 'black'),
pt.cex = 2,
cex = 1.2,
horiz = T,
bty = 'n',
ncol = floor(length(c(dnames, 'Ens. Mean'))/2),
x.intersp = 1,
y.intersp = 1,
inset = 0
)
}else{
legend(x = 'bottom',
legend = dnames,
pch = 15,
col = cbPalette[1:ncol(x)],
pt.cex = 2,
cex = 1.2,
horiz = T,
bty = 'n',
ncol = floor(length(c(dnames))/2),
x.intersp = 1,
y.intersp = 1,
inset = 0
)
}
}
}
}
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.