Commit 832e04eb authored by Manuela's avatar Manuela

remove dependence from wmtsa, which relies on ifultools that has been orphaned.

parent f29e4a9b
......@@ -20,12 +20,14 @@ Description: Provides a simulation framework to simulate streamflow time series
The function prsim.wave() extends the approach to multiple sites and is based on the complex wavelet transform. We further use the flexible four-parameter Kappa distribution, which allows
for the extrapolation to yet unobserved low and high flows. Alternatively, the empirical or any other distribution can be used. A detailed description of
the simulation approach for single sites and an application example can be found
in <https://www.hydrol-earth-syst-sci-discuss.net/hess-2019-142/>.
in <https://www.hydrol-earth-syst-sci.net/23/3175/2019/>.
A detailed description and evaluation of the wavelet-based multi-site approach can be found in
<https://www.hydrol-earth-syst-sci-discuss.net/hess-2019-658/>
URL: https://git.math.uzh.ch/reinhard.furrer/PRSim-devel
BugReports: https://git.math.uzh.ch/reinhard.furrer/PRSim-devel
License: GPL-3
Encoding: UTF-8
LazyData: true
Depends: R (>= 3.5.0), homtest, goftest, wmtsa
Depends: R (>= 3.5.0), homtest, goftest, splus2R
Suggests: lattice, ismev, evd, GB2
Imports: stats
......@@ -5,6 +5,99 @@ prsim.wave <- function(data, station_id="Qobs", number_sim=1, win_h_length=15,
marginal=c("kappa","empirical"), n_par=4, n_wave=100, marginalpar=TRUE,
GoFtest=NULL, verbose=TRUE, suppWarn=FALSE, ...){
### checkVectorType function originally implemented by package ifultools, which has recently been orphaned
checkVectorType <- function (x, isType = "numeric")
{
checkScalarType(isType, "character")
if (isType == "integer") {
if (!isVectorAtomic(x) || !is.numeric(x))
stop(deparseText(substitute(x)), " must be a vector of class ",
isType)
}
else {
if (!isVectorAtomic(x) || !eval(parse(text = paste("is.",
isType, "(x)", sep = ""))))
stop(deparseText(substitute(x)), " must be a vector of class ",
isType)
}
invisible(NULL)
}
### continuous wavelet transform as implemented by package wmtsa, which has recently been orphaned
wavCWT <- function (x, scale.range = deltat(x) * c(1, length(x)), n.scale = 100,
wavelet = "gaussian2", shift = 5, variance = 1)
{
checkVectorType(scale.range, "numeric")
checkScalarType(n.scale, "integer")
checkScalarType(wavelet, "character")
checkScalarType(shift, "numeric")
checkScalarType(variance, "numeric")
checkRange(n.scale, c(1, Inf))
series.name <- deparse(substitute(x))
if (length(scale.range) != 2)
stop("scale.range must be a two-element numeric vector")
if (variance <= 0)
stop("variance input must be positive")
sampling.interval <- deltat(x)
octave <- logb(scale.range, 2)
scale <- ifelse1(n.scale > 1, 2^c(octave[1] + seq(0, n.scale -
2) * diff(octave)/(floor(n.scale) - 1), octave[2]), scale.range[1])
scale <- unique(round(scale/sampling.interval) * sampling.interval)
n.scale <- length(scale)
if (min(scale) + .Machine$double.eps < sampling.interval)
stop("Minimum scale must be greater than or equal to sampling interval ",
"of the time series")
if (inherits(x, "signalSeries")) {
times <- as(x@positions, "numeric")
x <- x@data
}
else {
times <- time(x)
x <- as.vector(x)
}
storage.mode(x) <- "double"
gauss1 <- c("gaussian1", "gauss1")
gauss2 <- c("gaussian2", "gauss2", "mexican hat",
"sombrero")
supported.wavelets <- c("haar", gauss1, gauss2, "morlet")
wavelet <- match.arg(lowerCase(wavelet), supported.wavelets)
filter <- mutilsFilterTypeContinuous(wavelet)
if (filter == 4) {
filter.arg <- sqrt(variance)
wavelet <- "gaussian1"
}
else if (filter == 5) {
filter.arg <- sqrt(variance)
wavelet <- "gaussian2"
}
else if (filter == 6) {
filter.arg <- shift
wavelet <- "morlet"
}
else if (filter == 7) {
filter.arg <- 0
wavelet <- "haar"
scale <- sampling.interval * unique(round(scale/sampling.interval))
}
else {
stop("Unsupported filter type")
}
z <- itCall("RS_wavelets_transform_continuous_wavelet",
as.numeric(x), as.numeric(sampling.interval), as.integer(filter),
as.numeric(filter.arg), as.numeric(scale))
if (wavelet != "morlet")
z <- Re(z)
attr(z, "scale") <- scale
attr(z, "time") <- as.vector(times)
attr(z, "wavelet") <- wavelet
attr(z, "series") <- x
attr(z, "sampling.interval") <- sampling.interval
attr(z, "series.name") <- series.name
attr(z, "n.sample") <- length(x)
attr(z, "n.scale") <- n.scale
attr(z, "filter.arg") <- filter.arg
oldClass(z) <- "wavCWT"
z
}
### function for backtransformation of continuous wavelet transform
### inverse wavelet transform
### x is the input matrix
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment