Nothing
R/hydroplot.R
In hydroTSM: Time Series Management and Analysis for Hydrological Modelling
Defines functions
hydroplot.data.frame
hydroplot.zoo
hydroplot.default
.hydroplotseasonal
.hydroplothist
.hydroplotboxplot
.hydroplotts
hydroplot
Documented in
hydroplot
.hydroplotboxplot
hydroplot.data.frame
hydroplot.default
.hydroplothist
.hydroplotts
hydroplot.zoo
# File hydroplot.R
# Part of the hydroTSM R package, https://github.com/hzambran/hydroTSM ;
# http://www.rforge.net/hydroTSM/ ;
# https://cran.r-project.org/package=hydroTSM
# Copyright 2008-2020 Mauricio Zambrano-Bigiarini
# Distributed under GPL 2 or later
hydroplot <-function(x, ...) UseMethod("hydroplot")
################################################################################
# .hydroplotts Daily, Monthly and Annual Time Series #
################################################################################
# Author : Mauricio Zambrano-Bigiarini #
# Started: 2008 #
# Updates: 17-Apr-2011 ; 10-Aug-2011 #
# 15-Jan-2014 #
# 06-Aug-2017 #
################################################################################
# It requires the function'drawTimeAxis' that is stored in the 'lib_Plot.R' library
# 'x' : daily time series of type 'zoo'
# 'x.monthly : monthly time series of type 'zoo'
# 'x.annual' : annual time series of type 'zoo'
# 'win.len1' : number of days for being used in the computation of the first moving average
# 'win.len2' : number of days for being used in the computation of the second moving average
# 'var.type' : string representing the type of variable being plotted (e.g., "Precipitation", "Temperature" or "Flow").
# ONLY used for labelling the y axis and the title of the plot (in case it is missing)
# 'var.unit' : string representing the measurement unit of the variable being plotted ("mm" for precipitation, "C" for temperature, and "m3/s" for flow).
# ONLY used for labelling the y axis
# 'main' : string representing the main title of the plot
# 'pfreq' : string indicating how many plots are desired by the user.
# Valid values are:
# -) 'dma': Daily, Monthly and Annual values are plotted
# -) 'ma' : Monthly and Annual values are plotted
# -) 'dm' : Daily and Monthly values are plotted
# 'tick.tstep': string indicating the time step that have to be used for
# putting the ticks ont he time axis.
# Possible values are: 'days', 'months', 'years'
# 'lab.tstep' : string indicating the time step that have to be used for
# putting the labels ont he time axis.
.hydroplotts <- function(x, x.monthly, x.annual, win.len1=0, win.len2=0,
pfreq="dma", tick.tstep= "auto", lab.tstep= "auto", lab.fmt=NULL,
var.type, var.unit="units", main=NULL, xlab="Time", ylab=NULL,
cex.main=1.3, cex.lab=1.3, cex.axis=1.3, col="blue",
lwd=1, lty=1, ...) {
# Checking that the user provied a valid class for 'x'
valid.class <- c("xts", "zoo")
if (length(which(!is.na(match(class(x), valid.class )))) <= 0)
stop("Invalid argument: 'class(x)' must be in c('xts', 'zoo')")
# Checking that 'x.monthly' is a zoo or xts object
if ( length(x.monthly) > 1 ) {
if (is.na(match(class(x.monthly), c("zoo", "xts"))))
stop("Invalid argument: 'x.monthly' must be in c('zoo', 'xts')")
} # IF end
# Checking that 'x.annual' is a zoo or xts object
if ( length(x.annual) > 1 ) {
if (is.na(match(class(x.annual), c("zoo", "xts"))))
stop("Invalid argument: 'x.annual' must be be in c('zoo', 'xts')")
} # IF end
# Checking that the user provied a valid argument for 'pfreq'
if (is.na(match(pfreq, c("o", "dma", "ma", "dm"))))
stop("Invalid argument: 'pfreq' must be in c('o', 'dma', 'ma', 'dm')")
# Valid tseps for ''tick.tstep' and 'lab.tstep'
valid.tstep <- c("auto", "years", "quarters", "months", "weeks", "days",
"hours", "minutes", "seconds")
# Checking that the user provied a valid argument for 'tick.tstep'
if (is.na(match(tick.tstep, valid.tstep ) ) )
stop("Invalid argument: 'tick.tstep' must be in c('auto', 'years', 'quarters',
'months', 'weeks', 'days', 'hours', 'minutes', 'seconds')")
# Checking that the user provied a valid argument for 'lab.tstep'
if (is.na(match(lab.tstep, valid.tstep ) ) )
stop("Invalid argument: 'lab.tstep' must be in c('auto', 'years', 'quarters',
'months', 'weeks', 'days', 'hours', 'minutes', 'seconds')")
# Requiring the Zoo Library (Zoo's ordered observations)
#require(xts)
# Booleans indicating if the moving averages for the dayly and monthly
# time series can be computed and ploted. By default they are FALSE,
# and only if the lenght(x) is large enough they are changed into TRUE
d.ma1 <- FALSE
d.ma2 <- FALSE
m.ma1 <- FALSE
m.ma2 <- FALSE
# Generating a Moving Average of the Daily time series, with a window width 'win.len1'
if (win.len1 > 0 ) { # If 'win.len1==0', the moving average is not computed
win.len <- win.len1
if (length(x) >= win.len) {
d.ma1 <- TRUE
daily.ma1 <- ma.zoo(x, win.len)
#if (!is.xts(daily.ma1)) daily.ma1 <- as.xts(daily.ma1)
}
} # IF end
# Generating a Moving Average of the Daily time series, with a window width 'win.len2'
if (win.len2 > 0 ) { # If 'win.len2==0', the moving average is not computed
win.len <- win.len2
if (length(x) >= win.len) {
d.ma2 <- TRUE
daily.ma2 <- ma.zoo(x, win.len)
#if (!is.xts(daily.ma2)) daily.ma2 <- as.xts(daily.ma2)
}
} # IF end
# Generating a Moving Average of the Monthly time series, with a window width 'win.len1'
if (win.len1 > 0 ) { # If 'win.len1==0', the moving average is not computed
win.len <- round(win.len1/365,1)*12
if (length(x.monthly) >= win.len) {
m.ma1 <- TRUE
monthly.ma1 <- ma.zoo( x.monthly, win.len ) }
} # IF end
# Generating a Moving Average of the Monthly time series, with a window width 'win.len2'
if (win.len2 > 0 ) { # If 'win.len2==0', the moving average is not computed
win.len <- round(win.len2/365,1)*12
if (length(x.monthly) >= win.len) {
m.ma2 <- TRUE
monthly.ma2 <- ma.zoo( x.monthly, win.len ) }
} # IF end
# If 'x' is not 'xts' it is transformed into one
#if ( !(is.xts(x)) ) x <- as.xts(x)
# Plotting only the original zoo or xts object, without moving averages and legends
if ( pfreq == "o") {
# Plotting the Daily Time Series
zoo::plot.zoo(x, xaxt = "n", yaxt = "n", type="o",
main=main, xlab=xlab, ylab=ylab,
cex.main=cex.main, cex.lab=cex.lab, cex.axis=cex.axis, col=col,
lty=lty, lwd=lwd, ...)
axis(2, cex.lab=1.3, cex.axis=1.3)
# Draws monthly ticks in the X axis, but labels only in years
drawTimeAxis(x, tick.tstep=tick.tstep, lab.tstep=lab.tstep, lab.fmt=lab.fmt,
cex.lab=cex.lab, cex.axis=cex.axis, ...)
# manually adding a grid
grid(nx=NA, ny=NULL)
abline(v=time(x)[axTicksByTime(x)], col = "lightgray", lty = "dotted")
} # IF end
# Plotting the Daily, if needed
if ( pfreq %in% c("dma", "dm") ) {
# Generating the title of the Daily Time Series plot
title <- paste("Daily time series", main, sep= " ")
# Plotting the Daily Time Series
# xaxt = "n": is for avoiding drawing the x axis
zoo::plot.zoo(x, xaxt = "n", yaxt = "n", type="o",
main=title, xlab=xlab, ylab=paste(ylab," [", var.unit,"/day]", sep=""),
cex.main=cex.main, cex.lab=cex.lab, cex.axis=cex.axis, col=col,
lty=lty, lwd=lwd, ...)
axis(2, cex.lab=cex.lab, cex.axis=cex.axis)
# Draws monthly ticks in the X axis, but labels only in years
drawTimeAxis(x, tick.tstep=tick.tstep, lab.tstep=lab.tstep, lab.fmt=lab.fmt,
cex.lab=cex.lab, cex.axis=cex.axis, ...)
# manually adding a grid
grid(nx=NA, ny=NULL)
abline(v=time(x)[axTicksByTime(x)], col = "lightgray", lty = "dotted")
if (d.ma1) {
# Plotting the 1st Moving Average of the Daily time series. If win.len1=365*1 => "Annual Moving Average"
lines(daily.ma1, type="o", lty=2, lwd=1, col="green", cex = .5) }
if (d.ma2) {
# Plotting the 2nd Moving Average of the Daily time series. If win.len2=365*3 => "Moving Average of 3 Years"
lines(daily.ma2, type="o", lty=3, lwd=1, col="red", cex = .5) }
# Drawing a legend. y.intersp=0.5, is for the vertical spacin in the legend
leg.text <- "Daily series"
leg.lwd <- lwd
leg.lty <- lty
leg.col <- col
if (d.ma1) {
leg.text <- c(leg.text, paste("MA(", round(win.len1/365,2), " years)", sep="") )
leg.lwd <- c(leg.lwd, 1)
leg.lty <- c(leg.lty, 2)
leg.col <- c(leg.col, "green")
} # IF end
if (d.ma2) {
leg.text <- c(leg.text, paste("MA(", round(win.len2/365,2), " years)", sep="") )
leg.lwd <- c(leg.lwd, 1)
leg.lty <- c(leg.lty, 3)
leg.col <- c(leg.col, "red")
} # IF end
legend("topleft", leg.text, bty="n", cex =0.9, col= leg.col, lwd= leg.lwd, lty=leg.lty ) #bty="n" => no box around the legend
} # IF end
# Plotting the Monthly, if needed
if ( pfreq %in% c("dma", "dm", "ma") ) {
# Generating the title of the Monthly Time Series plot
title <- paste("Monthly time series", main, sep= " ")
# Plotting the Monthly time series
zoo::plot.zoo(x.monthly, xaxt = "n", yaxt = "n", type="o",
main=title, xlab=xlab, ylab=paste(ylab," [", var.unit,"/month]", sep=""),
cex.main=cex.main, cex.lab=cex.lab, cex.axis=cex.axis, col=col,
lty=lty, lwd=lwd, ... )
axis(2, cex.lab=cex.lab, cex.axis=cex.axis)
# Draws monthly ticks in the X axis, but labels only in years
drawTimeAxis(x.monthly, tick.tstep=tick.tstep, lab.tstep=lab.tstep, lab.fmt=lab.fmt,
cex.lab=cex.lab, cex.axis=cex.axis, ...)
# manually adding a grid
grid(nx=NA, ny=NULL)
abline(v=time(x)[axTicksByTime(x.monthly)], col = "lightgray", lty = "dotted")
if (m.ma1) {
# Plotting the 1st Moving Average of the Daily time series. If win.len1=365*1 => "Annual Moving Average"
lines(monthly.ma1, type="o", lty=2, lwd=1, col="green", cex = .5) }
if (m.ma2) {
# Plotting the 2nd Moving Average of the Daily time series. If win.len2=365*3 => "Moving Average of 3 Years"
lines(monthly.ma2, type="o", lty=3, lwd=1, col="red", cex = .5) }
# Drawing a legend
leg.text <- "Monthly series"
leg.lwd <- lwd
leg.lty <- lty
leg.col <- col
if (m.ma1) {
leg.text <- c(leg.text, paste("MA(", round(win.len1/365,1), " years)", sep="") )
leg.lwd <- c(leg.lwd, 1)
leg.lty <- c(leg.lty, 2)
leg.col <- c(leg.col, "green")
} # IF end
if (m.ma2) {
leg.text <- c(leg.text, paste("MA(", round(win.len2/365,1), " years)", sep="") )
leg.lwd <- c(leg.lwd, 1)
leg.lty <- c(leg.lty, 3)
leg.col <- c(leg.col, "red")
} # IF end
legend("topleft", leg.text, bty="n", cex =0.9, col= leg.col, lwd= leg.lwd, lty=leg.lty ) #bty="n" => no box around the legend
} # IF end
# Plotting the Annual, if needed
if ( pfreq %in% c("dma", "ma") ) {
# Generating the title of the Annual Time Series plot
title <- paste("Annual time series", main, sep= " ")
# Plotting the Annual time series
zoo::plot.zoo(x.annual, xaxt = "n", yaxt = "n", type="o",
main=title, xlab="Time", ylab=paste(ylab," [", var.unit,"/year]", sep=""),
cex.main=cex.main, cex.lab=cex.lab, cex.axis=cex.axis, col=col,
lty=lty, lwd=lwd, ...)
axis(2, cex.lab=cex.lab, cex.axis=cex.axis)
# Draws monthly ticks in the X axis, but labels only in years
drawTimeAxis(x.annual, tick.tstep="years", lab.tstep="years", lab.fmt="%Y",
cex.lab=cex.lab, cex.axis=cex.axis, ...)
# manually adding a grid
grid(nx=NA, ny=NULL)
abline(v=time(x)[axTicksByTime(x.annual)], col = "lightgray", lty = "dotted")
} # IF end
} # '.hydroplotts' end
################################################################################
# BoxPlot of Daily, Monthly and Annual Time Serires #
################################################################################
# Author : Mauricio Zambrano-Bigiarini #
################################################################################
# Started: 2008 #
# Updates: 17-Apr-2011 #
# 29-May-2013 #
################################################################################
# 'x' : daily time series of type 'zoo'
# 'x.monthly : monthly time series of type 'zoo'
# 'x.annual' : annual time series of type 'zoo'
# 'var.type' : string representing the type of variable being plotted
# (e.g., "Precipitation", "Temperature" or "Flow").
# ONLY used for labelling the y axis and the title of the plot (in case it is missing)
# 'var.unit' : string representing the measurement unit of the variable
# being plotted ("mm" for precipitation, "C" for temperature, and "m3/s" for flow).
# ONLY used for labelling the y axis
# 'main' : string representing the main title of the plot
# 'pfreq' : string indicating how many plots are desired by the user.
# Valid values are:
# -) 'dma': Daily, Monthly and Annual values are plotted
# -) 'dm' : Daily and Monthly values are plotted
# -) 'ma' : Monthly and Annual values are plotted
#
.hydroplotboxplot <- function(x, x.monthly, x.annual, pfreq="dma",
var.type, var.unit="units",
main=NULL, xlab=NULL, ylab=NULL,
cex.main=1.3, cex.lab=1.3, cex.axis=1.3,
col="lightblue",
...
) {
# Checking that 'x' is a zoo or xts object
if (is.na(match(class(x), c("zoo", "xts"))))
stop("Invalid argument: 'class(x)' must be in c('zoo', 'xts')")
# Checking that 'x.monthly' is a zoo object
if (is.na(match(class(x.monthly), c("zoo", "xts"))))
stop("Invalid argument: 'class(x.monthly)' must be in c('zoo', 'xts')")
# Checking that 'x.annual' is a zoo object
if (is.na(match(class(x.annual), c("zoo", "xts"))))
stop("Invalid argument: 'class(x.annual)' must be in c('zoo', 'xts')")
# Checking that the user provied a valid argument for 'pfreq'
if (is.na(match(pfreq, c("dma", "ma", "dm"))))
stop("Invalid argument: 'pfreq' must be in c('dma', 'ma', 'dm')")
# Checking if the Daily Boxplot have to be plotted
if ( pfreq %in% c("dma", "dm") ) {
# Generating a factor based on the year in which each daily date falls
cyear <- format(time(x), "%Y")
years <- factor(cyear, levels=unique(cyear), ordered=TRUE)
# Generating the title of the Daily plot
title <- paste("Daily Boxplot", main, sep= " ")
# Drawing boxplot of Daily values against Year
boxplot( coredata(x)~years, main=title, ylab=paste(ylab," [", var.unit, "/day]", sep=""),
cex.main=cex.main, cex.lab=cex.lab, cex.axis=cex.axis, col=col, ...)
} # IF end
# Checking if the Monthly Boxplot have to be plotted
if ( pfreq %in% c("dma", "dm", "ma") ) {
# Generating a factor based on the month in which each monthly date falls
cmonth <- format(time(x.monthly), "%b")
months <- factor(cmonth, levels=unique(cmonth), ordered=TRUE)
# Generating the title of the Monthly plot
title <- paste("Monthly Boxplot", main, sep= " ")
# Drawing boxplot of Monthly values against Year
boxplot( coredata(x.monthly)~months, main=title, ylab=paste(ylab," [", var.unit,"/month]", sep=""),
cex.main=cex.main, cex.lab=cex.lab, cex.axis=cex.axis, col=col, ...)
} # IF end
# Checking if the Annual Boxplot have to be plotted
if ( pfreq %in% c("dma", "ma") ) {
# Generating the title of the Annual plot
title <- paste("Annual Boxplot", main, sep= " ")
# Drawing boxplot of Annual values against Year
boxplot( coredata(x.annual), main=title, ylab=paste(ylab," [", var.unit, "/year]", sep=""),
cex.main=cex.main, cex.lab=cex.lab, cex.axis=cex.axis, col=col, ...)
} # IF end
} #'.hydroplotboxplot' end
################################################################################
# Histogram of Daily, Monthly and Annual Time Serires #
################################################################################
# Author : Mauricio Zambrano-Bigiarini #
################################################################################
# Started: 2008 #
# Updates: 17-Apr-2011 #
# 29-May-2013 #
################################################################################
# 'x' : daily time series of type 'zoo'
# 'x.monthly : monthly time series of type 'zoo'
# 'x.annual' : annual time series of type 'zoo'
# 'var.type' : string representing the type of variable being plotted (e.g., "Precipitation", "Temperature" or "Flow").
# ONLY used for labelling the y axis and the title of the plot (in case it is missing)
# 'var.unit' : string representing the measurement unit of the variable being plotted ("mm" for precipitation, "C" for temperature, and "m3/s" for flow).
# ONLY used for labelling the x axis
# 'main' : string representing the main title of the plot
# 'pfreq' : string indicating how many plots are desired by the user.
# Valid values are:
# -) 'dma': Daily, Monthly and Annual values are plotted
# -) 'ma' : Monthly and Annual values are plotted
# -) 'dm' : Daily and Monthly values are plotted
.hydroplothist <- function(x, x.monthly, x.annual, pfreq="dma",
var.type, var.unit="units",
main=NULL, xlab=NULL, ylab=NULL,
cex.main=1.3, cex.lab=1.3, cex.axis=1.3, col="lightblue",
...
) {
# Checking that 'x' is a zoo or xts object
if (is.na(match(class(x), c("zoo", "xts"))))
stop("Invalid argument: 'class(x)' must be in c('zoo', 'xts')")
# Checking that 'x.monthly' is a zoo object
if (is.na(match(class(x.monthly), c("zoo", "xts"))))
stop("Invalid argument: 'class(x.monthly)' must be in c('zoo', 'xts')")
# Checking that 'x.annual' is a zoo object
if (is.na(match(class(x.annual), c("zoo", "xts"))))
stop("Invalid argument: 'class(x.annual)' must be in c('zoo', 'xts')")
# Checking that the user provied a valid argument for 'pfreq'
if (is.na(match(pfreq, c("dma", "ma", "dm"))))
stop("Invalid argument: 'pfreq' must be in c('dma', 'ma', 'dm')")
# Checking if the Daily ts have to be plotted
if ( pfreq %in% c("dma", "dm") ) {
# Generating the title of the Daily plot
title <- paste("Daily Histogram", main, sep= " ")
# Drawing an histogram of Daily Precipitation
hist(x, br=100, freq=FALSE, main=title, xlab=paste(ylab," [", var.unit, "/day]", sep=""),
ylab="Pbb", cex.main=cex.main, cex.lab=cex.lab, cex.axis=cex.axis, col=col, ...)
} # IF end
# Checking if the Monthly ts have to be plotted
if ( pfreq %in% c("dma", "dm", "ma") ) {
# Generating the title of the Monthly plot
title <- paste("Monthly Histogram", main, sep= " ")
# Drawing an histogram of Monthly Precipitation
hist(x.monthly, br=10, freq=FALSE, main=title, xlab=paste(ylab," [", var.unit, "/month]", sep=""),
ylab="Pbb", cex.main=cex.main, cex.lab=cex.lab, cex.axis=cex.axis, col=col, ...)
} # IF end
# Checking if the Annual ts have to be plotted
if ( pfreq %in% c("dma", "ma") ) {
# Generating the title of the Annual plot
title <- paste("Annual Histogram", main, sep= " ")
# Drawing an histogram of Annual Precipitation
hist(x.annual, br=5, freq=FALSE, main=title, xlab=paste(ylab," [", var.unit, "/year]", sep=""),
ylab="Pbb", cex.main=cex.main, cex.lab=cex.lab, cex.axis=cex.axis, col=col, ...)
} # IF end
} # '.hydroplothist' end
#########################################################################
# hydroplotseasonal: Seasonal plots of hydrological time series #
#########################################################################
# Author : Mauricio Zambrano-Bigiarini #
# Started: 19-Jun-2011 #
# Updates: 10-Aug-2011 #
# 06-Aug-2017 #
#########################################################################
.hydroplotseasonal <- function(x, FUN, na.rm=TRUE,
tick.tstep= "auto", lab.tstep= "auto", lab.fmt=NULL,
var.unit="units", main=NULL, xlab="Time", ylab=NULL,
cex.main=1.3, cex.lab=1.3, cex.axis=1.3, col="blue",
lwd=1, lty=1, stype="default",
season.names=c("Winter", "Spring", "Summer", "Autumn"),
h=NULL, ...) {
# checking the class of 'x'
if (!is.zoo(x))
stop("Invalid argument: 'class(x)' must be in c('zoo', 'xts')")
# Valid tseps for ''tick.tstep' and 'lab.tstep'
valid.tstep <- c("auto", "years", "quarters", "months", "weeks", "days",
"hours", "minutes", "seconds")
# Checking that the user provied a valid argument for 'tick.tstep'
if (is.na(match(tick.tstep, valid.tstep ) ) )
stop("Invalid argument: 'tick.tstep' must be in c('auto', 'years', 'quarters',
'months', 'weeks', 'days', 'hours', 'minutes', 'seconds')")
# Checking that the user provied a valid argument for 'lab.tstep'
if (is.na(match(lab.tstep, valid.tstep ) ) )
stop("Invalid argument: 'lab.tstep' must be in c('auto', 'years', 'quarters',
'months', 'weeks', 'days', 'hours', 'minutes', 'seconds')")
# Checking that the user provied a valid value for 'stype'
valid.types <- c("default", "FrenchPolynesia")
if (length(which(!is.na(match(stype, valid.types )))) <= 0)
stop("Invalid argument: 'stype' must be in c('default', 'FrenchPolynesia')")
# Checking that the user provied a valid argument for 'season.names'
if ( length(season.names) != 4 )
stop("Invalid argument: 'season.names' must have 4 elements !")
# Checking the length of x
if ( sfreq(x) == "daily" ) {
if (length(x) < 365 )
stop("Invalid argument: daily time series need -at least- 365 values !")
} else if ( sfreq(x) == "monthly" ) {
if (length(x) < 12 )
stop("Invalid argument: monthly time series need -at least- 12 values !")
} else if ( sfreq(x) == "annual" )
stop("Invalid argument: seasonal plots can not be drawn for annual time series !")
# Labels for the seasons
if (stype=="default") {
seasons.lab <- c("DJF", "MAM", "JJA", "SON")
} else if (stype=="FrenchPolynesia") {
seasons.lab <- c("DJFM", "AM", "JJAS", "ON")
} # ELSE end
# Computing the seasonal values
winter <- dm2seasonal(x, season=seasons.lab[1], FUN=FUN, out.fmt="%Y-%m-%d")
spring <- dm2seasonal(x, season=seasons.lab[2], FUN=FUN, out.fmt="%Y-%m-%d")
summer <- dm2seasonal(x, season=seasons.lab[3], FUN=FUN, out.fmt="%Y-%m-%d")
autumm <- dm2seasonal(x, season=seasons.lab[4], FUN=FUN, out.fmt="%Y-%m-%d")
# Transforming the seasonal values into xts objects
#winter <- as.xts(winter)
#spring <- as.xts(spring)
#summer <- as.xts(summer)
#autumm <- as.xts(autumm)
#################################
# Plotting seasonal time series #
#################################
def.par <- par(no.readonly = TRUE) # save default, for resetting...
on.exit(par(def.par))
layout( matrix( c(1,1,1,1,1,1,1,1,1,5,5,2,2,2,2,2,2,2,2,2,6,6,3,3,3,3,3,3,3,3,3,7,7,4,4,4,4,4,4,4,4,4,8,8), ncol=11, byrow=TRUE) )
if (length(h)==1) h <- rep(h,4)
# winter
zoo::plot.zoo(winter, xaxt = "n", yaxt = "n", type="o",
main=paste(season.names[1], " (", seasons.lab[1], ")", sep=""), xlab=xlab, ylab=ylab,
cex.main=cex.main, cex.lab=cex.lab, cex.axis=cex.axis, col=col,
lty=lty, lwd=lwd, ...)
axis(2, cex.lab=1.3, cex.axis=1.3)
drawTimeAxis(winter, tick.tstep=tick.tstep, lab.tstep=lab.tstep, lab.fmt=lab.fmt,
cex.lab=cex.lab, cex.axis=cex.axis, ...)
abline(h=h[1], col="red", lty=2)
# manually adding a grid
grid(nx=NA, ny=NULL)
abline(v=time(x)[axTicksByTime(winter)], col = "lightgray", lty = "dotted")
# spring
zoo::plot.zoo(spring, xaxt = "n", yaxt = "n", type="o",
main=paste(season.names[2], " (", seasons.lab[2], ")", sep=""), xlab=xlab, ylab=ylab,
cex.main=cex.main, cex.lab=cex.lab, cex.axis=cex.axis, col=col,
lty=lty, lwd=lwd, ...)
axis(2, cex.lab=1.3, cex.axis=1.3)
drawTimeAxis(spring, tick.tstep=tick.tstep, lab.tstep=lab.tstep, lab.fmt=lab.fmt,
cex.lab=cex.lab, cex.axis=cex.axis, ...)
abline(h=h[2], col="red", lty=2)
# manually adding a grid
grid(nx=NA, ny=NULL)
abline(v=time(x)[axTicksByTime(spring)], col = "lightgray", lty = "dotted")
# summer
zoo::plot.zoo(summer, xaxt = "n", yaxt = "n", type="o",
main=paste(season.names[3], " (", seasons.lab[3], ")", sep=""), xlab=xlab, ylab=ylab,
cex.main=cex.main, cex.lab=cex.lab, cex.axis=cex.axis, col=col,
lty=lty, lwd=lwd, ...)
axis(2, cex.lab=1.3, cex.axis=1.3)
drawTimeAxis(summer, tick.tstep=tick.tstep, lab.tstep=lab.tstep, lab.fmt=lab.fmt,
cex.lab=cex.lab, cex.axis=cex.axis, ...)
abline(h=h[3], col="red", lty=2)
# manually adding a grid
grid(nx=NA, ny=NULL)
abline(v=time(x)[axTicksByTime(summer)], col = "lightgray", lty = "dotted")
# autumm
zoo::plot.zoo(autumm, xaxt = "n", yaxt = "n", type="o",
main=paste(season.names[4], " (", seasons.lab[4], ")", sep=""), xlab=xlab, ylab=ylab,
cex.main=cex.main, cex.lab=cex.lab, cex.axis=cex.axis, col=col,
lty=lty, lwd=lwd, ...)
axis(2, cex.lab=1.3, cex.axis=1.3)
drawTimeAxis(autumm, tick.tstep=tick.tstep, lab.tstep=lab.tstep, lab.fmt=lab.fmt,
cex.lab=cex.lab, cex.axis=cex.axis, ...)
abline(h=h[4], col="red", lty=2)
# manually adding a grid
grid(nx=NA, ny=NULL)
abline(v=time(x)[axTicksByTime(autumm)], col = "lightgray", lty = "dotted")
#################################
# Plotting seasonal boxplots #
#################################
boxplot(coredata(winter), col= "lightblue", ylab = ylab,
main = paste(season.names[1], " (", seasons.lab[1], ")", sep=""),
pars=list(cex.main=cex.main, cex.lab=cex.lab, cex.axis=cex.axis))
abline(h=h[1], col="red", lty=2)
boxplot(coredata(spring), col= "lightblue", ylab = ylab,
main = paste(season.names[2], " (", seasons.lab[2], ")", sep=""),
pars=list(cex.main=cex.main, cex.lab=cex.lab, cex.axis=cex.axis))
abline(h=h[2], col="red", lty=2)
boxplot(coredata(summer), col= "lightblue", ylab = ylab,
main = paste(season.names[3], " (", seasons.lab[3], ")", sep=""),
pars=list(cex.main=cex.main, cex.lab=cex.lab, cex.axis=cex.axis))
abline(h=h[3], col="red", lty=2)
boxplot(coredata(autumm), col= "lightblue", ylab = ylab,
main = paste(season.names[4], " (", seasons.lab[4], ")", sep=""),
pars=list(cex.main=cex.main, cex.lab=cex.lab, cex.axis=cex.axis))
abline(h=h[4], col="red", lty=2)
} # .hydroplotseasonal END
################################################################################
# hydroplot.zoo: Daily, Monthly and Annual plots of hydrological time series #
################################################################################
# Author : Mauricio Zambrano-Bigiarini #
################################################################################
# Started: 2008 #
# Updates: 19-Apr-2011 ; 19-Jun-2011 ; 10-Aug-2011 #
# 04-Jun-2012 #
# 04-Apr-2013 ; 29-May-2013 #
# 07-Nov-2020 #
################################################################################
hydroplot.default <- function(x,
FUN, na.rm=TRUE,
ptype="ts+boxplot+hist",
pfreq="dma",
var.type,
var.unit="units",
main=NULL, xlab="Time", ylab,
win.len1=0,
win.len2=0,
tick.tstep="auto",
lab.tstep="auto",
lab.fmt=NULL,
cex=0.3,
cex.main=1.3,
cex.lab=1.3,
cex.axis=1.3,
col=c("blue", "lightblue", "lightblue"),
from=NULL,
to=NULL,
dates=1, date.fmt = "%Y-%m-%d",
stype="default",
season.names=c("Winter", "Spring", "Summer", "Autumn"),
h=NULL, ...) {
# Checking that 'x' is a zoo object
if ( !is.zoo(x) ) stop("Invalid argument: 'class(x)' must be in c('zoo', 'xts')")
hydroplot.zoo(x, FUN=FUN, na.rm=na.rm, ptype=ptype, pfreq=pfreq,
var.type=var.type, var.unit=var.unit, main=main, xlab=xlab, ylab=ylab,
win.len1=win.len1, win.len2=win.len2, tick.tstep=tick.tstep,
lab.tstep=lab.tstep, lab.fmt=lab.fmt, cex=cex, cex.main=cex.main, cex.lab=cex.lab,
cex.axis=cex.axis, col=col, from=from, to=to, stype=stype, season.names=season.names, h=h, ...)
} # 'hydroplot.default' end
################################################################################
# hydroplot.zoo: Daily, Monthly and Annual plots of hydrological time series #
################################################################################
# Author : Mauricio Zambrano-Bigiarini #
################################################################################
# Started: 2008 #
# Updates: 19-Apr-2011 ; 19-Jun-2011 ; 10-Aug-2011 #
# 04-Jun-2012 #
# 04-Apr-2013 ; 29-May-2013 #
# 07-Nov-2020 #
################################################################################
# 9 plots:
# 1: Line plot with Daily time series, with 2 moving averages, specified by 'win.len1' and 'win.len2'
# 2: Line plot with Monthly time series, with 2 moving averages, specified by 'win.len1' and 'win.len2'
# 3: Line plot with Annual time series
# 4: Boxplot with daily time series
# 5: Boxplot with monthly time series
# 6: Boxplot with annual time series
# 7: Histogram of the daily time series
# 8: Histogram of the monthly time series
# 9: Histogram of the annual time series
hydroplot.zoo <- function(x,
FUN, na.rm=TRUE,
ptype="ts+boxplot+hist",
pfreq="dma",
var.type,
var.unit="units",
main=NULL, xlab="Time", ylab,
win.len1=0,
win.len2=0,
tick.tstep="auto",
lab.tstep="auto",
lab.fmt=NULL,
cex=0.3,
cex.main=1.3,
cex.lab=1.3,
cex.axis=1.3,
col=c("blue", "lightblue", "lightblue"),
from=NULL,
to=NULL,
dates=1, date.fmt = "%Y-%m-%d",
stype="default",
season.names=c("Winter", "Spring", "Summer", "Autumn"),
h=NULL, ...) {
# Checking that the user provied a valid class for 'x'
if (!is.zoo(x))
stop("Invalid argument: 'class(x)' must be in c('xts', 'zoo')")
# 'xname' value
xname <- deparse(substitute(x))
# 'ylab' value
if ( missing(ylab) ) {
ylab <- xname
} else if ( is.null(ylab) ) ylab <- xname
# Checking that the user provied a valid argument for 'ptype'
if (is.na(match(ptype, c("ts", "ts+boxplot", "ts+hist", "ts+boxplot+hist"))))
stop("Invalid argument: 'ptype' must be in c('ts', 'ts+boxplot', 'ts+hist', 'ts+boxplot+hist')")
# Checking that the user provied a valid argument for 'pfreq'
if ( sfreq(x) == "daily" ) {
if (is.na(match(pfreq, c("o", "dma", "dm", "ma", "seasonal"))))
stop("Invalid argument: 'pfreq' must be in c('o', 'dma', 'ma', 'dm', 'seasonal')")
} else if ( sfreq(x) == "monthly" ) {
if (is.na(match(pfreq, c("ma", "seasonal")))) {
message("[Warning: 'x' is a monthly object, so 'pfreq' has been changed to 'ma']")
pfreq <- "ma"
}
} # ELSE end
if ( (pfreq == "o") & (ptype != "ts") ) {
message(paste("[Note: pfreq='o' => ptype has been changed to 'ts']" , sep="") )
ptype <- "ts"
} # IF end
# Checking that the user provied a valid argument for 'var.type'
if (missing(FUN) & (pfreq != "o") ) {
# If the user did not provide a title for the plots, this is created automatically
if (missing(var.type)) {
stop("Missing argument: 'var.type' OR 'FUN' must be provided")
} else # If 'var.type' is provided
# Checking that the user provied a valid argument for 'var.type'
if (is.na(match(var.type, c("Precipitation", "Temperature", "Flow") ) ) ) {
stop("Invalid argument: 'var.type' must be in c('Precipitation', 'Temperature', 'Flow')")
} else {
if (var.type=="Precipitation") {
FUN <- sum
if (missing(var.unit)) { var.unit <- "mm" }
} else if (var.type=="Temperature") {
FUN <- mean
if (missing(var.unit)) { var.unit <- "dC" }
} else if (var.type=="Flow") {
FUN <- mean
if (missing(var.unit)) { var.unit= "m3/s" }
}
} #ELSE end
} # IF end
##########################################
## In case 'from' and 'to' are provided ##
dates <- time(x)
ndates <- length(dates)
# Checking the validity of the 'from' argument
if (!is.null(from)) {
from <- as.Date(from, format=date.fmt)
if ( !(from %in% dates) ) {
stop("Invalid argument: 'from' is not in 'dates' ")
} else x <- window(x, start=from)
} # IF end
# Checking the validity of the 'to' argument
if (!is.null(to)) {
to <- as.Date(to, format=date.fmt)
if ( !(from %in% dates) ) {
stop("Invalid argument: 'to' is not in 'dates' ")
} else x <- window(x, end=to)
} # IF end
#################
# Assigning a dummy value to FUN, which is not used when pfreq="o"
if (pfreq == "o") FUN <- mean
def.par <- par(no.readonly = TRUE) # save default, for resetting...
on.exit(par(def.par))
# IF the user wants SEASONAL plots
if (pfreq == "seasonal") {
# Checking that the user provied a valid value for 'stype'
valid.types <- c("default", "FrenchPolynesia")
if (length(which(!is.na(match(stype, valid.types )))) <= 0)
stop("Invalid argument: 'stype' must be in c('default', 'FrenchPolynesia')")
# Checking that the user provied a valid argument for 'season.names'
if ( length(season.names) != 4 )
stop("Invalid argument: 'season.names' must have 4 elements !")
if (!missing(ptype)) {
if ( ptype != "ts+boxplot") {
message("[Note: 'pfreq=seasonal' => 'ptype' has been changed to 'ts+boxplot']")
ptype <- "ts+boxplot"
} # IF end
} # IF end
if ( lab.tstep != "auto" ) {
if ( lab.tstep != "years" ) {
message("[Note: 'pfreq=seasonal' => 'lab.tstep' has been changed to 'years']")
lab.tstep <- "years"
} # IF end
} else lab.tstep <- "years"
if ( !is.null(lab.fmt) ) {
if ( lab.fmt != "%Y" ) {
message("[Note: 'pfreq=seasonal' => 'lab.fmt' has been changed to '%Y']")
lab.fmt <- "%Y"
} # IF end
} else lab.fmt <- "%Y"
.hydroplotseasonal(x=x, FUN=FUN, na.rm=na.rm, tick.tstep= tick.tstep,
lab.tstep= lab.tstep, lab.fmt=lab.fmt, var.unit=var.unit,
main=main, xlab=xlab, ylab=ylab, cex.main=cex.main,
cex.lab=cex.lab, cex.axis=cex.axis, col=col,
stype=stype, season.names=season.names, h=h, ...)
} else {
if (pfreq != "o") {
# If 'x' is too short for plotting annual values, 'pfreq' is automatically changed
if ( ( (sfreq(x) == "daily") & ( length(x) <= 366 ) ) |
( (sfreq(x) == "monthly") & ( length(x) <= 12 ) ) ) {
if ( pfreq %in% c("dma", "ma") ) {
if (pfreq == "dma") pfreq <- "dm"
if (pfreq == "ma") pfreq <- "m"
message(paste("[Warning: your ts is too short for plotting annual time series => 'pfreq'= ", pfreq, "]", sep="") )
}
} # IF end
# Computing the monthly time series
if ( sfreq(x) == "daily" ) {
x.monthly <- daily2monthly(x, FUN=FUN, na.rm=na.rm)
} else if ( sfreq(x) == "monthly" ) {
x.monthly <- x
} else x.monthly <- NA
# Computing the annual time series
if ( !is.na( match( sfreq(x), c("daily", "monthly") ) ) ) {
x.annual <- daily2annual(x, FUN=FUN, na.rm=na.rm, out.fmt="%Y-%m-%d")
} else if ( sfreq(x) == "annual" ) {
x.annual <- x
} else x.annual <- NA
} else {
x.monthly <- NA
x.annual <- NA
} # ELSE end
if (ptype=="ts") {
# Setting up the screen with 3 rows and 3 columns
if (pfreq == "o") {
par(mfcol=c(1,1))
} else if (pfreq == "dma") {
par(mfcol=c(3,1))
} else if (pfreq %in% c("dm", "ma")) {
par(mfcol=c(2,1))
} # ELSE end
# Drawing the daily, monthly and annual time series of the variable against time
.hydroplotts(x=x, x.monthly=x.monthly, x.annual=x.annual, pfreq=pfreq,
win.len1=win.len1, win.len2=win.len2, var.type=var.type,
var.unit=var.unit, main=main, xlab=xlab, ylab=ylab,
tick.tstep= tick.tstep, lab.tstep= lab.tstep, lab.fmt,
cex=cex, cex.main=cex.main, cex.lab=cex.lab, cex.axis=cex.axis, col=col[1], ...)
} # IF end
else if ( (ptype=="ts+boxplot") & (pfreq != "seasonal") ) {
# Setting up the screen with 3 rows and 3 columns
if (pfreq == "dma") { par(mfcol=c(3,2))
} else if (pfreq %in% c("dm", "ma")) { par(mfcol=c(2,2))
} # ELSE end
# Drawing the daily, monthly and annual time series of the variable against time
.hydroplotts(x=x, x.monthly=x.monthly, x.annual=x.annual, pfreq=pfreq,
win.len1=win.len1, win.len2=win.len2, var.type=var.type,
var.unit=var.unit, main=main, xlab=xlab, ylab=ylab,
tick.tstep= tick.tstep, lab.tstep= lab.tstep, lab.fmt,
cex=cex, cex.main=cex.main, cex.lab=cex.lab, cex.axis=cex.axis, col=col[1], ...)
# Drawing a boxplot of the daily, monthly and annual time series of the variable
.hydroplotboxplot(x=x, x.monthly=x.monthly, x.annual=x.annual, pfreq=pfreq,
var.type=var.type, var.unit=var.unit, main=main, xlab=xlab, ylab=ylab,
cex=cex, cex.main=cex.main, cex.lab=cex.lab, cex.axis=cex.axis, col=col[2], ...)
} # ELSE end
else if (ptype=="ts+hist") {
# Setting up the screen with 3 rows and 3 columns
if (pfreq == "dma") { par(mfcol=c(3,2))
} else if (pfreq %in% c("dm", "ma")) { par(mfcol=c(2,2))
} # ELSE end
# Drawing the daily, monthly and annual time series of the variable against time
.hydroplotts(x=x, x.monthly=x.monthly, x.annual=x.annual, pfreq=pfreq,
win.len1=win.len1, win.len2=win.len2, var.type=var.type,
var.unit=var.unit, main=main, xlab=xlab, ylab=ylab,
tick.tstep= tick.tstep, lab.tstep= lab.tstep, lab.fmt,
cex=cex, cex.main=cex.main, cex.lab=cex.lab, cex.axis=cex.axis, col=col[1], ...)
# Drawing an histogram of the daily, monthly and annual time series of the variable
.hydroplothist(x=x, x.monthly=x.monthly, x.annual=x.annual, pfreq=pfreq,
var.type=var.type, var.unit=var.unit, main=main, xlab=xlab, ylab=ylab,
cex=cex, cex.main=cex.main, cex.lab=cex.lab, cex.axis=cex.axis, col=col[3], ...)
} # ELSE end
else if (ptype=="ts+boxplot+hist") {
# Setting up the screen with 3 rows and 3 columns
if (pfreq == "dma") { par(mfcol=c(3,3))
} else if (pfreq %in% c("dm", "ma")) { par(mfcol=c(2,3))
} # ELSE end
# Drawing the daily, monthly and annual time series of the variable against time
.hydroplotts(x=x, x.monthly=x.monthly, x.annual=x.annual, pfreq=pfreq,
win.len1=win.len1, win.len2=win.len2, var.type=var.type,
var.unit=var.unit, main=main, xlab=xlab, ylab=ylab,
tick.tstep= tick.tstep, lab.tstep= lab.tstep, lab.fmt,
cex=cex, cex.main=cex.main, cex.lab=cex.lab, cex.axis=cex.axis, col=col[1], ...)
# Drawing a boxplot of the daily, monthly and annual time series of the variable
.hydroplotboxplot(x=x, x.monthly=x.monthly, x.annual=x.annual, pfreq=pfreq,
var.type=var.type, var.unit=var.unit, main=main, xlab=xlab, ylab=ylab,
cex=cex, cex.main=cex.main, cex.lab=cex.lab, cex.axis=cex.axis, col=col[2], ...)
# Drawing an histogram of the daily, monthly and annual time series of the variable
.hydroplothist(x=x, x.monthly=x.monthly, x.annual=x.annual, pfreq=pfreq,
var.type=var.type, var.unit=var.unit, main=main, xlab=xlab, ylab=ylab,
cex=cex, cex.main=cex.main, cex.lab=cex.lab, cex.axis=cex.axis, col=col[3], ...)
} # ELSE end
} # ELSE end (if (pfreq == "seasonal")
} # 'hydroplot.zoo end
################################################################################
# hydroplot.data.frame: Daily, Monthly and Annual plots of hydrological ts #
################################################################################
# Author : Mauricio Zambrano-Bigiarini #
################################################################################
# Started: 2008 #
# Updates: 19-Apr-2011 ; 19-Jun-2011 ; 10-Aug-2011 #
# 04-Jun-2012 #
# 04-Apr-2013 ; 29-May-2013 #
# 07-Nov-2020 #
# 23-Aug-2022 #
################################################################################
hydroplot.data.frame <- function(x,
FUN, na.rm=TRUE,
ptype="ts+boxplot+hist",
pfreq="dma",
var.type,
var.unit="units",
main=NULL, xlab="Time", ylab,
win.len1=0,
win.len2=0,
tick.tstep="auto",
lab.tstep="auto",
lab.fmt=NULL,
cex=0.3,
cex.main=1.3,
cex.lab=1.3,
cex.axis=1.3,
col=c("blue", "lightblue", "lightblue"),
from=NULL,
to=NULL,
dates=1, date.fmt = "%Y-%m-%d",
stype="default",
season.names=c("Winter", "Spring", "Summer", "Autumn"),
h=NULL, ...) {
# Checking the user provides the dates
if ( !any( class(dates) %in% c("numeric", "factor", "character", "Date" ,"POSIXct", "POSIXlt", "POSIXt") ) )
stop("Invalid argument: 'dates' must be of class 'numeric', 'factor', 'character', 'Date', 'POSIXct', 'POSIXlt', 'POSIXt'")
# If 'dates' is a number, it indicates the index of the column of 'x' that stores the dates
if ( inherits(dates, "numeric") ) {
temp <- x[, -dates]
dates <- as.Date(as.character(x[, dates]), format= date.fmt) # zoo::as.Date
x <- temp
} # IF end
# If 'dates' is a factor, it have to be converted into 'Date' class,
# using the date format specified by 'date.fmt'
if ( ( inherits(dates, "factor") ) | ( inherits(dates, "character") ) )
dates <- as.Date(dates, format= date.fmt) # zoo::as.Date
# If 'dates' is already of Date class, the following line verifies that
# the number of days in 'dates' be equal to the number of element in the
# time series corresponding to the 'sname' station
if ( ( inherits(dates, "Date") ) & (length(dates) != nrow(x) ) )
stop("Invalid argument: 'length(dates)' must be equal to 'nrow(x)'")
# converting from data.frame to zoo
x <- zoo::zoo(x, dates)
hydroplot.zoo(x, FUN=FUN, na.rm=na.rm, ptype=ptype, pfreq=pfreq,
var.type=var.type, var.unit=var.unit, main=main, xlab=xlab, ylab=ylab,
win.len1=win.len1, win.len2=win.len2, tick.tstep=tick.tstep,
lab.tstep=lab.tstep, lab.fmt=lab.fmt, cex=cex, cex.main=cex.main, cex.lab=cex.lab,
cex.axis=cex.axis, col=col, from=from, to=to, stype=stype, season.names=season.names, h=h, ...)
} # 'hydroplot.data.frame' END
Try the hydroTSM package in your browser
Any scripts or data that you put into this service are public.
hydroTSM documentation built on May 29, 2024, 8:36 a.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 hydroplot.data.frame hydroplot.zoo hydroplot.default .hydroplotseasonal .hydroplothist .hydroplotboxplot .hydroplotts hydroplot
Documented in hydroplot .hydroplotboxplot hydroplot.data.frame hydroplot.default .hydroplothist .hydroplotts hydroplot.zoo
# File hydroplot.R
# Part of the hydroTSM R package, https://github.com/hzambran/hydroTSM ;
# http://www.rforge.net/hydroTSM/ ;
# https://cran.r-project.org/package=hydroTSM
# Copyright 2008-2020 Mauricio Zambrano-Bigiarini
# Distributed under GPL 2 or later
hydroplot <-function(x, ...) UseMethod("hydroplot")
################################################################################
# .hydroplotts Daily, Monthly and Annual Time Series #
################################################################################
# Author : Mauricio Zambrano-Bigiarini #
# Started: 2008 #
# Updates: 17-Apr-2011 ; 10-Aug-2011 #
# 15-Jan-2014 #
# 06-Aug-2017 #
################################################################################
# It requires the function'drawTimeAxis' that is stored in the 'lib_Plot.R' library
# 'x' : daily time series of type 'zoo'
# 'x.monthly : monthly time series of type 'zoo'
# 'x.annual' : annual time series of type 'zoo'
# 'win.len1' : number of days for being used in the computation of the first moving average
# 'win.len2' : number of days for being used in the computation of the second moving average
# 'var.type' : string representing the type of variable being plotted (e.g., "Precipitation", "Temperature" or "Flow").
# ONLY used for labelling the y axis and the title of the plot (in case it is missing)
# 'var.unit' : string representing the measurement unit of the variable being plotted ("mm" for precipitation, "C" for temperature, and "m3/s" for flow).
# ONLY used for labelling the y axis
# 'main' : string representing the main title of the plot
# 'pfreq' : string indicating how many plots are desired by the user.
# Valid values are:
# -) 'dma': Daily, Monthly and Annual values are plotted
# -) 'ma' : Monthly and Annual values are plotted
# -) 'dm' : Daily and Monthly values are plotted
# 'tick.tstep': string indicating the time step that have to be used for
# putting the ticks ont he time axis.
# Possible values are: 'days', 'months', 'years'
# 'lab.tstep' : string indicating the time step that have to be used for
# putting the labels ont he time axis.
.hydroplotts <- function(x, x.monthly, x.annual, win.len1=0, win.len2=0,
pfreq="dma", tick.tstep= "auto", lab.tstep= "auto", lab.fmt=NULL,
var.type, var.unit="units", main=NULL, xlab="Time", ylab=NULL,
cex.main=1.3, cex.lab=1.3, cex.axis=1.3, col="blue",
lwd=1, lty=1, ...) {
# Checking that the user provied a valid class for 'x'
valid.class <- c("xts", "zoo")
if (length(which(!is.na(match(class(x), valid.class )))) <= 0)
stop("Invalid argument: 'class(x)' must be in c('xts', 'zoo')")
# Checking that 'x.monthly' is a zoo or xts object
if ( length(x.monthly) > 1 ) {
if (is.na(match(class(x.monthly), c("zoo", "xts"))))
stop("Invalid argument: 'x.monthly' must be in c('zoo', 'xts')")
} # IF end
# Checking that 'x.annual' is a zoo or xts object
if ( length(x.annual) > 1 ) {
if (is.na(match(class(x.annual), c("zoo", "xts"))))
stop("Invalid argument: 'x.annual' must be be in c('zoo', 'xts')")
} # IF end
# Checking that the user provied a valid argument for 'pfreq'
if (is.na(match(pfreq, c("o", "dma", "ma", "dm"))))
stop("Invalid argument: 'pfreq' must be in c('o', 'dma', 'ma', 'dm')")
# Valid tseps for ''tick.tstep' and 'lab.tstep'
valid.tstep <- c("auto", "years", "quarters", "months", "weeks", "days",
"hours", "minutes", "seconds")
# Checking that the user provied a valid argument for 'tick.tstep'
if (is.na(match(tick.tstep, valid.tstep ) ) )
stop("Invalid argument: 'tick.tstep' must be in c('auto', 'years', 'quarters',
'months', 'weeks', 'days', 'hours', 'minutes', 'seconds')")
# Checking that the user provied a valid argument for 'lab.tstep'
if (is.na(match(lab.tstep, valid.tstep ) ) )
stop("Invalid argument: 'lab.tstep' must be in c('auto', 'years', 'quarters',
'months', 'weeks', 'days', 'hours', 'minutes', 'seconds')")
# Requiring the Zoo Library (Zoo's ordered observations)
#require(xts)
# Booleans indicating if the moving averages for the dayly and monthly
# time series can be computed and ploted. By default they are FALSE,
# and only if the lenght(x) is large enough they are changed into TRUE
d.ma1 <- FALSE
d.ma2 <- FALSE
m.ma1 <- FALSE
m.ma2 <- FALSE
# Generating a Moving Average of the Daily time series, with a window width 'win.len1'
if (win.len1 > 0 ) { # If 'win.len1==0', the moving average is not computed
win.len <- win.len1
if (length(x) >= win.len) {
d.ma1 <- TRUE
daily.ma1 <- ma.zoo(x, win.len)
#if (!is.xts(daily.ma1)) daily.ma1 <- as.xts(daily.ma1)
}
} # IF end
# Generating a Moving Average of the Daily time series, with a window width 'win.len2'
if (win.len2 > 0 ) { # If 'win.len2==0', the moving average is not computed
win.len <- win.len2
if (length(x) >= win.len) {
d.ma2 <- TRUE
daily.ma2 <- ma.zoo(x, win.len)
#if (!is.xts(daily.ma2)) daily.ma2 <- as.xts(daily.ma2)
}
} # IF end
# Generating a Moving Average of the Monthly time series, with a window width 'win.len1'
if (win.len1 > 0 ) { # If 'win.len1==0', the moving average is not computed
win.len <- round(win.len1/365,1)*12
if (length(x.monthly) >= win.len) {
m.ma1 <- TRUE
monthly.ma1 <- ma.zoo( x.monthly, win.len ) }
} # IF end
# Generating a Moving Average of the Monthly time series, with a window width 'win.len2'
if (win.len2 > 0 ) { # If 'win.len2==0', the moving average is not computed
win.len <- round(win.len2/365,1)*12
if (length(x.monthly) >= win.len) {
m.ma2 <- TRUE
monthly.ma2 <- ma.zoo( x.monthly, win.len ) }
} # IF end
# If 'x' is not 'xts' it is transformed into one
#if ( !(is.xts(x)) ) x <- as.xts(x)
# Plotting only the original zoo or xts object, without moving averages and legends
if ( pfreq == "o") {
# Plotting the Daily Time Series
zoo::plot.zoo(x, xaxt = "n", yaxt = "n", type="o",
main=main, xlab=xlab, ylab=ylab,
cex.main=cex.main, cex.lab=cex.lab, cex.axis=cex.axis, col=col,
lty=lty, lwd=lwd, ...)
axis(2, cex.lab=1.3, cex.axis=1.3)
# Draws monthly ticks in the X axis, but labels only in years
drawTimeAxis(x, tick.tstep=tick.tstep, lab.tstep=lab.tstep, lab.fmt=lab.fmt,
cex.lab=cex.lab, cex.axis=cex.axis, ...)
# manually adding a grid
grid(nx=NA, ny=NULL)
abline(v=time(x)[axTicksByTime(x)], col = "lightgray", lty = "dotted")
} # IF end
# Plotting the Daily, if needed
if ( pfreq %in% c("dma", "dm") ) {
# Generating the title of the Daily Time Series plot
title <- paste("Daily time series", main, sep= " ")
# Plotting the Daily Time Series
# xaxt = "n": is for avoiding drawing the x axis
zoo::plot.zoo(x, xaxt = "n", yaxt = "n", type="o",
main=title, xlab=xlab, ylab=paste(ylab," [", var.unit,"/day]", sep=""),
cex.main=cex.main, cex.lab=cex.lab, cex.axis=cex.axis, col=col,
lty=lty, lwd=lwd, ...)
axis(2, cex.lab=cex.lab, cex.axis=cex.axis)
# Draws monthly ticks in the X axis, but labels only in years
drawTimeAxis(x, tick.tstep=tick.tstep, lab.tstep=lab.tstep, lab.fmt=lab.fmt,
cex.lab=cex.lab, cex.axis=cex.axis, ...)
# manually adding a grid
grid(nx=NA, ny=NULL)
abline(v=time(x)[axTicksByTime(x)], col = "lightgray", lty = "dotted")
if (d.ma1) {
# Plotting the 1st Moving Average of the Daily time series. If win.len1=365*1 => "Annual Moving Average"
lines(daily.ma1, type="o", lty=2, lwd=1, col="green", cex = .5) }
if (d.ma2) {
# Plotting the 2nd Moving Average of the Daily time series. If win.len2=365*3 => "Moving Average of 3 Years"
lines(daily.ma2, type="o", lty=3, lwd=1, col="red", cex = .5) }
# Drawing a legend. y.intersp=0.5, is for the vertical spacin in the legend
leg.text <- "Daily series"
leg.lwd <- lwd
leg.lty <- lty
leg.col <- col
if (d.ma1) {
leg.text <- c(leg.text, paste("MA(", round(win.len1/365,2), " years)", sep="") )
leg.lwd <- c(leg.lwd, 1)
leg.lty <- c(leg.lty, 2)
leg.col <- c(leg.col, "green")
} # IF end
if (d.ma2) {
leg.text <- c(leg.text, paste("MA(", round(win.len2/365,2), " years)", sep="") )
leg.lwd <- c(leg.lwd, 1)
leg.lty <- c(leg.lty, 3)
leg.col <- c(leg.col, "red")
} # IF end
legend("topleft", leg.text, bty="n", cex =0.9, col= leg.col, lwd= leg.lwd, lty=leg.lty ) #bty="n" => no box around the legend
} # IF end
# Plotting the Monthly, if needed
if ( pfreq %in% c("dma", "dm", "ma") ) {
# Generating the title of the Monthly Time Series plot
title <- paste("Monthly time series", main, sep= " ")
# Plotting the Monthly time series
zoo::plot.zoo(x.monthly, xaxt = "n", yaxt = "n", type="o",
main=title, xlab=xlab, ylab=paste(ylab," [", var.unit,"/month]", sep=""),
cex.main=cex.main, cex.lab=cex.lab, cex.axis=cex.axis, col=col,
lty=lty, lwd=lwd, ... )
axis(2, cex.lab=cex.lab, cex.axis=cex.axis)
# Draws monthly ticks in the X axis, but labels only in years
drawTimeAxis(x.monthly, tick.tstep=tick.tstep, lab.tstep=lab.tstep, lab.fmt=lab.fmt,
cex.lab=cex.lab, cex.axis=cex.axis, ...)
# manually adding a grid
grid(nx=NA, ny=NULL)
abline(v=time(x)[axTicksByTime(x.monthly)], col = "lightgray", lty = "dotted")
if (m.ma1) {
# Plotting the 1st Moving Average of the Daily time series. If win.len1=365*1 => "Annual Moving Average"
lines(monthly.ma1, type="o", lty=2, lwd=1, col="green", cex = .5) }
if (m.ma2) {
# Plotting the 2nd Moving Average of the Daily time series. If win.len2=365*3 => "Moving Average of 3 Years"
lines(monthly.ma2, type="o", lty=3, lwd=1, col="red", cex = .5) }
# Drawing a legend
leg.text <- "Monthly series"
leg.lwd <- lwd
leg.lty <- lty
leg.col <- col
if (m.ma1) {
leg.text <- c(leg.text, paste("MA(", round(win.len1/365,1), " years)", sep="") )
leg.lwd <- c(leg.lwd, 1)
leg.lty <- c(leg.lty, 2)
leg.col <- c(leg.col, "green")
} # IF end
if (m.ma2) {
leg.text <- c(leg.text, paste("MA(", round(win.len2/365,1), " years)", sep="") )
leg.lwd <- c(leg.lwd, 1)
leg.lty <- c(leg.lty, 3)
leg.col <- c(leg.col, "red")
} # IF end
legend("topleft", leg.text, bty="n", cex =0.9, col= leg.col, lwd= leg.lwd, lty=leg.lty ) #bty="n" => no box around the legend
} # IF end
# Plotting the Annual, if needed
if ( pfreq %in% c("dma", "ma") ) {
# Generating the title of the Annual Time Series plot
title <- paste("Annual time series", main, sep= " ")
# Plotting the Annual time series
zoo::plot.zoo(x.annual, xaxt = "n", yaxt = "n", type="o",
main=title, xlab="Time", ylab=paste(ylab," [", var.unit,"/year]", sep=""),
cex.main=cex.main, cex.lab=cex.lab, cex.axis=cex.axis, col=col,
lty=lty, lwd=lwd, ...)
axis(2, cex.lab=cex.lab, cex.axis=cex.axis)
# Draws monthly ticks in the X axis, but labels only in years
drawTimeAxis(x.annual, tick.tstep="years", lab.tstep="years", lab.fmt="%Y",
cex.lab=cex.lab, cex.axis=cex.axis, ...)
# manually adding a grid
grid(nx=NA, ny=NULL)
abline(v=time(x)[axTicksByTime(x.annual)], col = "lightgray", lty = "dotted")
} # IF end
} # '.hydroplotts' end
################################################################################
# BoxPlot of Daily, Monthly and Annual Time Serires #
################################################################################
# Author : Mauricio Zambrano-Bigiarini #
################################################################################
# Started: 2008 #
# Updates: 17-Apr-2011 #
# 29-May-2013 #
################################################################################
# 'x' : daily time series of type 'zoo'
# 'x.monthly : monthly time series of type 'zoo'
# 'x.annual' : annual time series of type 'zoo'
# 'var.type' : string representing the type of variable being plotted
# (e.g., "Precipitation", "Temperature" or "Flow").
# ONLY used for labelling the y axis and the title of the plot (in case it is missing)
# 'var.unit' : string representing the measurement unit of the variable
# being plotted ("mm" for precipitation, "C" for temperature, and "m3/s" for flow).
# ONLY used for labelling the y axis
# 'main' : string representing the main title of the plot
# 'pfreq' : string indicating how many plots are desired by the user.
# Valid values are:
# -) 'dma': Daily, Monthly and Annual values are plotted
# -) 'dm' : Daily and Monthly values are plotted
# -) 'ma' : Monthly and Annual values are plotted
#
.hydroplotboxplot <- function(x, x.monthly, x.annual, pfreq="dma",
var.type, var.unit="units",
main=NULL, xlab=NULL, ylab=NULL,
cex.main=1.3, cex.lab=1.3, cex.axis=1.3,
col="lightblue",
...
) {
# Checking that 'x' is a zoo or xts object
if (is.na(match(class(x), c("zoo", "xts"))))
stop("Invalid argument: 'class(x)' must be in c('zoo', 'xts')")
# Checking that 'x.monthly' is a zoo object
if (is.na(match(class(x.monthly), c("zoo", "xts"))))
stop("Invalid argument: 'class(x.monthly)' must be in c('zoo', 'xts')")
# Checking that 'x.annual' is a zoo object
if (is.na(match(class(x.annual), c("zoo", "xts"))))
stop("Invalid argument: 'class(x.annual)' must be in c('zoo', 'xts')")
# Checking that the user provied a valid argument for 'pfreq'
if (is.na(match(pfreq, c("dma", "ma", "dm"))))
stop("Invalid argument: 'pfreq' must be in c('dma', 'ma', 'dm')")
# Checking if the Daily Boxplot have to be plotted
if ( pfreq %in% c("dma", "dm") ) {
# Generating a factor based on the year in which each daily date falls
cyear <- format(time(x), "%Y")
years <- factor(cyear, levels=unique(cyear), ordered=TRUE)
# Generating the title of the Daily plot
title <- paste("Daily Boxplot", main, sep= " ")
# Drawing boxplot of Daily values against Year
boxplot( coredata(x)~years, main=title, ylab=paste(ylab," [", var.unit, "/day]", sep=""),
cex.main=cex.main, cex.lab=cex.lab, cex.axis=cex.axis, col=col, ...)
} # IF end
# Checking if the Monthly Boxplot have to be plotted
if ( pfreq %in% c("dma", "dm", "ma") ) {
# Generating a factor based on the month in which each monthly date falls
cmonth <- format(time(x.monthly), "%b")
months <- factor(cmonth, levels=unique(cmonth), ordered=TRUE)
# Generating the title of the Monthly plot
title <- paste("Monthly Boxplot", main, sep= " ")
# Drawing boxplot of Monthly values against Year
boxplot( coredata(x.monthly)~months, main=title, ylab=paste(ylab," [", var.unit,"/month]", sep=""),
cex.main=cex.main, cex.lab=cex.lab, cex.axis=cex.axis, col=col, ...)
} # IF end
# Checking if the Annual Boxplot have to be plotted
if ( pfreq %in% c("dma", "ma") ) {
# Generating the title of the Annual plot
title <- paste("Annual Boxplot", main, sep= " ")
# Drawing boxplot of Annual values against Year
boxplot( coredata(x.annual), main=title, ylab=paste(ylab," [", var.unit, "/year]", sep=""),
cex.main=cex.main, cex.lab=cex.lab, cex.axis=cex.axis, col=col, ...)
} # IF end
} #'.hydroplotboxplot' end
################################################################################
# Histogram of Daily, Monthly and Annual Time Serires #
################################################################################
# Author : Mauricio Zambrano-Bigiarini #
################################################################################
# Started: 2008 #
# Updates: 17-Apr-2011 #
# 29-May-2013 #
################################################################################
# 'x' : daily time series of type 'zoo'
# 'x.monthly : monthly time series of type 'zoo'
# 'x.annual' : annual time series of type 'zoo'
# 'var.type' : string representing the type of variable being plotted (e.g., "Precipitation", "Temperature" or "Flow").
# ONLY used for labelling the y axis and the title of the plot (in case it is missing)
# 'var.unit' : string representing the measurement unit of the variable being plotted ("mm" for precipitation, "C" for temperature, and "m3/s" for flow).
# ONLY used for labelling the x axis
# 'main' : string representing the main title of the plot
# 'pfreq' : string indicating how many plots are desired by the user.
# Valid values are:
# -) 'dma': Daily, Monthly and Annual values are plotted
# -) 'ma' : Monthly and Annual values are plotted
# -) 'dm' : Daily and Monthly values are plotted
.hydroplothist <- function(x, x.monthly, x.annual, pfreq="dma",
var.type, var.unit="units",
main=NULL, xlab=NULL, ylab=NULL,
cex.main=1.3, cex.lab=1.3, cex.axis=1.3, col="lightblue",
...
) {
# Checking that 'x' is a zoo or xts object
if (is.na(match(class(x), c("zoo", "xts"))))
stop("Invalid argument: 'class(x)' must be in c('zoo', 'xts')")
# Checking that 'x.monthly' is a zoo object
if (is.na(match(class(x.monthly), c("zoo", "xts"))))
stop("Invalid argument: 'class(x.monthly)' must be in c('zoo', 'xts')")
# Checking that 'x.annual' is a zoo object
if (is.na(match(class(x.annual), c("zoo", "xts"))))
stop("Invalid argument: 'class(x.annual)' must be in c('zoo', 'xts')")
# Checking that the user provied a valid argument for 'pfreq'
if (is.na(match(pfreq, c("dma", "ma", "dm"))))
stop("Invalid argument: 'pfreq' must be in c('dma', 'ma', 'dm')")
# Checking if the Daily ts have to be plotted
if ( pfreq %in% c("dma", "dm") ) {
# Generating the title of the Daily plot
title <- paste("Daily Histogram", main, sep= " ")
# Drawing an histogram of Daily Precipitation
hist(x, br=100, freq=FALSE, main=title, xlab=paste(ylab," [", var.unit, "/day]", sep=""),
ylab="Pbb", cex.main=cex.main, cex.lab=cex.lab, cex.axis=cex.axis, col=col, ...)
} # IF end
# Checking if the Monthly ts have to be plotted
if ( pfreq %in% c("dma", "dm", "ma") ) {
# Generating the title of the Monthly plot
title <- paste("Monthly Histogram", main, sep= " ")
# Drawing an histogram of Monthly Precipitation
hist(x.monthly, br=10, freq=FALSE, main=title, xlab=paste(ylab," [", var.unit, "/month]", sep=""),
ylab="Pbb", cex.main=cex.main, cex.lab=cex.lab, cex.axis=cex.axis, col=col, ...)
} # IF end
# Checking if the Annual ts have to be plotted
if ( pfreq %in% c("dma", "ma") ) {
# Generating the title of the Annual plot
title <- paste("Annual Histogram", main, sep= " ")
# Drawing an histogram of Annual Precipitation
hist(x.annual, br=5, freq=FALSE, main=title, xlab=paste(ylab," [", var.unit, "/year]", sep=""),
ylab="Pbb", cex.main=cex.main, cex.lab=cex.lab, cex.axis=cex.axis, col=col, ...)
} # IF end
} # '.hydroplothist' end
#########################################################################
# hydroplotseasonal: Seasonal plots of hydrological time series #
#########################################################################
# Author : Mauricio Zambrano-Bigiarini #
# Started: 19-Jun-2011 #
# Updates: 10-Aug-2011 #
# 06-Aug-2017 #
#########################################################################
.hydroplotseasonal <- function(x, FUN, na.rm=TRUE,
tick.tstep= "auto", lab.tstep= "auto", lab.fmt=NULL,
var.unit="units", main=NULL, xlab="Time", ylab=NULL,
cex.main=1.3, cex.lab=1.3, cex.axis=1.3, col="blue",
lwd=1, lty=1, stype="default",
season.names=c("Winter", "Spring", "Summer", "Autumn"),
h=NULL, ...) {
# checking the class of 'x'
if (!is.zoo(x))
stop("Invalid argument: 'class(x)' must be in c('zoo', 'xts')")
# Valid tseps for ''tick.tstep' and 'lab.tstep'
valid.tstep <- c("auto", "years", "quarters", "months", "weeks", "days",
"hours", "minutes", "seconds")
# Checking that the user provied a valid argument for 'tick.tstep'
if (is.na(match(tick.tstep, valid.tstep ) ) )
stop("Invalid argument: 'tick.tstep' must be in c('auto', 'years', 'quarters',
'months', 'weeks', 'days', 'hours', 'minutes', 'seconds')")
# Checking that the user provied a valid argument for 'lab.tstep'
if (is.na(match(lab.tstep, valid.tstep ) ) )
stop("Invalid argument: 'lab.tstep' must be in c('auto', 'years', 'quarters',
'months', 'weeks', 'days', 'hours', 'minutes', 'seconds')")
# Checking that the user provied a valid value for 'stype'
valid.types <- c("default", "FrenchPolynesia")
if (length(which(!is.na(match(stype, valid.types )))) <= 0)
stop("Invalid argument: 'stype' must be in c('default', 'FrenchPolynesia')")
# Checking that the user provied a valid argument for 'season.names'
if ( length(season.names) != 4 )
stop("Invalid argument: 'season.names' must have 4 elements !")
# Checking the length of x
if ( sfreq(x) == "daily" ) {
if (length(x) < 365 )
stop("Invalid argument: daily time series need -at least- 365 values !")
} else if ( sfreq(x) == "monthly" ) {
if (length(x) < 12 )
stop("Invalid argument: monthly time series need -at least- 12 values !")
} else if ( sfreq(x) == "annual" )
stop("Invalid argument: seasonal plots can not be drawn for annual time series !")
# Labels for the seasons
if (stype=="default") {
seasons.lab <- c("DJF", "MAM", "JJA", "SON")
} else if (stype=="FrenchPolynesia") {
seasons.lab <- c("DJFM", "AM", "JJAS", "ON")
} # ELSE end
# Computing the seasonal values
winter <- dm2seasonal(x, season=seasons.lab[1], FUN=FUN, out.fmt="%Y-%m-%d")
spring <- dm2seasonal(x, season=seasons.lab[2], FUN=FUN, out.fmt="%Y-%m-%d")
summer <- dm2seasonal(x, season=seasons.lab[3], FUN=FUN, out.fmt="%Y-%m-%d")
autumm <- dm2seasonal(x, season=seasons.lab[4], FUN=FUN, out.fmt="%Y-%m-%d")
# Transforming the seasonal values into xts objects
#winter <- as.xts(winter)
#spring <- as.xts(spring)
#summer <- as.xts(summer)
#autumm <- as.xts(autumm)
#################################
# Plotting seasonal time series #
#################################
def.par <- par(no.readonly = TRUE) # save default, for resetting...
on.exit(par(def.par))
layout( matrix( c(1,1,1,1,1,1,1,1,1,5,5,2,2,2,2,2,2,2,2,2,6,6,3,3,3,3,3,3,3,3,3,7,7,4,4,4,4,4,4,4,4,4,8,8), ncol=11, byrow=TRUE) )
if (length(h)==1) h <- rep(h,4)
# winter
zoo::plot.zoo(winter, xaxt = "n", yaxt = "n", type="o",
main=paste(season.names[1], " (", seasons.lab[1], ")", sep=""), xlab=xlab, ylab=ylab,
cex.main=cex.main, cex.lab=cex.lab, cex.axis=cex.axis, col=col,
lty=lty, lwd=lwd, ...)
axis(2, cex.lab=1.3, cex.axis=1.3)
drawTimeAxis(winter, tick.tstep=tick.tstep, lab.tstep=lab.tstep, lab.fmt=lab.fmt,
cex.lab=cex.lab, cex.axis=cex.axis, ...)
abline(h=h[1], col="red", lty=2)
# manually adding a grid
grid(nx=NA, ny=NULL)
abline(v=time(x)[axTicksByTime(winter)], col = "lightgray", lty = "dotted")
# spring
zoo::plot.zoo(spring, xaxt = "n", yaxt = "n", type="o",
main=paste(season.names[2], " (", seasons.lab[2], ")", sep=""), xlab=xlab, ylab=ylab,
cex.main=cex.main, cex.lab=cex.lab, cex.axis=cex.axis, col=col,
lty=lty, lwd=lwd, ...)
axis(2, cex.lab=1.3, cex.axis=1.3)
drawTimeAxis(spring, tick.tstep=tick.tstep, lab.tstep=lab.tstep, lab.fmt=lab.fmt,
cex.lab=cex.lab, cex.axis=cex.axis, ...)
abline(h=h[2], col="red", lty=2)
# manually adding a grid
grid(nx=NA, ny=NULL)
abline(v=time(x)[axTicksByTime(spring)], col = "lightgray", lty = "dotted")
# summer
zoo::plot.zoo(summer, xaxt = "n", yaxt = "n", type="o",
main=paste(season.names[3], " (", seasons.lab[3], ")", sep=""), xlab=xlab, ylab=ylab,
cex.main=cex.main, cex.lab=cex.lab, cex.axis=cex.axis, col=col,
lty=lty, lwd=lwd, ...)
axis(2, cex.lab=1.3, cex.axis=1.3)
drawTimeAxis(summer, tick.tstep=tick.tstep, lab.tstep=lab.tstep, lab.fmt=lab.fmt,
cex.lab=cex.lab, cex.axis=cex.axis, ...)
abline(h=h[3], col="red", lty=2)
# manually adding a grid
grid(nx=NA, ny=NULL)
abline(v=time(x)[axTicksByTime(summer)], col = "lightgray", lty = "dotted")
# autumm
zoo::plot.zoo(autumm, xaxt = "n", yaxt = "n", type="o",
main=paste(season.names[4], " (", seasons.lab[4], ")", sep=""), xlab=xlab, ylab=ylab,
cex.main=cex.main, cex.lab=cex.lab, cex.axis=cex.axis, col=col,
lty=lty, lwd=lwd, ...)
axis(2, cex.lab=1.3, cex.axis=1.3)
drawTimeAxis(autumm, tick.tstep=tick.tstep, lab.tstep=lab.tstep, lab.fmt=lab.fmt,
cex.lab=cex.lab, cex.axis=cex.axis, ...)
abline(h=h[4], col="red", lty=2)
# manually adding a grid
grid(nx=NA, ny=NULL)
abline(v=time(x)[axTicksByTime(autumm)], col = "lightgray", lty = "dotted")
#################################
# Plotting seasonal boxplots #
#################################
boxplot(coredata(winter), col= "lightblue", ylab = ylab,
main = paste(season.names[1], " (", seasons.lab[1], ")", sep=""),
pars=list(cex.main=cex.main, cex.lab=cex.lab, cex.axis=cex.axis))
abline(h=h[1], col="red", lty=2)
boxplot(coredata(spring), col= "lightblue", ylab = ylab,
main = paste(season.names[2], " (", seasons.lab[2], ")", sep=""),
pars=list(cex.main=cex.main, cex.lab=cex.lab, cex.axis=cex.axis))
abline(h=h[2], col="red", lty=2)
boxplot(coredata(summer), col= "lightblue", ylab = ylab,
main = paste(season.names[3], " (", seasons.lab[3], ")", sep=""),
pars=list(cex.main=cex.main, cex.lab=cex.lab, cex.axis=cex.axis))
abline(h=h[3], col="red", lty=2)
boxplot(coredata(autumm), col= "lightblue", ylab = ylab,
main = paste(season.names[4], " (", seasons.lab[4], ")", sep=""),
pars=list(cex.main=cex.main, cex.lab=cex.lab, cex.axis=cex.axis))
abline(h=h[4], col="red", lty=2)
} # .hydroplotseasonal END
################################################################################
# hydroplot.zoo: Daily, Monthly and Annual plots of hydrological time series #
################################################################################
# Author : Mauricio Zambrano-Bigiarini #
################################################################################
# Started: 2008 #
# Updates: 19-Apr-2011 ; 19-Jun-2011 ; 10-Aug-2011 #
# 04-Jun-2012 #
# 04-Apr-2013 ; 29-May-2013 #
# 07-Nov-2020 #
################################################################################
hydroplot.default <- function(x,
FUN, na.rm=TRUE,
ptype="ts+boxplot+hist",
pfreq="dma",
var.type,
var.unit="units",
main=NULL, xlab="Time", ylab,
win.len1=0,
win.len2=0,
tick.tstep="auto",
lab.tstep="auto",
lab.fmt=NULL,
cex=0.3,
cex.main=1.3,
cex.lab=1.3,
cex.axis=1.3,
col=c("blue", "lightblue", "lightblue"),
from=NULL,
to=NULL,
dates=1, date.fmt = "%Y-%m-%d",
stype="default",
season.names=c("Winter", "Spring", "Summer", "Autumn"),
h=NULL, ...) {
# Checking that 'x' is a zoo object
if ( !is.zoo(x) ) stop("Invalid argument: 'class(x)' must be in c('zoo', 'xts')")
hydroplot.zoo(x, FUN=FUN, na.rm=na.rm, ptype=ptype, pfreq=pfreq,
var.type=var.type, var.unit=var.unit, main=main, xlab=xlab, ylab=ylab,
win.len1=win.len1, win.len2=win.len2, tick.tstep=tick.tstep,
lab.tstep=lab.tstep, lab.fmt=lab.fmt, cex=cex, cex.main=cex.main, cex.lab=cex.lab,
cex.axis=cex.axis, col=col, from=from, to=to, stype=stype, season.names=season.names, h=h, ...)
} # 'hydroplot.default' end
################################################################################
# hydroplot.zoo: Daily, Monthly and Annual plots of hydrological time series #
################################################################################
# Author : Mauricio Zambrano-Bigiarini #
################################################################################
# Started: 2008 #
# Updates: 19-Apr-2011 ; 19-Jun-2011 ; 10-Aug-2011 #
# 04-Jun-2012 #
# 04-Apr-2013 ; 29-May-2013 #
# 07-Nov-2020 #
################################################################################
# 9 plots:
# 1: Line plot with Daily time series, with 2 moving averages, specified by 'win.len1' and 'win.len2'
# 2: Line plot with Monthly time series, with 2 moving averages, specified by 'win.len1' and 'win.len2'
# 3: Line plot with Annual time series
# 4: Boxplot with daily time series
# 5: Boxplot with monthly time series
# 6: Boxplot with annual time series
# 7: Histogram of the daily time series
# 8: Histogram of the monthly time series
# 9: Histogram of the annual time series
hydroplot.zoo <- function(x,
FUN, na.rm=TRUE,
ptype="ts+boxplot+hist",
pfreq="dma",
var.type,
var.unit="units",
main=NULL, xlab="Time", ylab,
win.len1=0,
win.len2=0,
tick.tstep="auto",
lab.tstep="auto",
lab.fmt=NULL,
cex=0.3,
cex.main=1.3,
cex.lab=1.3,
cex.axis=1.3,
col=c("blue", "lightblue", "lightblue"),
from=NULL,
to=NULL,
dates=1, date.fmt = "%Y-%m-%d",
stype="default",
season.names=c("Winter", "Spring", "Summer", "Autumn"),
h=NULL, ...) {
# Checking that the user provied a valid class for 'x'
if (!is.zoo(x))
stop("Invalid argument: 'class(x)' must be in c('xts', 'zoo')")
# 'xname' value
xname <- deparse(substitute(x))
# 'ylab' value
if ( missing(ylab) ) {
ylab <- xname
} else if ( is.null(ylab) ) ylab <- xname
# Checking that the user provied a valid argument for 'ptype'
if (is.na(match(ptype, c("ts", "ts+boxplot", "ts+hist", "ts+boxplot+hist"))))
stop("Invalid argument: 'ptype' must be in c('ts', 'ts+boxplot', 'ts+hist', 'ts+boxplot+hist')")
# Checking that the user provied a valid argument for 'pfreq'
if ( sfreq(x) == "daily" ) {
if (is.na(match(pfreq, c("o", "dma", "dm", "ma", "seasonal"))))
stop("Invalid argument: 'pfreq' must be in c('o', 'dma', 'ma', 'dm', 'seasonal')")
} else if ( sfreq(x) == "monthly" ) {
if (is.na(match(pfreq, c("ma", "seasonal")))) {
message("[Warning: 'x' is a monthly object, so 'pfreq' has been changed to 'ma']")
pfreq <- "ma"
}
} # ELSE end
if ( (pfreq == "o") & (ptype != "ts") ) {
message(paste("[Note: pfreq='o' => ptype has been changed to 'ts']" , sep="") )
ptype <- "ts"
} # IF end
# Checking that the user provied a valid argument for 'var.type'
if (missing(FUN) & (pfreq != "o") ) {
# If the user did not provide a title for the plots, this is created automatically
if (missing(var.type)) {
stop("Missing argument: 'var.type' OR 'FUN' must be provided")
} else # If 'var.type' is provided
# Checking that the user provied a valid argument for 'var.type'
if (is.na(match(var.type, c("Precipitation", "Temperature", "Flow") ) ) ) {
stop("Invalid argument: 'var.type' must be in c('Precipitation', 'Temperature', 'Flow')")
} else {
if (var.type=="Precipitation") {
FUN <- sum
if (missing(var.unit)) { var.unit <- "mm" }
} else if (var.type=="Temperature") {
FUN <- mean
if (missing(var.unit)) { var.unit <- "dC" }
} else if (var.type=="Flow") {
FUN <- mean
if (missing(var.unit)) { var.unit= "m3/s" }
}
} #ELSE end
} # IF end
##########################################
## In case 'from' and 'to' are provided ##
dates <- time(x)
ndates <- length(dates)
# Checking the validity of the 'from' argument
if (!is.null(from)) {
from <- as.Date(from, format=date.fmt)
if ( !(from %in% dates) ) {
stop("Invalid argument: 'from' is not in 'dates' ")
} else x <- window(x, start=from)
} # IF end
# Checking the validity of the 'to' argument
if (!is.null(to)) {
to <- as.Date(to, format=date.fmt)
if ( !(from %in% dates) ) {
stop("Invalid argument: 'to' is not in 'dates' ")
} else x <- window(x, end=to)
} # IF end
#################
# Assigning a dummy value to FUN, which is not used when pfreq="o"
if (pfreq == "o") FUN <- mean
def.par <- par(no.readonly = TRUE) # save default, for resetting...
on.exit(par(def.par))
# IF the user wants SEASONAL plots
if (pfreq == "seasonal") {
# Checking that the user provied a valid value for 'stype'
valid.types <- c("default", "FrenchPolynesia")
if (length(which(!is.na(match(stype, valid.types )))) <= 0)
stop("Invalid argument: 'stype' must be in c('default', 'FrenchPolynesia')")
# Checking that the user provied a valid argument for 'season.names'
if ( length(season.names) != 4 )
stop("Invalid argument: 'season.names' must have 4 elements !")
if (!missing(ptype)) {
if ( ptype != "ts+boxplot") {
message("[Note: 'pfreq=seasonal' => 'ptype' has been changed to 'ts+boxplot']")
ptype <- "ts+boxplot"
} # IF end
} # IF end
if ( lab.tstep != "auto" ) {
if ( lab.tstep != "years" ) {
message("[Note: 'pfreq=seasonal' => 'lab.tstep' has been changed to 'years']")
lab.tstep <- "years"
} # IF end
} else lab.tstep <- "years"
if ( !is.null(lab.fmt) ) {
if ( lab.fmt != "%Y" ) {
message("[Note: 'pfreq=seasonal' => 'lab.fmt' has been changed to '%Y']")
lab.fmt <- "%Y"
} # IF end
} else lab.fmt <- "%Y"
.hydroplotseasonal(x=x, FUN=FUN, na.rm=na.rm, tick.tstep= tick.tstep,
lab.tstep= lab.tstep, lab.fmt=lab.fmt, var.unit=var.unit,
main=main, xlab=xlab, ylab=ylab, cex.main=cex.main,
cex.lab=cex.lab, cex.axis=cex.axis, col=col,
stype=stype, season.names=season.names, h=h, ...)
} else {
if (pfreq != "o") {
# If 'x' is too short for plotting annual values, 'pfreq' is automatically changed
if ( ( (sfreq(x) == "daily") & ( length(x) <= 366 ) ) |
( (sfreq(x) == "monthly") & ( length(x) <= 12 ) ) ) {
if ( pfreq %in% c("dma", "ma") ) {
if (pfreq == "dma") pfreq <- "dm"
if (pfreq == "ma") pfreq <- "m"
message(paste("[Warning: your ts is too short for plotting annual time series => 'pfreq'= ", pfreq, "]", sep="") )
}
} # IF end
# Computing the monthly time series
if ( sfreq(x) == "daily" ) {
x.monthly <- daily2monthly(x, FUN=FUN, na.rm=na.rm)
} else if ( sfreq(x) == "monthly" ) {
x.monthly <- x
} else x.monthly <- NA
# Computing the annual time series
if ( !is.na( match( sfreq(x), c("daily", "monthly") ) ) ) {
x.annual <- daily2annual(x, FUN=FUN, na.rm=na.rm, out.fmt="%Y-%m-%d")
} else if ( sfreq(x) == "annual" ) {
x.annual <- x
} else x.annual <- NA
} else {
x.monthly <- NA
x.annual <- NA
} # ELSE end
if (ptype=="ts") {
# Setting up the screen with 3 rows and 3 columns
if (pfreq == "o") {
par(mfcol=c(1,1))
} else if (pfreq == "dma") {
par(mfcol=c(3,1))
} else if (pfreq %in% c("dm", "ma")) {
par(mfcol=c(2,1))
} # ELSE end
# Drawing the daily, monthly and annual time series of the variable against time
.hydroplotts(x=x, x.monthly=x.monthly, x.annual=x.annual, pfreq=pfreq,
win.len1=win.len1, win.len2=win.len2, var.type=var.type,
var.unit=var.unit, main=main, xlab=xlab, ylab=ylab,
tick.tstep= tick.tstep, lab.tstep= lab.tstep, lab.fmt,
cex=cex, cex.main=cex.main, cex.lab=cex.lab, cex.axis=cex.axis, col=col[1], ...)
} # IF end
else if ( (ptype=="ts+boxplot") & (pfreq != "seasonal") ) {
# Setting up the screen with 3 rows and 3 columns
if (pfreq == "dma") { par(mfcol=c(3,2))
} else if (pfreq %in% c("dm", "ma")) { par(mfcol=c(2,2))
} # ELSE end
# Drawing the daily, monthly and annual time series of the variable against time
.hydroplotts(x=x, x.monthly=x.monthly, x.annual=x.annual, pfreq=pfreq,
win.len1=win.len1, win.len2=win.len2, var.type=var.type,
var.unit=var.unit, main=main, xlab=xlab, ylab=ylab,
tick.tstep= tick.tstep, lab.tstep= lab.tstep, lab.fmt,
cex=cex, cex.main=cex.main, cex.lab=cex.lab, cex.axis=cex.axis, col=col[1], ...)
# Drawing a boxplot of the daily, monthly and annual time series of the variable
.hydroplotboxplot(x=x, x.monthly=x.monthly, x.annual=x.annual, pfreq=pfreq,
var.type=var.type, var.unit=var.unit, main=main, xlab=xlab, ylab=ylab,
cex=cex, cex.main=cex.main, cex.lab=cex.lab, cex.axis=cex.axis, col=col[2], ...)
} # ELSE end
else if (ptype=="ts+hist") {
# Setting up the screen with 3 rows and 3 columns
if (pfreq == "dma") { par(mfcol=c(3,2))
} else if (pfreq %in% c("dm", "ma")) { par(mfcol=c(2,2))
} # ELSE end
# Drawing the daily, monthly and annual time series of the variable against time
.hydroplotts(x=x, x.monthly=x.monthly, x.annual=x.annual, pfreq=pfreq,
win.len1=win.len1, win.len2=win.len2, var.type=var.type,
var.unit=var.unit, main=main, xlab=xlab, ylab=ylab,
tick.tstep= tick.tstep, lab.tstep= lab.tstep, lab.fmt,
cex=cex, cex.main=cex.main, cex.lab=cex.lab, cex.axis=cex.axis, col=col[1], ...)
# Drawing an histogram of the daily, monthly and annual time series of the variable
.hydroplothist(x=x, x.monthly=x.monthly, x.annual=x.annual, pfreq=pfreq,
var.type=var.type, var.unit=var.unit, main=main, xlab=xlab, ylab=ylab,
cex=cex, cex.main=cex.main, cex.lab=cex.lab, cex.axis=cex.axis, col=col[3], ...)
} # ELSE end
else if (ptype=="ts+boxplot+hist") {
# Setting up the screen with 3 rows and 3 columns
if (pfreq == "dma") { par(mfcol=c(3,3))
} else if (pfreq %in% c("dm", "ma")) { par(mfcol=c(2,3))
} # ELSE end
# Drawing the daily, monthly and annual time series of the variable against time
.hydroplotts(x=x, x.monthly=x.monthly, x.annual=x.annual, pfreq=pfreq,
win.len1=win.len1, win.len2=win.len2, var.type=var.type,
var.unit=var.unit, main=main, xlab=xlab, ylab=ylab,
tick.tstep= tick.tstep, lab.tstep= lab.tstep, lab.fmt,
cex=cex, cex.main=cex.main, cex.lab=cex.lab, cex.axis=cex.axis, col=col[1], ...)
# Drawing a boxplot of the daily, monthly and annual time series of the variable
.hydroplotboxplot(x=x, x.monthly=x.monthly, x.annual=x.annual, pfreq=pfreq,
var.type=var.type, var.unit=var.unit, main=main, xlab=xlab, ylab=ylab,
cex=cex, cex.main=cex.main, cex.lab=cex.lab, cex.axis=cex.axis, col=col[2], ...)
# Drawing an histogram of the daily, monthly and annual time series of the variable
.hydroplothist(x=x, x.monthly=x.monthly, x.annual=x.annual, pfreq=pfreq,
var.type=var.type, var.unit=var.unit, main=main, xlab=xlab, ylab=ylab,
cex=cex, cex.main=cex.main, cex.lab=cex.lab, cex.axis=cex.axis, col=col[3], ...)
} # ELSE end
} # ELSE end (if (pfreq == "seasonal")
} # 'hydroplot.zoo end
################################################################################
# hydroplot.data.frame: Daily, Monthly and Annual plots of hydrological ts #
################################################################################
# Author : Mauricio Zambrano-Bigiarini #
################################################################################
# Started: 2008 #
# Updates: 19-Apr-2011 ; 19-Jun-2011 ; 10-Aug-2011 #
# 04-Jun-2012 #
# 04-Apr-2013 ; 29-May-2013 #
# 07-Nov-2020 #
# 23-Aug-2022 #
################################################################################
hydroplot.data.frame <- function(x,
FUN, na.rm=TRUE,
ptype="ts+boxplot+hist",
pfreq="dma",
var.type,
var.unit="units",
main=NULL, xlab="Time", ylab,
win.len1=0,
win.len2=0,
tick.tstep="auto",
lab.tstep="auto",
lab.fmt=NULL,
cex=0.3,
cex.main=1.3,
cex.lab=1.3,
cex.axis=1.3,
col=c("blue", "lightblue", "lightblue"),
from=NULL,
to=NULL,
dates=1, date.fmt = "%Y-%m-%d",
stype="default",
season.names=c("Winter", "Spring", "Summer", "Autumn"),
h=NULL, ...) {
# Checking the user provides the dates
if ( !any( class(dates) %in% c("numeric", "factor", "character", "Date" ,"POSIXct", "POSIXlt", "POSIXt") ) )
stop("Invalid argument: 'dates' must be of class 'numeric', 'factor', 'character', 'Date', 'POSIXct', 'POSIXlt', 'POSIXt'")
# If 'dates' is a number, it indicates the index of the column of 'x' that stores the dates
if ( inherits(dates, "numeric") ) {
temp <- x[, -dates]
dates <- as.Date(as.character(x[, dates]), format= date.fmt) # zoo::as.Date
x <- temp
} # IF end
# If 'dates' is a factor, it have to be converted into 'Date' class,
# using the date format specified by 'date.fmt'
if ( ( inherits(dates, "factor") ) | ( inherits(dates, "character") ) )
dates <- as.Date(dates, format= date.fmt) # zoo::as.Date
# If 'dates' is already of Date class, the following line verifies that
# the number of days in 'dates' be equal to the number of element in the
# time series corresponding to the 'sname' station
if ( ( inherits(dates, "Date") ) & (length(dates) != nrow(x) ) )
stop("Invalid argument: 'length(dates)' must be equal to 'nrow(x)'")
# converting from data.frame to zoo
x <- zoo::zoo(x, dates)
hydroplot.zoo(x, FUN=FUN, na.rm=na.rm, ptype=ptype, pfreq=pfreq,
var.type=var.type, var.unit=var.unit, main=main, xlab=xlab, ylab=ylab,
win.len1=win.len1, win.len2=win.len2, tick.tstep=tick.tstep,
lab.tstep=lab.tstep, lab.fmt=lab.fmt, cex=cex, cex.main=cex.main, cex.lab=cex.lab,
cex.axis=cex.axis, col=col, from=from, to=to, stype=stype, season.names=season.names, h=h, ...)
} # 'hydroplot.data.frame' END
Try the hydroTSM package in your browser
Any scripts or data that you put into this service are public.
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.