Analisi del trend nelle serie annuali dei massimi di precipitazione (RX1).
I trend vengono valutati mediante lo stimatore di TheilSenn e assumendo un modello GEV non stazionario.
rm(list = objects())
library("extRemes")
## Loading required package: Lmoments
## Loading required package: distillery
## Loading required package: car
##
## Attaching package: 'extRemes'
##
## The following objects are masked from 'package:stats':
##
## qqnorm, qqplot
library("zyp")
## Loading required package: Kendall
## elimina warnings
options(warn = -1)
analisiGEV <- function(col) {
par(oldPar)
ID <- names(dati)[col]
cat(sprintf("Stazione: %s", ID))
## associamo i dati
x <- dati[, c(1, col)]
names(x) <- c("yy", "prcp")
## subset dei dati sulla base di quanto riportato nel file annoI
file.annoI <- list.files(pattern = "^annoI.+txt$")
if (length(file.annoI) != 1)
stop("Impossibile: ci deve essere un solo file")
## cerchiamo anno inizio
info.anni <- read.csv(file = file.annoI[1], sep = ";", head = T)
index.id <- which(info.anni$idstaz == ID)
if (!length(index.id)) {
YYYY <- 1951
} else {
YYYY <- info.anni[index.id, ]$annoI
}
## YYYY: prima di questo anno dobbiamo eliminare la serie Consideriamo solo
## le serie che partono dal 1951
if (YYYY != 1951) {
sprintf("Serie che inizia prima del 1951 %s", ID)
return()
## questo nn verrĂ mai eseguito
x <- subset(x, x >= YYYY)
}
x.temp <- x
## questo ci serve solo per il grafico (vogliamo mantenere gli NA)
index <- which(is.na(x$prcp))
if (length(index))
x <- x[-index, ]
yy.index <- matrix(1:length(x$prcp), ncol = 1)
x <- cbind(yy.index, x)
## theil sen
x.zyp <- zyp.sen(prcp ~ yy, dataframe = x)
zyp.coef <- coefficients(x.zyp)
zyp.int <- confint.zyp(x.zyp)
plot(x.temp$yy, x.temp$prcp, type = "l", xlab = "Years", ylab = "mm", main = paste0("Station -- ",
ID))
points(x.temp$yy, x.temp$prcp, pch = 21, bg = "red")
abline(a = zyp.coef["Intercept"], b = zyp.coef["yy"])
## trend in the location parameter
annual.fit.trend <- tryCatch({
fevd(x = prcp, data = x, type = "GEV", location.fun = ~yy.index, use.phi = F,
units = "mm", time.units = "year")
}, error = function(err) {
print(paste(ID, "gev", sep = " "))
print(err)
my.logRatio <- c(ID = ID, DEV = NA, CHI = NA, MU = NA)
return(my.logRatio)
})
parametri.trend <- round(annual.fit.trend$results$par[c(2, 3, 4)], 2)
annual.fit.notrend <- tryCatch({
fevd(x = prcp, data = x, type = "GEV", location.fun = ~1, use.phi = F,
units = "mm", time.units = "year")
}, error = function(err) {
print(paste(ID, "gev", sep = " "))
print(err)
my.logRatio <- c(ID = ID, DEV = NA, CHI = NA, MU = NA)
return(my.logRatio)
})
parametri.notrend <- round(annual.fit.notrend$results$par[c(1, 2, 3)], 2)
print("Annual fit with trend in location parameter")
plot(annual.fit.trend, , rperiods = tempi.ritorno)
print("Annual fit with no trend in location parameter")
plot(annual.fit.notrend, rperiods = tempi.ritorno)
## quale modello funziona meglio? loglikelihood ratio test
lr.ris <- lr.test(annual.fit.notrend, annual.fit.trend, alpha = 0.05, df = 1)
my.logRatio <- c(ID = ID, DEV = round(lr.ris$statistic, 2), PVAL = lr.ris$p.value,
ZYP.SLOPE = zyp.coef["yy"], ZYP.LW = zyp.int[2], ZYP.UP = zyp.int[4])
list(my.logRatio)
} ##fine analisiGEV
############################################ inizio programma
tempi.ritorno <- seq(10, 100, by = 10)
## dati di input: serie che cominciano dal 1951
dati <- read.csv(file = "dati1951.csv", sep = ";", head = T, check.names = F)
colonne <- ncol(dati)
## parametri
oldPar <- par()
risultati.gev <- lapply(2:colonne, analisiGEV)
## Stazione: 5602
## [1] "Annual fit with trend in location parameter"
## [1] "Annual fit with no trend in location parameter"
## Stazione: 5621
## [1] "Annual fit with trend in location parameter"
## [1] "Annual fit with no trend in location parameter"
## Stazione: 5635
## [1] "Annual fit with trend in location parameter"
## [1] "Annual fit with no trend in location parameter"
## Stazione: 5640
## [1] "Annual fit with trend in location parameter"
## [1] "Annual fit with no trend in location parameter"
## Stazione: 6259
## [1] "Annual fit with trend in location parameter"
## [1] "Annual fit with no trend in location parameter"
## Stazione: 6269
## [1] "Annual fit with trend in location parameter"
## [1] "Annual fit with no trend in location parameter"
## Stazione: 6285
## [1] "Annual fit with trend in location parameter"
## [1] "Annual fit with no trend in location parameter"
## Stazione: 6429
## [1] "Annual fit with trend in location parameter"
## [1] "Annual fit with no trend in location parameter"
## Stazione: 6697
## [1] "Annual fit with trend in location parameter"
## [1] "Annual fit with no trend in location parameter"
## Stazione: 6709
## [1] "Annual fit with trend in location parameter"
## [1] "Annual fit with no trend in location parameter"
## Stazione: 6720
## [1] "Annual fit with trend in location parameter"
## [1] "Annual fit with no trend in location parameter"
## Stazione: 6721
## [1] "Annual fit with trend in location parameter"
## [1] "Annual fit with no trend in location parameter"
## Stazione: 6723
## [1] "Annual fit with trend in location parameter"
## [1] "Annual fit with no trend in location parameter"
## Stazione: 6729
## [1] "Annual fit with trend in location parameter"
## [1] "Annual fit with no trend in location parameter"
## Stazione: 6736
## [1] "Annual fit with trend in location parameter"
## [1] "Annual fit with no trend in location parameter"
## Stazione: 6769
## [1] "Annual fit with trend in location parameter"
## [1] "Annual fit with no trend in location parameter"
## Stazione: 6773
## [1] "Annual fit with trend in location parameter"
## [1] "Annual fit with no trend in location parameter"
## Stazione: 6794
## [1] "Annual fit with trend in location parameter"
## [1] "Annual fit with no trend in location parameter"
## Stazione: 6812
## [1] "Annual fit with trend in location parameter"
## [1] "Annual fit with no trend in location parameter"
## Stazione: 6817
## [1] "Annual fit with trend in location parameter"
## [1] "Annual fit with no trend in location parameter"
## Stazione: 6828
## [1] "Annual fit with trend in location parameter"
## [1] "Annual fit with no trend in location parameter"
## Stazione: 6836
## [1] "Annual fit with trend in location parameter"
## [1] "Annual fit with no trend in location parameter"
## Stazione: 6841
## [1] "Annual fit with trend in location parameter"
## [1] "Annual fit with no trend in location parameter"
## Stazione: 6850
## [1] "Annual fit with trend in location parameter"
## [1] "Annual fit with no trend in location parameter"
## Stazione: 6856
## [1] "Annual fit with trend in location parameter"
## [1] "Annual fit with no trend in location parameter"
## Stazione: 6859
## [1] "Annual fit with trend in location parameter"
## [1] "Annual fit with no trend in location parameter"
## Stazione: 6865
## [1] "Annual fit with trend in location parameter"
## [1] "Annual fit with no trend in location parameter"
## Stazione: 6869
## [1] "Annual fit with trend in location parameter"
## [1] "Annual fit with no trend in location parameter"
## Stazione: 6874
## [1] "Annual fit with trend in location parameter"
## [1] "Annual fit with no trend in location parameter"
## Stazione: 6888
## [1] "Annual fit with trend in location parameter"
## [1] "Annual fit with no trend in location parameter"
## Stazione: 6897
## [1] "Annual fit with trend in location parameter"
## [1] "Annual fit with no trend in location parameter"
## Stazione: 6901
## [1] "Annual fit with trend in location parameter"
## [1] "Annual fit with no trend in location parameter"
## Stazione: 6923
## [1] "Annual fit with trend in location parameter"
## [1] "Annual fit with no trend in location parameter"
dev.gevDataFrame <- do.call("rbind", lapply(1:(colonne - 1), function(i) {
risultati.gev[[i]][[1]]
}))
write.table(dev.gevDataFrame, file = "dev.gevDataFrame1951.csv", sep = ";",
col.names = T, row.names = F, quote = F)