#' @title Plot annual time series
#'
#' @author Chantelle Layton
#'
#' @description Creates a time-series of annual time series in the format that is used
#' for
#'
#' @param x a vector indicating the times of observations
#' @param y a vector indicating the observations
#' @param ysc a vector indicating observations used for scorecard, ignored if `plotScorecard = FALSE`
#' @param xlim Optional limit for x axis
#' @param ylim Optional limit for y axis
#' @param xlab Logical indicating whether to label the x axis
#' @param ylabel Logical indicating whether to label the y axis
#' @param yaxs Logical indicating whether to have a labelled y-axis
#' @param plotSd Logical indicating whether to add +/- 0.5 standard deviation lines on plot of
#' the annual anomaly over the defined climatology period.
#' @param climatologyYears Vector of length two indicating the climatology years, ignored if
#' `plotSd = FALSE`.
#' @param plotPoints Logical indicating whether or not to plot points on top of line
#' @param plotRunningAvg Logical indicating whether or not to plot a 5 year running average
#' @param plotLmTrend Logical indicating whether or not to print out results of a linear regression
#' on the plot
#' @param lmResults A `lm` format object, if `plotLmTrend = FALSE`, ignored.
#' @param plotClimatologyMean Logical indicating whether or not to print out the climatology mean.
#' @param climatologyMean A numeric value, if `plotClimatologyMean = FALSE`, ignored.
#' @param plotScorecard Logical indicating whether or not to plot scorecard on side = 1.
#' @param scorecardLines Logical indicating whether or not to put vertical lines on scorecard.
#' @param scorecardLabels Logical indicating whether or not to print `ysc` values in scorecard.
#' @param scorecardSeparation Value used to denote the separation between the main plot and scorecard.
#' Suggested to use `par('cin')[2]` (default) and play with that value. If closer is desired, decrease.
#' @param scorecardWidth Value used to denote the width of the scorecard. Suggested to use
#' `par('cin')[2]` (default) and play with that value. If wider is desired, increase.
#'
#' @details The current format of the figure is for the 2019 research document. Any changes in the future
#' will be reflected in the code with comments, and here.
#'
#' \itemize{
#' \item{2019 - Annual anomalies are plotted with a grey line and a 5-year running mean plotted over top in black.
#' Thick dashed horizonal lines of the standard deviation of the annual climatology are added. Code has
#' been written to ensure that at least one century is labelled.}
#' }
#'
#' @importFrom stats lm
#' @importFrom stats sd
#' @importFrom stats coef
#' @importFrom graphics plot
#' @importFrom graphics abline
#' @importFrom graphics axis
#' @importFrom graphics lines
#' @importFrom graphics mtext
#' @importFrom graphics points
#' @importFrom graphics legend
#'
#' @export
#'
<- (x, y, ysc, , , xlab = , climatologyYears, ylabel = ,
plotSd = , yaxs = , plotPoints = , plotRunningAvg = ,
plotLmTrend = , lmResults,
plotClimatologyMean = , climatologyMean,
plotScorecard = , scorecardLines = , scorecardLabels = ,
scorecardSeparation = ('cin')[2], scorecardWidth = ('cin')[2]){
("anomalyColors")
okbreaks <- $breaks <= 3.5
okcol <- $breaks < 3.5
'breaks']] <- 'breaks']][okbreaks]
'colors']] <- 'colors']][okcol]
# need to extend the top half, keep adding dark red
addBreaks <- (4.0, 5.5, 0.5)
'breaks']] <- ('breaks']], addBreaks)
'colors']] <- ('colors']], ('colors']][length('colors']])], (addBreaks)))
# need to extend the bottom half, just keep adding the dark blue
addBreaks <- (-5.5, -4.0, 0.5)
'breaks']] <- (addBreaks, 'breaks']])
'colors']] <- (('colors']][1], (addBreaks)), 'colors']])
<- (x) x %% 2 == 0
# ylabel
L <- '['
R <- ']'
ylab <- (item = 'temperatureAnomaly', sep = "")
# xlim
# set it if not given
xlimGiven <- !()
(!xlimGiven){
<- (x, na.rm = )
}
# ylim
# set it if not given
ylimGiven <- !()
(!ylimGiven){
<- (y, na.rm = )
}
(plotScorecard){
<- + (-0.5, 1.0) # to make the beginning and end nice
# plot bottom scorecard first, some code taken from drawPalette()
# set up margins
omai <- ("mai")
mai <- (0, 4)
# arguments for paletteCalculations
# scorecardSeparation
# set it if not given
separationGiven <- !(scorecardSeparation)
(!separationGiven){
scorecardSeparation <- ('cin')[2]
}
widthGiven <- !(scorecardWidth)
(!separationGiven){
scorecardWidth <- ('cin')[2]
}
pos <- 1
<- 3
zlab <- ""
pc <- (separation = scorecardSeparation, = scorecardWidth,
maidiff=mai, pos=pos,
zlab=zlab, =-1)
# plot
z <- ( = ysc, = (x), = 1)
zy <- 1
# plot it
barxlim <- #+ c(-1, 1)
(mai = (pc$mai1 > 0, pc$mai1, 0))
(x = x, y = zy, z = z,
= barxlim,
axes = , xlab="", ylab="",
= 'colors']],
breaks = 'breaks']])
(("usr")[1],("usr")[3],("usr")[2],("usr")[4], = "lightgray")
(x = x, y = zy, z = z,
= barxlim,
axes = , xlab="", ylab="",
= 'colors']],
breaks = 'breaks']],
add = )
()
## add vertical lines to separate years
(scorecardLines) {(x, (k) (x = (k, 2) + 0.5, y = (0, 1) + 0.5))}
# axis and labels
## annual
(scorecardLabels) {
textcol <- ('black', (ysc))
whitetext <- ysc <= -3.0 | (ysc >= 3.0 & ysc < 3.5)
whitetext[is.na(whitetext)] <-
annualtextat <- x
((!whitetext)) (x = annualtextat!whitetext == & !(ysc)], y = 1, = ('%.1f', ysc!whitetext == & !(ysc)]), = 'black', cex = 0.8, srt = 90)
((whitetext)) (x = annualtextat[whitetext == ], y = 1, = ('%.1f', ysc[whitetext == & !(ysc)]), = 'white', cex = 0.8, srt = 90)
}
# x-axis, x-axis labels
((()) > 10){
xat <- (([1], digits = -1), ([2], digits = -1), 10) # tick every decade
centuries <- (1800, 1900, 2000)
okcentury <- centuries %in% xat
centuryIdx <- ((centuries[okcentury], (k) (k == xat)))
# if centuryIdx[1] is even, start xlabel idx at 2, if odd, at 1
xlabels <- (((centuryIdx[1]), 2, 1), (xat), 2) # label every second decade, make sure centuries are labelled
(side = 1, at = xat, = )
(xlab){
#axis(side = 1, at = xat[xlabels], labels = xat[xlabels])
(side = 1, at = xat, = xat) # try this for now
}
} {
xat <- ()
(xlab){
(side = 1, at = xat)
} {
(side = 1, at = xat, = )
}
}
# reset mai, prep for primary plot
(=, mai=pc$mai2)
(mar = ('mar') * (0, 1, 1, 1) + (4.5, 0, 0, 0)) # have to change first term of second addition if changes made to colorbar height
}
(x = x,
y = y, = 'white',
lwd = 0.6,
= 'n',
xaxs = (plotScorecard, 'i', 'r'),
= , = ,
xaxt = 'n', yaxt = 'n',
xlab = '', ylab = '')
#...)
# x-axis, x-axis labels
(!plotScorecard) {
((()) > 10){
xat <- (([1], digits = -1), ([2], digits = -1), 10) # tick every decade
centuries <- (1800, 1900, 2000)
okcentury <- centuries %in% xat
centuryIdx <- ((centuries[okcentury], (k) (k == xat)))
# if centuryIdx[1] is even, start xlabel idx at 2, if odd, at 1
xlabels <- (((centuryIdx[1]), 2, 1), (xat), 2) # label every second decade, make sure centuries are labelled
(side = 1, at = xat, = )
(xlab){
#axis(side = 1, at = xat[xlabels], labels = xat[xlabels])
(side = 1, at = xat, = xat) # try this for now
}
} {
xat <- ()
(xlab){
(side = 1, at = xat)
} {
(side = 1, at = xat, = )
}
}
}
# y-axis, y-axis labels, y-axis label
(yaxs){
{(() < 20){ # kind of bad logic
yat <- (([1], digits = 0), ([2], digits = 0), 1) # label every one
} {
yat <- ()
}
}
(side = 2, at = yat, = yat)
}
(ylabel) ( = ylab, side = 2, = 2, cex = 4/5)
# grid
# ugh, function grid() not working when nx and ny given
(v = xat, = 'lightgray', lty = 'dotted')
(yaxs) (h = yat, = 'lightgray', lty = 'dotted')
# replot initial lines so its over the grid
(plotPoints){
(x = x, y = y, = 'black')
(x = x, y = y, = 21, = 'black', bg = 'white')
} {
(x = x, y = y, = 'black', lty = 2)
}
# add additional stuff to plot
# climatology standard deviation
(plotSd){
okclim <- x >= climatologyYears[1] & x <= climatologyYears[2]
aasd <- (y[okclim], na.rm = )
#{if(diff(ylim) > 20) { # commented out this if else statement 20200402
cmean <- (y[okclim], na.rm = )
(h = cmean, lty = 1, lwd = 2)
(h = (aasd/2) + cmean, lty = 2, lwd = 2)
(h = (-aasd/2) + cmean, lty = 2, lwd = 2)
#} else {
# abline(h = 0)
# abline(h = aasd/2, lty = 2, lwd = 2)
# abline(h = -aasd/2, lty = 2, lwd = 2)
#}
#}
}
# replot initial lines so its over the grid and sd lines
(plotPoints){
(x = x, y = y, = 'black')
(x = x, y = y, = 21, = 'black', bg = 'white')
} {
(x = x, y = y, = 'black', lty = 2)
}
# 5 year running mean filter
(plotRunningAvg){
aafilt <- ::(y, (0.2, 5), method = 'convolution', sides = 2)
(x = x, y = aafilt, lwd = 2)
}
(plotLmTrend){
slope <- ('%.1f', (((lmResults)[2]) * 100, 1))
slope <- (('LANG') == 'fr', ('\\.', ',', slope), slope) # comma instead of period for french
<- (degree * 'C')
yearlab <- ('years', domain = 'R-csasAtlPhys')
legendText <- (.(slope) * .(unit) * ' / 100 ' * .(yearlab))
('bottomright', = legendText, bty = 'n', cex = 1.2)
}
(plotClimatologyMean){
<- (degree * 'C')
meanlab <- ('Mean', domain = 'R-csasAtlPhys')
climMean <- ('%.2f', climatologyMean)
('bottomleft', = (.(meanlab)*' = ' * .(climMean) * .(unit)), bty = 'n')
}
}
#' @title Plot monthly time series
#'
#' @author Chantelle Layton
#'
#' @description Creates a time-series plot of annual temperature anomaly in the style required for
#' AZMP reporting.
#'
#' @param x a vector indicating the times of observations
#' @param y a vector indicating the observations
#' @param xlim Optional limit for x axis
#' @param ylim Optional limit for y axis
#' @param xlab Logical indicating whether to label the x axis
#' @param climatologyYears Vector of length two indicating the climatology years
#' @param ylabel Logical indicating whether to label the y axis
#' @param plotSd Logical indicating whether to add +/- 0.5 standard deviation lines on plot of
#' the annual anomaly over the defined climatology period.
#' @param yaxs Logical indicating whether to have a labelled y-axis
#' @param plotPoints Logical indicating whether or not to plot data as points, or as lines with lty = 2.
#'
#' @details The current format of the figure is for a specific user. It is similar in nature to
#' plotAnnualAnomaly, but is behind in development as it is not frequently used.
#'
#' @importFrom stats sd
#' @importFrom graphics axis.POSIXct
#' @importFrom graphics plot
#' @importFrom graphics abline
#' @importFrom graphics axis
#' @importFrom graphics lines
#' @importFrom graphics mtext
#' @importFrom graphics points
#' @importFrom graphics legend
#'
#' @export
<- (x, y, , , xlab = , climatologyYears, ylabel = ,
plotSd = , yaxs = , plotPoints = ){
<- (x) x %% 2 == 0
# ylabel
L <- '['
R <- ']'
ylab <- ('Temperature Anomaly ' * .(L) * degree * "C" * .(R))
# xlim
# set it if not given
xlimGiven <- !()
(!xlimGiven){
<- (((x)), na.rm = )
}
# ylim
# set it if not given
ylimGiven <- !()
(!ylimGiven){
<- (x, na.rm = )
}
(x = x,
y = y, = 'white',
lwd = 0.6,
= 'n',
= ((, (01, 12), (01, 31), sep = '/'), tz = 'UTC'),
= ,
xaxt = 'n', yaxt = 'n',
xlab = '', ylab = '')
#...)
# x-axis, x-axis labels
xat <- (([1], digits = -1), ([2], digits = -1), 10) # tick every decade
centuries <- (1800, 1900, 2000)
okcentury <- centuries %in% xat
centuryIdx <- ((centuries[okcentury], (k) (k == xat)))
# if centuryIdx[1] is even, start xlabel idx at 2, if odd, at 1
xlabels <- (((centuryIdx[1]), 2, 1), (xat), 2) # label every second decade, make sure centuries are labelled
(side = 1, at = ((xat, '01', '01', sep = '/'), tz = 'UTC'), = )
(xlab){
(side = 1,
at = ((xat[xlabels], '01', '01', sep = '/'), tz = 'UTC'),
= ,
= '%Y')
}
# y-axis, y-axis labels, y-axis label
(yaxs){
{(() < 20){ # kind of bad logic
yat <- (([1], digits = 0), ([2], digits = 0), 1) # label every one
} {
yat <- ()
}
}
(side = 2, at = yat, = yat)
}
(ylabel) ( = ylab, side = 2, = 2, cex = 4/5)
# grid
# ugh, function grid() not working when nx and ny given
(v = ((xat, '01', '01', sep = '/'), tz = 'UTC'), = 'lightgray', lty = 'dotted')
(yaxs) (h = yat, = 'lightgray', lty = 'dotted')
# replot initial lines so its over the grid
(plotPoints){
(x = x, y = y, = 'black')
(x = x, y = y, = 21, = 'black', bg = 'white')
} {
(x = x, y = y, = 'black', lty = 2)
}
# add additional stuff to plot
# climatology standard deviation
(plotSd){
okclim <- ((x)) >= climatologyYears[1] & ((x)) <= climatologyYears[2]
aasd <- (x[okclim], na.rm = )
{(() > 20) {
cmean <- (x[okclim], na.rm = )
(h = cmean, lty = 1, lwd = 2)
(h = (aasd/2) + cmean, lty = 2, lwd = 2)
(h = (-aasd/2) + cmean, lty = 2, lwd = 2)
} {
(h = 0)
(h = aasd/2, lty = 2, lwd = 2)
(h = -aasd/2, lty = 2, lwd = 2)
}
}
}
}
#' @title Plot monthly bar plots
#'
#' @description This plotting method for air temperature data plots bar plots
#' for monthly anomalies and is colour coded based on normalized monthly
#' anomalies
#'
#' @param df a data.frame containing at least year, month, anomaly, and normalizedAnomaly.
#' @param ylim a vector of length 2 indicating the range for the y-axis
#' @param years vector of length two indicating the range of years for climatology
#' @param plotYear a vector indicating which years to plot. Can be a vector of length one, indicating
#' to plot only one year, or of length two, indicating a range of years to plot
#' @param yearLabel logical expression indicating whether or not to label the plotYears
#' @param yearLabelSide which side the yearLabel should be placed, (1 = bottom, 3 = top)
#' @param drawPalette logical expression indicating whether or not to draw a palette
#' @param xaxt logical expression indicating whether or not to label x-axis
#' @param ylabel logical exptression indicating whether or not to label y-axis labels
#' @param mar vector of length 4 indicating the margins of the plot
#'
#' @author Chantelle Layton
#'
#' @importFrom graphics barplot
#' @importFrom graphics box
#' @importFrom graphics par
#' @importFrom grDevices rgb
#' @importFrom oce colormap
#' @importFrom oce drawPalette
#'
#' @export
<- (, , years, plotYear, yearLabel = , yearLabelSide, drawPalette = , xaxt = , ylabel = , mar){
<- (x) x %% 2 == 0
# ylabel
L <- '['
R <- ']'
ylab <- ('temperatureAnomaly')
# The blue-red colormap with ranges -3.5 to +3.5 standard deviations
rgbcol <- ((157,0,0),(230,0,0),(255,51,51),(255,102,102),(255,151,151),(255,202,202),(255,255,255),
(255,255,255),(202,202,255),(151,151,255),(102,102,255),(51,51,255),(0,0,230),(0,0,157))
rgbcol <- (rgbcol, =(rgbcol)/3, =3, byrow=)
rgbcol <- rgbcol[seq((rgbcol),1,-1),]
# Make the RGB colors, but don't make a colorRamp
anomalyCols <- (red=rgbcol,1], green=rgbcol,2], blue=rgbcol,3], maxColorValue = 255)
anomalyBreaks <- (-3.5, 3.5, 0.5)
# ylim
# set it if not given
ylimGiven <- !()
(!ylimGiven){
<- ('anomaly']], na.rm = )
}
# subset the data based on plotYear
dfs <- [df'year']] %in% plotYear, ]
# add any missing months
expectedYearMonth <- ('rbind',(plotYear, (k) (year = (k, 12), month = (1:12))))
expectedData <- dfs[nrow(dfs) + 1:(expectedYearMonth), !(dfs) %in% ('year', 'month')]
expectedDf <- (expectedYearMonth, expectedData)
okaddexpected <- !((year,month) month %in% dfs'month']][dfs'year']] == year],
expectedDf'year']],
expectedDf'month']])
dfu <- (dfs, expectedDf[okaddexpected, ])
# create colour map based on normalized values
<- colormap(z = dfu'normalizedAnomaly']], breaks = anomalyBreaks, = anomalyCols)
# now plot
(drawPalette){
drawPalette(colormap = , zlab = ' ', cex = 1)
}
marGiven <- !(mar)
(!marGiven){
mar <- (3.5, 3.5, 1, 1)
}
(mar=mar)
(dfu'anomaly']], = $zcol,
= , = (0, (dfu'anomaly']])),
axisnames = , axes = ,
space = 0, = 0, = 1, # to tighten up bars
xaxs = 'i')
# axes
# x-axis
# label every third month
monthTick <- 1:(dfu)
monthAt <- (1, (dfu), 2)
monthLabels <- ([dfu'month']]], 1, 1)[monthAt]
{(xaxt){ # if xaxt is not given
(1, at = monthTick - 0.5, = ) # subtract 0.5 from monthAt to be center of bar
( = monthLabels, side = 1, = 0.5, at = monthAt - 0.5, cex = 3/5)
} {
(1, at = monthTick - 0.5, = )
}}
(yearLabel){
((plotYear) == 1){
( = plotYear, side = yearLabelSide, = 1)
} {
yrs <- plotYear[1]:plotYear[2]
( = '|', side = yearLabelSide, at = 12 * ((1, (yrs)-1,1)), cex = 3/5, = 1.5)
( = yrs, side = yearLabelSide, at = 6 + 12 * (0, (yrs) - 1, 1), cex = 3/5, = 1.5)
#mtext(text = plotYear[2], side = yearLabelSide, at = 18, cex = 4/5)
}
}
(v = monthAt- 0.5, = 'lightgrey', lty = 2)
((plotYear) == 2) {
yrs <- plotYear[1]:plotYear[2]
(v = 12 * ((1, (yrs)-1,1)))
}
#axis(3, at = monthAt - 0.5, labels = FALSE)
# y - axis
# regardless of ylim, label every second value
yat <- ([1], [2], 2)
ylabels <- yat
(2, at = yat, = ylabels)
(h = yat, = 'lightgrey', lty = 2)
(ylabel){( = ylab, side = 2, = 2, cex = 4/5)}
# make it pretty
(h = 0)
()
(dfu'anomaly']], = $zcol,
= , = (0, (dfu'anomaly']])),
axisnames = , axes = ,
space = 0, = 0, = 1, # to tighten up bars
add = )
(drawPalette) (side = 4, = ('normalizedAnomaly'), = 4, cex = 4/5)
}
#' @title Plot annual stacked bar plot
#'
#' @description This function will plot a stacked bar plot that has negative and
#' positive values. It also has the option to plot the average of values provided.
#'
#' @param x a vector indicating what the columns represent for \code{z}
#' @param y a vector indicating what the rows represent for \code{z}
#' @param z a matrix with the columns being the x-axis and the rows being items
#' that wish to be stacked.
#' @param zsc a vector of normalized values of z for the scorecard, ignored if `plotScorecard = FALSE`
#' @param plotAverage a logical value indicating whether or not to add the average value
#' from matrix z.
#' @param ylab1 name for the y-axis on side 2, default is \code{NULL}
#' @param ylab2 name for the y-axis on side 4 if \code{plotAverage = TRUE}, ignored otherwise, default is
#' \code{NULL}.
#' @param xlabels Logical indicating if the x-axis ticks should be annotated.
#' @param ylim1 limits for the y-axis on side 2, if not supplied, it will be inferred from \code{z}
#' @param ylim2 limits for the y-axis on side 4 if \code{plotAverage = TRUE}, ignored otherwise. If not
#' supplied, it will be inferred from the data.
#' @param ncol supplied to legend, the number of columns in which to set the legend items, default is 1.
#' @param hclpalette Name of an `hcl.colors` palette. Names can be found by doing `hcl.pals()`, default is
#' a sequential palette, 'Viridis'.
#' @param legendLocation Character string, valid choices are `inside` or `outside`. Indicating if the
#' legend should be place `inside` the plot window (default), or `outside` of the plot window on the right
#' hand side.
#' @param legendInset Vector of two values to control placement of legend, see `?legend` for details, when
#' `legendLocation = 'outside'`.
#' @param plotScorecard Logical indicating whether or not to plot scorecard on side = 1.
#' @param scorecardLines Logical indicating whether or not to put vertical lines on scorecard.
#' @param scorecardLabels Logical indicating whether or not to print `ysc` values in scorecard.
#' @param scorecardSeparation Value used to denote the separation between the main plot and scorecard.
#' Suggested to use `par('cin')[2]` (default) and play with that value. If closer is desired, decrease.
#' @param scorecardWidth Value used to denote the width of the scorecard. Suggested to use
#' `par('cin')[2]` (default) and play with that value. If wider is desired, increase.
#'
#' @author Chantelle Layton
#'
#' @importFrom graphics legend
#'
#' @export
#'
<- (x, y, z, zsc, plotAverage = , ylab1 = , ylab2 = ,
xaxtlabels = ,
ylim1, ylim2, = 1, hclpalette = 'Viridis', legendLocation = 'inside',
legendInset = (-0.38, 0),
plotScorecard = , scorecardLines = , scorecardLabels = ,
scorecardSeparation = ('cin')[2], scorecardWidth = ('cin')[2]){
mround <- (x, ) { * (x/)}
<- (x) x %% 2 == 0
# check to see if ylim1 is given
((ylim1)){
ylim1 <- ((z, 2, , na.rm = ), na.rm = )
}
# test barplot to get x values for scorecard so they line up
# first do the positive values
bpset <- (z, = ylim1, = , xaxt = 'n',
#legend = y, args.legend = list(x = 'topleft', bty = 'n'),
xaxs = 'i',
border = ,
cex.axis = cexaxis, = )
# x-axis at and labels
# need to do some fudging when close to decade ending
stackedx <- (x, x[length(x)] + 1)
<- mround((stackedx),5)
(() > 50){
xat <- (([1], digits = -1), ([2], digits = -1), 10) # tick every decade
centuries <- (1800, 1900, 2000)
okcentury <- centuries %in% xat
centuryIdx <- ((centuries[okcentury], (k) (k == xat)))
# if centuryIdx[1] is even, start xlabel idx at 2, if odd, at 1
xlabels <- (((centuryIdx[1]), 2, 1), (xat), 2) # label every second decade, make sure centuries are labelled
okIdxLab <- ((xat[xlabels], (k) (k == stackedx)))
okIdxAt <- ((xat, (k) (k == stackedx)))
} {
xat <- ()
okIdxAt <- okIdxLab <- ((xat, (k) (k == stackedx)))
}
(plotScorecard){
ysc <- zsc
("anomalyColors")
# need to extend the bottom half, just keep adding the dark blue
addBreaks <- (-5.5, -4.0, 0.5)
'breaks']] <- (addBreaks, 'breaks']])
'colors']] <- (('colors']][1], (addBreaks)), 'colors']])
<- (bpset) + (bpset)[1]/2 * (-1, 1)
# plot bottom scorecard first, some code taken from drawPalette()
# set up margins
omai <- ("mai")
mai <- (0, 4)
# arguments for paletteCalculations
# scorecardSeparation
# set it if not given
separationGiven <- !(scorecardSeparation)
(!separationGiven){
scorecardSeparation <- ('cin')[2]
}
widthGiven <- !(scorecardWidth)
(!separationGiven){
scorecardWidth <- ('cin')[2]
}
pos <- 1
<- 3
zlab <- ""
pc <- (separation = scorecardSeparation, = scorecardWidth,
maidiff=mai, pos=pos,
zlab=zlab, =-1)
# plot
zm <- ( = ysc, = (x), = 1)
zy <- 1
# plot it
barxlim <- #+ c(-1, 1)
(mai = (pc$mai1 > 0, pc$mai1, 0))
(x = bpset, y = zy, z = zm,
= barxlim,
axes = , xlab="", ylab="",
= 'colors']],
breaks = 'breaks']])
(("usr")[1],("usr")[3],("usr")[2],("usr")[4], = "lightgray")
(x = bpset, y = zy, z = zm,
= barxlim,
axes = , xlab="", ylab="",
= 'colors']],
breaks = 'breaks']],
add = )
()
## add vertical lines to separate years
bpsetdiff <- (bpset)[1]
(scorecardLines) {(bpset, (k) (x = (k, 2) + bpsetdiff/2, y = (0, 1) + 0.5))}
# axis and labels
## annual
(scorecardLabels) {
textcol <- ('black', (ysc))
whitetext <- ysc <= -3.0 | (ysc >= 3.0 & ysc < 3.5)
whitetext[is.na(whitetext)] <-
annualtextat <- bpset
((!whitetext)) (x = annualtextat!whitetext == & !(ysc)], y = 1, = ('%.1f', ysc!whitetext == & !(ysc)]), = 'black', cex = 0.8, srt = 90)
((whitetext)) (x = annualtextat[whitetext == ], y = 1, = ('%.1f', ysc[whitetext == & !(ysc)]), = 'white', cex = 0.8, srt = 90)
}
# x-axis, x-axis labels
(side = 1, at = bpset[okIdxAt], = )
(xaxtlabels) (side = 1, at = bpset[okIdxLab], = stackedx[okIdxLab])
# reset mai, prep for primary plot
(=, mai=pc$mai2)
(mar = ('mar') * (0, 1, 1, 1) + (4.5, 0, 0, 0)) # have to change first term of second addition if changes made to colorbar height
}
# get colors
<- (n = (z)[1], = hclpalette)
# have to split up the matrix into negative and positive
zPos <- z
zPos[zPos < 0] <- 0
zPos[is.na(zPos)] <- 0
zNeg <- z
zNeg[zNeg > 0] <- 0
zNeg[is.na(zNeg)] <- 0
cexaxis <- 0.8
bppos <- (zPos, = ylim1, = , xaxt = 'n',
#legend = y, args.legend = list(x = 'topleft', bty = 'n'),
xaxs = 'i',
border = ,
cex.axis = cexaxis)
# need to set up the nice xaxis labels using some information from the bar plot
# this will be used again below when actually labelling the x-axis, but some information
# is needed to do dotted guidelines
bp <- (bppos, bppos[length(bppos)] + ((bppos)))
# horizontal and vertical guidelines
hline <- (ylim1)
# positive will include zero
(h = hline[hline >= 0], lty = 'dotted', = 'lightgrey')
(v = bp[okIdxAt], lty = 'dotted', = 'lightgrey')
# negative values
bpneg <- (zNeg, = ylim1, = , xaxt = 'n',
border = , cex.axis = cexaxis, add = )
(h = hline[hline < 0], lty = 'dotted', = 'lightgrey')
(v = bp[okIdxAt], lty = 'dotted', = 'lightgrey')
# add neg bar plot again to get things on top of guidelines
bpneg <- (zNeg, = ylim1, = , xaxt = 'n',
border = , add = , cex.axis = cexaxis)
# add the bar plot back on top to get things on top of the guidelines
(legendLocation == 'inside'){
legendArgs <- (x = 'topleft', bty = 'n', = )
<- y
} {
legendArgs <-
<-
}
(zPos, = ylim1, = , xaxt = 'n',
= , args.legend = legendArgs,
border = , add = ,
cex.axis = cexaxis)
()
(!plotScorecard){
(side = 1, at = bpset[okIdxAt], = )
(xaxtlabels) {(side = 1, at = bpset[okIdxLab], = stackedx[okIdxLab])}
}
# add legend if legendLocation == 'outside'
(legendLocation == 'outside'){
(xpd=)
("topright", inset = legendInset, = y, = , = 15, box.col = 'white')
(xpd=)
}
(plotAverage){
( = )
mtanom <- (z, 2, , na.rm = )
# check if ylim2 given
((ylim2)){
ylim2 <- (mtanom, na.rm = )
}
usr <- ('usr')
xr <- (usr[2] - usr[1]) / 27
<- (usr[1] + xr, usr[2] - xr)
(bp[1:((bp)-1)], (mtanom), = 'l',
= ylim2 , = , lwd = 1,
axes = , bty = 'n', xlab = '', ylab = '')
(side = 4, cex.axis = cexaxis)
('topright', lty = 1, = 'black',
bty = 'n',
= ('average', domain = 'R-csasAtlPhys'))
()
}
(!(ylab1)) {(side = 2, = ylab1, = 2)}
(plotAverage & !(ylab2)) (side = 4, = ylab2, = 2)
}
#' @title Plot station locations
#'
#' @description Plots station locations at the top of plots using the points function
#'
#' @param distance a numerical vector indicating the distance
#' @param plabel a numerical vector indication the placement of the labels
#' @param distanceOffset a numerical value indicating the value to add and subtract from distace that will plot a line, default value is NULL
#' @param cex a numerical value indicating the magnification
#' @param pch a numerical value indicating the symbol
#' @param col a character string indicating the color
#'
#' @author Chantelle Layton
#'
#' @importFrom graphics par
#' @importFrom graphics points
#' @export
<- (distance, plabel, distanceOffset = , cex = 9/10, = 25, = 'black'){
(xpd = )
(distance, (plabel, (distance)), = , bg = , = , cex = cex)
(!(distanceOffset)){
(distance + (-distanceOffset, distanceOffset), (plabel, 2), lty = 1, = , cex = cex)
}
(xpd = )
}
#' @title Plot monthly timeseries with anomaly bar
#'
#' @description Creates a time series plot with the monthly anomaly and annual
#' anomaly scorecard below.
#'
#' @details This is the plot style that is used in many of Peter Galbraith's
#' research documents. Was translated to R in efforts to better represent
#' some data.
#'
#' @param xYear a numeric vector of the associated year
#' @param xMonth a numeric vector of the associated month
#' @param y a numeric vector of the associated year month value
#' @param yAnomaly a numeric vector of the associated anomaly year month value
#' @param yNormalizedAnomaly a numeric vector of the associated normalized anomaly with xYear and xMonth
#' @param xAnnualAnomaly a numeric vector of the year for the annual anomaly
#' @param yAnnualAnomaly a numeric vector of the annual anomaly
#' @param plotAnnual a logical value indicating if the annual anomaly should be shown in the scorecard bar, default is `TRUE`
#' @param xClimatology a numeric vector of the months for the monthly climatology
#' @param yClimatology a numeric vector of the climatology values for associated month
#' @param sdClimatology a numeric vector of the standard deviation for the associated month
#' @param xlim the x limits (x1, x2) of the plot
#' @param ylim the y limits (y1, y2) of the plot
#' @param anomalyColors a list that contains the colors and breaks of the desired color bar for the anomaly scorecard
#' @param scorecardSeparation Value used to denote the separation between the main plot and scorecard.
#' Suggested to use `par('cin')[2]` as a starting point and play with that value. If closer is desired, decrease.
#' @param scorecardWidth Value used to denote the width of the scorecard. Suggested to use
#' `par('cin')[2]` as a starting point and play with that value. If wider is desired, increase.
#'
#' @author Chantelle Layton
#'
#' @importFrom graphics image
#' @importFrom graphics polygon
#' @importFrom graphics text
#' @importFrom graphics rect
#'
#' @export
<- (xYear, xMonth, y, yAnomaly, yNormalizedAnomaly,
xAnnualAnomaly, yAnnualAnomaly, plotAnnual = ,
xClimatology, yClimatology, sdClimatology,
, , ,
scorecardSeparation=('cin')[2]/2 + 0.1 - 0.05 - 0.0125,
scorecardWidth=('cin')[2] + 0.2 - 0.05 - 0.0125){
# 1. set arguments if missing
(()){
<- (xMonth)
}
(()){
<- (y)
}
# 2. construct climatology polygon
uyear <- (xYear)
uyear <- (uyear, (uyear) + 1) # add the next year for boundary
x1 <- ((((uyear, , times = 12)) , 1:12, '15', sep = '-'), tz = 'UTC')
x2 <- (((((uyear), , times = 12)), 12:1, '15', sep = '-'), tz = 'UTC')
xpoly <- (x1, x2)
y1 <- (yClimatology - (sdClimatology/2), times = (uyear))
y2 <- ((yClimatology + (sdClimatology/2)), times = (uyear))
ypoly <- (y1, y2)
# for debugging polygon
# ok <- (as.POSIXlt(xpoly)$year + 1900) %in% c(max(uyear) - 2, max(uyear) - 1)
# xpolyb <- xpoly[ok]
# ypolyb <- ypoly[ok]
# plot bottom scorecard first, some code taken from drawPalette()
# set up margins
omai <- ("mai")
mai <- (0, 4)
# arguments for paletteCalculations
pos <- 1
<- 3
zlab <- ""
pc <- (separation = scorecardSeparation,
= scorecardWidth,
maidiff=mai, pos=pos, zlab=zlab, =-1)
# plot
<- ((xYear, xMonth, '15', sep = '-'), tz = 'UTC')
<- # this is x
# don't think I need colormap calls b/c image does it.
#cm <- colormap(z = yAnomaly, breaks = anomalyColors[['breaks']], col = anomalyColors[['colors']], missingColor = 'lightgray')
#col <- cm$zcol
uxYear <- (xYear)
zannual <-
(iy 1:(uxYear)){
lookyear <- uxYear[iy]
ok <- xYear == lookyear
nmon <- (xMonth[ok])
okannual <- xAnnualAnomaly == lookyear
aa <- yAnnualAnomaly[okannual]
((okannual)){
annualadd <- (yAnnualAnomaly[okannual], nmon)
} {
annualadd <- (, nmon)
}
zannual <- (zannual, annualadd)
}
#zannual <- unlist(lapply(yAnnualAnomaly, rep, 12))
(plotAnnual){
z <- ( = (), = 2)
z, 2] <- yAnomaly
#z[, 1] <- zannual[1:length(time)] # watch this
z, 1] <- zannual
zy <- (1,2)
} { # only monthly
z <- ( = (), = 1)
z,1] <- yAnomaly
zy <- 1
}
#col[is.na(col)] <- 'lightgray'
# plot it
(mai = (pc$mai1 > 0, pc$mai1, 0))
(x = , y = zy, z = z,
= ,
axes = , xlab="", ylab="",
= 'colors']],
breaks = 'breaks']])
(("usr")[1],("usr")[3],("usr")[2],("usr")[4], = "lightgray")
(x = , y = zy, z = z,
= ,
axes = , xlab="", ylab="",
= 'colors']],
breaks = 'breaks']],
add = )
()
# axis and labels
at <- ([1], [2], = 'month')
#abline(v = at)
(at, (k) (x = (k, 2), y = ((plotAnnual, 1, 0), (plotAnnual, 2, 1)) + 0.5)) # vertical lines for monthly
(h = 1.5) # separate monthly and annual
# month axis labels
(at[as.POSIXlt(at)$mon + 1 == 1], (k) (x = (k, 2), y = (0, 1) + 0.5))
label <- ((, 1, 1), 2)
xlimyear <- ()$year + 1900
labelat <- ((xlimyear, (k) ((k, 1:12, '16', sep = '-'), tz = 'UTC')))
(side=1, at= at, = , mgp=(2.5, 0.7, 0))
(side = 1, at = labelat, = label, mgp=(2.5, 0.7, 0), tick = , = -0.7)
# year axis labels
bigtickat <- ((xlimyear[2:(xlimyear)], (k) ((k, '01', '01', sep = '-'), tz = 'UTC')))
(side = 1, at = bigtickat, = , mgp=(2.5, 0.7, 0), tck = -0.6)
yearlabelat <- ((xlimyear, '07', '02', sep = '-'), tz = 'UTC')
(side = 1, = xlimyear, at = yearlabelat, mgp = (2.5, 0.7, 0), tck = )
# put numbers in boxes
## monthly
textcol <- ('black', (yAnomaly))
whitetext <- yAnomaly <= -3.0 | (yAnomaly >= 3.0 & yAnomaly < 3.5)
whitetext[is.na(whitetext)] <-
((!whitetext)) (x = !whitetext == & !(yAnomaly)], y = (plotAnnual, 2, 1), = ('%.1f', yAnomaly!whitetext == & !(yAnomaly)]), = 'black', srt = 90, cex = 0.8)
((whitetext)) (x = [whitetext == & !(yAnomaly)], y = (plotAnnual, 2, 1), = ('%.1f', yAnomaly[whitetext == & !(yAnomaly)]), = 'white', srt = 90, cex = 0.8)
## annual
(plotAnnual){
textcol <- ('black', (yAnnualAnomaly))
whitetext <- yAnnualAnomaly <= -3.0 | (yAnnualAnomaly >= 3.0 & yAnnualAnomaly < 3.5)
whitetext[is.na(whitetext)] <-
annualtextat <- ((xAnnualAnomaly, '07', '02', sep = '-'), tz = 'UTC')
((!whitetext)) (x = annualtextat!whitetext == & !(yAnnualAnomaly)], y = 1, = ('%.1f', yAnnualAnomaly!whitetext == & !(yAnnualAnomaly)]), = 'black', cex = 0.8)
((whitetext)) (x = annualtextat[whitetext == ], y = 1, = ('%.1f', yAnnualAnomaly[whitetext == & !(yAnnualAnomaly)]), = 'white', cex = 0.8)
}
# reset mai, prep for primary plot
(=, mai=pc$mai2)
# monthly plot with climatology
(mar = ('mar') * (0, 1, 1, 1) + (5.5, 0, 0, 0)) # have to change first term of second addition if changes made to colorbar height
#time <- as.POSIXct(paste(d[['data']][['year']], d[['data']][['month']], '15', sep = '-'), tz = 'UTC')
(, y,
= , = ,
xaxs = 'i',
xaxt = 'n', yaxt = 'n',
xlab = '', ylab = '',
= 'l')
(v = at[seq(1, (at), 2)], lty = 2, = 'lightgrey')
(2)
(h = (), lty = 2, = 'lightgrey')
(x = xpoly, y = ypoly,
= ,
= 'lightblue')
(, y)
()
# for debugging polygon
# polygon(x = xpolyb, y = ypolyb,
# density = NA,
# col = 'lightblue')
# points(x = xpolyb,
# y = ypolyb)
# text(x = xpolyb,
# y = ypolyb,
# labels = 1:length(xpolyb))
}
#' @title palette calculations
#' @param separation a numeric value
#' @param width a numeric value
#' @param pos a numeric value indicating the side
#' @param zlab a character
#' @param maidiff a numeric value
#' @param debug a numeric value
#' @importFrom graphics frame
#' @importFrom oce oceDebug
<- (separation=('cin')[2]/2 + 0.1 - 0.05 - 0.0125, # changed this, orig when just 1 it was 0.1/2
=('cin')[2] + 0.2 - 0.05 - 0.0125, # changed this, orig when just 1 it was 0.1
pos=4,
zlab, maidiff=(0, 0, 0, 0),
=("oceDebug"))
{
# NOTE from CL : many of the comments below are from imagep.R from the oce package, so disregard if trying to debug this
# code, this function is for use in plotMonthlyTimeseriesWAnomalyBar
## This returns a list with the following entries:
## mai0 = before this call
## mai1 = just before plotting palette (i.e. lots of white space on one side)
## mai1f = set before plotting fullpage palette
## mai2 = ready for post-palette drawing (i.e. good for a diagram beside palette)
if (!(pos %in% 1:4))
("'pos' must be 1, 2, 3 or 4")
oceDebug(, "paletteCalculations(separation=", separation,
", width=", , ", pos=", pos,
", zlab=", if ((zlab)) "(missing)" zlab,
", maidiff=c(", (maidiff, collapse=","), ")",
", debug=", , ") {\n", sep="", style="bold", unindent=1)
haveZlab <- !(zlab) && !(zlab) && ((zlab)) > 0
## 2014-04-02 {
## Below, we will be using e.g. par('mai') to find margins. If the user
## is employing layout(), the call will not give the right answer until the plot
## has been established or initialized (not sure on right term). So, we use
## a trick: call frame() to establish/initialize the plot, then call
## plot(new=TRUE) to prevent advancing to the next panel of the layout.
## A secondary trick is also required: we set to zero margins before
## calling frame(), because otherwise there can be a "figure margins
## too large" error from frame(), if the layout is tight.
omar <- ('mar')
(mar=(0, 4))
()
(mar=omar)
(=)
## OK, done with the trick now. PS: the long comments given here
## are a result of persistent problems with large-margin errors,
## and I don't want this new approach to get lost in code.
## } 2014-04-02
lineHeight <- ("cin")[2] # character height in inches
oceDebug(, "lineHeight:", lineHeight, "from cin\n")
oceDebug(, "par('csi'):", ('csi'), "\n")
tickSpace <- (("tcl")) * lineHeight # inches (not sure on this)
textSpace <- 1.25 * (lineHeight + if (haveZlab) lineHeight 0)
figureWidth <- ("fin")[1]
figureHeight <- ("fin")[2]
oceDebug(, "figureWidth:", (figureWidth, digits=2), "in\n")
oceDebug(, "figureHeight:", (figureHeight, digits=2), "in\n")
oceDebug(, "tickSpace:", tickSpace, "in\n")
oceDebug(, "textSpace:", textSpace, "in\n")
pc <- (mai0=('mai'))
pc$mai1 <- pc$mai0
pc$mai1f <- pc$mai0
pc$mai2 <- pc$mai0
##P <- separation + width
P <-
A <- tickSpace + textSpace
if (pos == 1) {
## alter top and bottom margins
pc$mai1[1] <- A
pc$mai1[3] <- figureHeight - P - A
pc$mai1f[2] <- 0
pc$mai1f[4] <- A
pc$mai2[1] <- P + A + pc$mai0[1]
pc$mai2[3] <- pc$mai0[3]
} if (pos == 2) {
## alter left and right margins
pc$mai1[2] <- A
pc$mai1[4] <- figureWidth - P - A
pc$mai1f[4] <- 0
pc$mai1f[2] <- A
pc$mai2[2] <- P + A + pc$mai0[2]
pc$mai2[4] <- pc$mai0[4]
} if (pos == 3) {
## alter top and bottom margins
pc$mai1[1] <- figureHeight - P - A
pc$mai1[3] <- A
pc$mai1f[1] <- 0
pc$mai1f[3] <- A
pc$mai2[1] <- pc$mai0[1]
pc$mai2[3] <- P + A + pc$mai0[3]
} if (pos == 4) {
## DEVELOPER: work here first since it's the common case
## alter left and right margins
pc$mai1[2] <- figureWidth - P - A
pc$mai1[4] <- A
pc$mai1f[2] <- 0
pc$mai1f[4] <- A
pc$mai2[2] <- pc$mai0[2]
pc$mai2[4] <- P + A + pc$mai0[4]
} {
("pos must be in 1:4") # never reached
}
## Adjust palette margins (mai1); FIXME: should this also alter mai2?
pc$mai1 <- pc$mai1 + maidiff
pc$mai1f <- pc$mai1f + maidiff
oceDebug(, "pc$mail1: ", ((pc$mai1, 2), sep=" "), "\n")
oceDebug(, "pc$mailf: ", ((pc$mai1f, 2), sep=" "), "\n")
oceDebug(, "} # paletteCalculations\n", style="bold", sep="", unindent=1)
pc
}
