WilksGaussianization: Wilsks Correctio for Precipitation Marginal Gausianization

In ecor/RMRAINGEN: RMRAINGEN (R Multi-site RAINfall GENeretor): a package to generate daily time series of rainfall from monthly mean values

Description

Wrapper Gaussianization of normalizeGaussian_severalstations

Usage

WilksGaussianization(x, data = x, gauss = NULL, valmin = 0.5,
  tolerance = 0.001, prec_tolerance = c(0.05, 2.5), iterations = 20,
  force.precipitation.value = TRUE, seed = 1234, shuffle = list(e1 =
  1:ncol(x)), p = 1, args_var = NULL, ...)

Arguments

x	see normalizeGaussian_severalstations, e. g. precipitation depth values
data	see normalizeGaussian_severalstations
prec_tolerance	tolerance used for precipitation value
iterations	number of iteration proposed for 'Wilks Gaussianization'
force.precipitation.value	logical value. If it is TRUE (Default) gaussianized values corresponding to precipitation days are forced to fit the observed precipitation values.
seed	seed used for random generation.
valmin,tolerance	see CCGamma
...	further arguments for normalizeGaussian_severalstations

See Also

normalizeGaussian_severalstations,CCGamma

Examples

library(RMRAINGEN)


data(trentino)

year_min <- 1961
year_max <- 1990
origin <- paste(year_min,1,1,sep="-")

period <- PRECIPITATION$year>=year_min & PRECIPITATION$year<=year_max
station <- names(PRECIPITATION)[!(names(PRECIPITATION) %in% c("day","month","year"))]
prec_mes <- PRECIPITATION[period,station]



## removing nonworking stations (e.g. time series with NA)
accepted <- array(TRUE,length(names(prec_mes)))
names(accepted) <- names(prec_mes)
for (it in names(prec_mes)) {
	accepted[it]  <- (length(which(!is.na(prec_mes[,it])))==length(prec_mes[,it]))
}

prec_mes <- prec_mes[,accepted]
valmin <- 0.5
prec_mes_gaussWilks <- WilksGaussianization(x=prec_mes, data=prec_mes,valmin=valmin,sample="monthly",extremes=TRUE,origin_x = origin, origin_data = origin,force.precipitation.value="both")
prec_mes_gauss <- normalizeGaussian_severalstations(x=prec_mes, data=prec_mes,step=0,sample="monthly",extremes=TRUE,origin_x = origin, origin_data = origin)
prec_mes_ginv <- list()
prec_mes_ginv$unforced <- normalizeGaussian_severalstations(x=prec_mes_gaussWilks$unforced, data=prec_mes,step=0,sample="monthly",extremes=TRUE,origin_x = origin, origin_data = origin,inverse=TRUE)
prec_mes_ginv$forced <- normalizeGaussian_severalstations(x=prec_mes_gaussWilks$forced, data=prec_mes,step=0,sample="monthly",extremes=TRUE,origin_x = origin, origin_data = origin,inverse=TRUE)

str(prec_mes_ginv)

 plot(prec_mes[,1],prec_mes_ginv$unforced[,1])
 plot(prec_mes[,19],prec_mes_ginv$unforced[,19])

CCGamma <- CCGamma(data=prec_mes, lag = 0,valmin=valmin,only.matrix=TRUE,tolerance=0.001)


 plot(cor(prec_mes_gaussWilks$unforced),cor(prec_mes_gaussWilks$forced))
abline(0,1)


VARselect(prec_mes_gaussWilks$forced)


# u <- apply(prec_mes_ginv$forced,2,rank)/(nrow(prec_mes_ginv$forced)+1)
#copula <- normalCopula(dim=ncol(u), disp = "un",param=P2p(CCGamma))
#out <- fitCopula(copula, data=u, method = "ml" )
     #     start = NULL, lower = NULL, upper = NULL,
     #     optim.method = "BFGS", optim.control = list(maxit=1000),
     #     estimate.variance = TRUE, hideWarnings = TRUE)

ecor/RMRAINGEN documentation built on May 15, 2019, 8:53 p.m.