Nothing
# File subdaily2monthly.R
# Part of the hydroTSM R package, https://github.com/hzambran/hydroTSM ;
# https://CRAN.R-project.org/package=hydroTSM
# Copyright 2013-2023 Mauricio Zambrano-Bigiarini
# Distributed under GPL 2 or later
################################################################################
# subdaily2monthly #
################################################################################
# This function transform a (sub)DAILY regular time series into a MONTHLY one
# 'x' : daily values that will be converted into monthly ones.
# class(x) must be zoo/xts
# 'FUN' : Function that have to be applied for transforming from daily into
# monthly time step
# For precipitation FUN MUST be "sum"
# For temperature and flow time series, FUN MUST be "mean"
# 'na.rm': Logical. Should missing values be removed?
# TRUE : the monthly and annual values are computed considering only those values different from NA
# FALSE: if there is AT LEAST one NA within a year, the monthly and annual values are NA
subdaily2monthly <-function(x, ...) UseMethod("subdaily2monthly")
################################################################################
# Author : Mauricio Zambrano-Bigiarini #
################################################################################
# Started: 09-Apr-2013 #
# Updates: 25-May-2033 #
################################################################################
subdaily2monthly.default <- function(x, FUN, na.rm=TRUE, start="00:00:00",
start.fmt= "%H:%M:%S", tz, ...) {
# Checking that 'x' is a zoo object
if ( !is.zoo(x) ) stop("Invalid argument: 'class(x)' must be 'zoo' !")
# if (missing(tz)) tz <- ""
if (missing(tz)) tz <- format(time(x), "%Z")[1]
subdaily2monthly.zoo(x=x, FUN=FUN, na.rm=na.rm, start=start, start.fmt=start.fmt, tz=tz, ...)
} # 'subdaily2monthly.default' end
################################################################################
# Author : Mauricio Zambrano-Bigiarini #
################################################################################
# Started: 09-Apr-2013 #
# Updates: 25-May-2023 #
################################################################################
subdaily2monthly.zoo <- function(x, FUN, na.rm=TRUE, start="00:00:00",
start.fmt= "%H:%M:%S", tz, ...) {
# testing the existence of 'na.rm' argument
#args <- list(...)
#exist <- "na.rm" %in% names(args)
#exist
# # Checking that the user provied a valid class for 'x'
# if ( !is.zoo(x) ) stop("Invalid argument: 'class(x)' must be 'zoo' !")
#
# # Automatic detection of 'tz'
# if (missing(tz))
# tz <- format(time(x), "%Z")[1]
#
# d <- subdaily2daily.zoo(x=x, FUN=fn, na.rm=na.rm, start=start, start.fmt=start.fmt, tz=tz, ...)
#
# daily2monthly.zoo(x=d, FUN=fn, na.rm=na.rm, ...)
# testing the existence of 'na.rm' argument
#args <- list(...)
#exist <- "na.rm" %in% names(args)
#exist
# Checking that the user provied a valid class for 'x'
if ( !is.zoo(x) ) stop("Invalid argument: 'class(x)' must be 'zoo' !!")
# Checking the user provide a valid value for 'FUN'
if (missing(FUN))
stop("Missing argument: 'FUN' must contain a valid function for aggregating the sub-daily values")
# Automatic detection of 'tz'
#if (missing(tz)) tz <- ""
if (missing(tz)) tz <- format(time(x), "%Z")[1]
# Analysis of days different from 00:00 to 23:59 hrs
if ( start != "00:00:00" ) {
# Storing the original time
time.old <- time(x)
# Converting the new starting time provided by the user into a POSIXct object
start <- as.POSIXct(start, format=start.fmt, tz=tz)
# normal staring time for a day
nstart <- as.POSIXct("00:00:00", format="%H:%M:%S", tz=tz)
# time difference between the desired starting time 'strat' and the "normal"
# starting time 'nstart', [s]
delta <- difftime(start, nstart, units="secs")
# Computing teh time difference between 'start' and the "normal" starting time, [s]
#time.new <- as.POSIXct(time.old, tz=tz) - delta
time.new <- time.old - delta
# Changing the time in 'x' in 'delta' seconds
time(x) <- time.new
} # IF end
# Making sure that the time serie is complete before aggregation
# This is useful when the first element of 'x' is not given at the time defined by 'start'.
# For example, if the first element of 'x' starts at 08:00:00 hrs, but 'start=00:00:00',
# what happens with all the values from 00:00:00 to 07:59:59 hrs?
# The following lines of code makes sure that the missing elements in a day are actually
# considered as missing
st <- paste(format(start(x), "%Y-%m-%d"), "00:00:00", tz)
et <- paste(format(end(x), "%Y-%m-%d"), "23:59:59", tz)
x <- izoo2rzoo(x, from=st, to=et, tz=tz)
# Computing the Monthly time series
m <- aggregate(x, by= function(tt) format(tt, "%Y-%m"), FUN=FUN, na.rm= na.rm, ...)
# Removing subdaily time attibute, but not the dates
if (NCOL(m) == 1) {
m <- zoo(as.numeric(m), as.yearmon(time(m), format="%Y-%m") )
} else m <- zoo(coredata(m), as.yearmon(time(m), format="%Y-%m") )
# Replacing the NaNs by 'NA.
# mean(NA:NA, na.rm=TRUE) == NaN
nan.index <- which(is.nan(m))
if ( length(nan.index) > 0 ) m[nan.index] <- NA
# Replacing all the Inf and -Inf by NA's
# min(NA:NA, na.rm=TRUE) == Inf ; max(NA:NA, na.rm=TRUE) == -Inf
inf.index <- which(is.infinite(m))
if ( length(inf.index) > 0 ) m[inf.index] <- NA
return(m)
} # 'subdaily2monthly.zoo' end
################################################################################
# Author : Mauricio Zambrano-Bigiarini #
################################################################################
# Started: 09-Apr-2013 #
# Updates: 25-May-2023 #
################################################################################
subdaily2monthly.data.frame <- function(x, FUN, na.rm=TRUE, start="00:00:00",
start.fmt= "%H:%M:%S", tz,
dates=1, date.fmt="%Y-%m-%d %H:%M:%S",
out.fmt="zoo",
verbose=TRUE,...) {
# Checking that the user provide a valid value for 'FUN'
if (missing(FUN))
stop("Missing argument value: 'FUN' must contain a valid function for aggregating the values !!")
# Checking that the user provied a valid argument for 'out.fmt'
if (is.na(match( out.fmt, c("numeric", "zoo") ) ) )
stop("Invalid argument: 'out.fmt' must be in c('numeric', 'zoo')")
# 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 ( !( inherits(dates, "numeric") | inherits(dates, "factor") | inherits(dates, "POSIXt")) )
stop("Invalid argument: 'class(dates)' must be in c('numeric', 'factor', 'POSIXct', 'POSIXt') !")
# Automatic detection of 'tz'
if (missing(tz)) tz <- ""
# 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 ( TRUE && ( inherits(dates, "numeric") ) ) {
tmp <- dates
dates <- as.POSIXct(x[, dates], format= date.fmt, tz=tz)
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 ( TRUE && ( inherits(dates, "factor") ) ) dates <- as.POSIXct(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 ( (TRUE && ( inherits(dates, "POSIXt") ) ) & (length(dates) != nrow(x) ) )
stop("Invalid argument: 'length(dates)' must be equal to 'nrow(x)'")
# Transforming 'x' into a zoo object
x <- zoo::zoo(x, dates)
##############################################################################
z <- subdaily2monthly.zoo(x=x, FUN=FUN, na.rm=na.rm, start=start, start.fmt=start.fmt, tz=tz, ...)
if (out.fmt == "numeric") {
snames <- colnames(z)
dates.lab <- as.character(time(z))
z <- coredata(z)
colnames(z) <- snames
rownames(z) <- dates.lab
} # IF end
return( z )
} # 'subdaily2monthly.data.frame' end
################################################################################
# Author : Mauricio Zambrano-Bigiarini #
################################################################################
# Started: 09-Apr-2013 #
# Updates: 25-May-2023 #
################################################################################
subdaily2monthly.matrix <- function(x, FUN, na.rm=TRUE, start="00:00:00",
start.fmt= "%H:%M:%S", tz,
dates=1, date.fmt="%Y-%m-%d %H:%M:%S",
out.fmt="zoo",
verbose=TRUE,...) {
# Checking that the user provide a valid value for 'FUN'
if (missing(FUN))
stop("Missing argument value: 'FUN' must contain a valid function for aggregating the values !!")
# Checking that the user provied a valid argument for 'out.fmt'
if (is.na(match( out.fmt, c("numeric", "zoo") ) ) )
stop("Invalid argument: 'out.fmt' must be in c('numeric', 'zoo')")
# 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 ( !( inherits(dates, "numeric") | inherits(dates, "factor") | inherits(dates, "POSIXt")) )
stop("Invalid argument: 'class(dates)' must be in c('numeric', 'factor', 'POSIXct', 'POSIXt') !")
# Automatic detection of 'tz'
if (missing(tz)) tz <- ""
x <- as.data.frame(x)
#NextMethod("daily2annual") # I don't know why is redirecting to 'daily2monthly.default' instead of 'daily2monthly.data.frame'....
subdaily2monthly.data.frame(x=x, FUN=FUN, na.rm=na.rm, start=start,
start.fmt=start.fmt, tz=tz,
dates=dates, date.fmt=date.fmt,
out.fmt=out.fmt,
verbose=verbose,...)
} # 'subdaily2monthly.matrix' end
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.