# File dwdays.R
# Part of the hydroTSM R package, https://github.com/hzambran/hydroTSM ;
# https://CRAN.R-project.org/package=hydroTSM
# Copyright 2010-2017 Mauricio Zambrano-Bigiarini
# Distributed under GPL 2 or later
################################################################################
# dwdays: average amount of dry/wet days per each month #
################################################################################
# Author : Mauricio Zambrano-Bigiarini #
################################################################################
# Started: 24-Jan-2010 #
# Updates: 29-May-2013 #
# 23-Aug-2022 #
################################################################################
# Given a daily time series of precipitation, this function computes the average amount
# of dry/wet days (pcp > thr or pcp < thr for wet and dry days, respectively) on each month
# 'x' : zoo. Daily time series of precipitation.
# 'thr': numeric. Value of daily precipitation used as threshold for classifying a day as dry/wet or not.
# Days with a precipitation value larger or equal to 'thr' are classified as 'wet days',
# whereas precipitation values lower or equal to 'thr' are classified as 'dry days'
# 'type': character, indicating if the daily values have to be calssified as dry or wet days. It works liked to the values specified in 'thr'. Valid values aer c('wet', dry')
dwdays <-function(x, ...) UseMethod("dwdays")
dwdays.default <- function(x, thr=0, type="wet", na.rm=TRUE, ... ) {
# Checking the user provide a valid value for 'x'
if ( !inherits(x, "zoo") )
stop("Invalid argument: 'x' must be of class 'zoo'")
# Checking the user provide a valid value for 'x'
if (is.na(match(sfreq(x), c("daily")))) {
stop(paste("Invalid argument: 'x' is not a daily ts, it is a ", sfreq(x), " ts", sep="") ) }
# Checking the user provide a valid value for 'type'
if ( is.na(match(type, c("dry", "wet"))) )
stop("Invalid argument: 'type' must be in c('dry', 'wet'")
# getting the dates of 'x'
dates <- time(x)
# Computing the Starting and Ending Year of the analysis
Starting.Year <- as.numeric(format(range(dates)[1], "%Y"))
Ending.Year <- as.numeric(format(range(dates)[2], "%Y"))
# Total amount of Years of 'x'
nyears <- Ending.Year - Starting.Year + 1
# Array with the average monthly amount of wet days
wdays <- rep(NA, 12)
for (m in 1:12) {
#Extracts all the days of 'x' belonging to the month 'm'
pcp.m <- extract(x, m)
if (type=="wet") {
wdays[m] <- length(which(pcp.m > thr )) / nyears
} else if (type=="dry") {
wdays[m] <- length(which(pcp.m < thr )) / nyears
} # ELSE end
} # FOR m end
names(wdays) <- month.abb
return(wdays)
} # 'dwdays.default' end
################################################################################
# Author : Mauricio Zambrano-Bigiarini #
################################################################################
# Started: 24-Jan-2010 #
# Updates: 29-May-2013 #
# 23-Aug-2022 #
################################################################################
# 'dates' : "numeric", "factor", "Date" indicating how to obtain the
# dates for correponding to the 'sname' station
# If 'dates' is a number, it indicates the index of the column in
# 'x' that stores the dates
# If 'dates' is a factor, it have to be converted into 'Date' class,
# using the date format specified by 'date.fmt'
# 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 'st.name' station
# 'date.fmt': format in which the dates are stored in 'dates'.
# ONLY required when class(dates)=="factor" or "numeric"
# 'verbose' : logical; if TRUE, progress messages are printed
dwdays.data.frame <- function(x, thr=0, type="wet", na.rm=TRUE,
dates=1,
date.fmt="%Y-%m-%d",
verbose=TRUE,...) {
# Checking that the user provied a valid argument for 'dates'
if (missing(dates)) {
stop("Missing argument: 'dates' must be provided")
} else
# Checking that the user provied a valid argument for 'dates'
if (is.na(match(class(dates), c("numeric", "factor", "Date"))))
stop("Invalid argument: 'dates' must be of class 'numeric', 'factor', 'Date'")
# If 'dates' is a number, it indicates the index of the column of 'x' that stores the dates
# The column with dates is then substracted form 'x' for easening the further computations
if ( inherits(dates, "numeric") ) {
tmp <- dates
dates <- as.Date(x[, dates], format= date.fmt)
x <- x[-tmp]
} # 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") ) dates <- as.Date(dates, format= date.fmt)
# 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 'st.name' station
if ( ( inherits(dates, "Date") ) & (length(dates) != nrow(x) ) )
stop("Invalid argument: 'length(dates)' must be equal to 'nrow(x)'")
# Amount of stations in 'x'
nstations <- ncol(x)
# ID of all the stations in 'x'
snames <- colnames(x)
# Computing the Starting and Ending Year of the analysis
Starting.Year <- as.numeric(format(range(dates)[1], "%Y"))
Ending.Year <- as.numeric(format(range(dates)[2], "%Y"))
# Amount of Years belonging to the desired period
nyears <- Ending.Year - Starting.Year + 1
if (verbose) message("[Starting the computations...]")
# Creating the data.frame that will store the computed averages for each station
z <- as.data.frame(matrix(data = NA, ncol = 12, nrow = nstations,
byrow = TRUE, dimnames = NULL) )
colnames(z) <- month.abb
rownames(z) <- snames
y = x
for (j in 1:nstations) {
if (verbose) message( paste("Station: ", format(snames[j], width=10, justify="left"),
" : ",format(j, width=3, justify="left"), "/",
nstations, " => ",
format(round(100*j/nstations,2), width=6, justify="left"),
"%", sep="") )
# Transforming the column of 'x' into a zoo object,
# using the dates provided by the user
tmp <- vector2zoo(x=y[,j], dates=dates, date.fmt=date.fmt)
# Computing the monthly values
z[j, ] <- as.numeric(dwdays.default(x=tmp, thr=thr, type=type, na.rm=na.rm, ...))
} # FOR end
return( z )
} #'dwdays.data.frame' END
################################################################################
# Author : Mauricio Zambrano-Bigiarini #
################################################################################
# Started: 24-Jan-2010 #
# Updates: 29-May-2013 #
################################################################################
dwdays.matrix <- function(x, thr=0, type="wet", na.rm=TRUE,
dates=1,
date.fmt="%Y-%m-%d",
verbose=TRUE,...) {
x <- as.data.frame(x)
NextMethod("dwdays", x, thr=thr, type=type, na.rm=na.rm,
dates=dates,
date.fmt=date.fmt,
verbose=verbose,...)
} # 'dwdays.matrix ' END
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.