# NOT RUN {
z <- revd(100, loc=20, scale=0.5, shape=-0.2)
fit <- fevd(z)
fit
plot(fit)
plot(fit, "trace")
# }
# NOT RUN {
## Fitting the GEV to block maxima.
# Port Jervis, New York winter maximum and minimum
# temperatures (degrees centigrade).
data(PORTw)
# Gumbel
fit0 <- fevd(TMX1, PORTw, type="Gumbel", units="deg C")
fit0
plot(fit0)
plot(fit0, "trace")
return.level(fit0)
# GEV
fit1 <- fevd(TMX1, PORTw, units="deg C")
fit1
plot(fit1)
plot(fit1, "trace")
return.level(fit1)
return.level(fit1, do.ci=TRUE)
ci(fit1, return.period=c(2,20,100)) # Same as above.
lr.test(fit0, fit1)
ci(fit1, type="parameter")
par(mfrow=c(1,1))
ci(fit1, type="parameter", which.par=3, xrange=c(-0.4,0.01),
nint=100, method="proflik", verbose=TRUE)
# 100-year return level
ci(fit1, method="proflik", xrange=c(22,28), verbose=TRUE)
plot(fit1, "probprob")
plot(fit1, "qq")
plot(fit1, "hist")
plot(fit1, "hist", ylim=c(0,0.25))
# Non-stationary model.
# Location as a function of AO index.
fit2 <- fevd(TMX1, PORTw, location.fun=~AOindex, units="deg C")
fit2
plot(fit2)
plot(fit2, "trace")
# warnings are not critical here.
# Sometimes the nllh or gradients
# are not defined.
return.level(fit2)
v <- make.qcov(fit2, vals=list(mu1=c(-1, 1)))
return.level(fit2, return.period=c(2, 20, 100), qcov=v)
# Note that first row is for AOindex = -1 and second
# row is for AOindex = 1.
lr.test(fit1, fit2)
# Also compare AIC and BIC
look1 <- summary(fit1, silent=TRUE)
look1 <- c(look1$AIC, look1$BIC)
look2 <- summary(fit2, silent=TRUE)
look2 <- c(look2$AIC, look2$BIC)
# Lower AIC/BIC is better.
names(look1) <- names(look2) <- c("AIC", "BIC")
look1
look2
par(mfrow=c(1,1))
plot(fit2, "rl")
## Fitting the GP df to threshold excesses.
# Hurricane damage data.
data(damage)
ny <- tabulate(damage$Year)
# Looks like only, at most, 5 obs per year.
ny <- mean(ny[ny > 0])
fit0 <- fevd(Dam, damage, threshold=6, type="Exponential", time.units="2.05/year")
fit0
plot(fit0)
plot(fit0, "trace") # ignore the warning.
fit1 <- fevd(Dam, damage, threshold=6, type="GP", time.units="2.05/year")
fit1
plot(fit1) # ignore the warning.
plot(fit1, "trace")
return.level(fit1)
# lr.test(fit0, fit1)
# Fort Collins, CO precipitation
data(Fort)
## GP df
fit <- fevd(Prec, Fort, threshold=0.395, type="GP", units="inches", verbose=TRUE)
fit
plot(fit)
plot(fit, "trace")
ci(fit, type="parameter")
par(mfrow=c(1,1))
ci(fit, type="return.level", method="proflik", xrange=c(4,7.5), verbose=TRUE)
# Can check using locator(2).
ci(fit, type="parameter", which.par=2, method="proflik", xrange=c(0.1, 0.3),
verbose=TRUE)
# Can check using locator(2).
## PP model.
fit <- fevd(Prec, Fort, threshold=0.395, type="PP", units="inches", verbose=TRUE)
fit
plot(fit)
plot(fit, "trace")
ci(fit, type="parameter")
# Same thing, but just to try a different optimization method.
# And, for fun, a different way of entering the data set.
fit <- fevd(Fort$Prec, threshold=0.395, type="PP",
optim.args=list(method="Nelder-Mead"), units="inches", verbose=TRUE)
fit
plot(fit)
plot(fit, "trace")
ci(fit, type="parameter")
## PP model with blocks argument for computational efficiency # CJP2
system.time(fit <- fevd(Prec, Fort, threshold=0.395, type="PP", units="inches", verbose=TRUE))
FortSub = Fort[Fort$Prec > 0.395, ]
system.time(fit.blocks <- fevd(Prec, FortSub, threshold=0.395,
type="PP", units="inches", blocks = list(nBlocks = 100), verbose=TRUE))
fit.blocks
plot(fit.blocks)
plot(fit.blocks, "trace")
ci(fit.blocks, type="parameter")
#
# Phoenix data
#
# Summer only with 62 days per year.
data(Tphap)
plot(MinT~ Year, data=Tphap)
# GP df
fit <- fevd(-MinT ~1, Tphap, threshold=-73, type="GP", units="deg F",
time.units="62/year", verbose=TRUE)
fit
plot(fit)
plot(fit, "trace")
# PP
fit <- fevd(-MinT ~1, Tphap, threshold=-73, type="PP", units="deg F", time.units="62/year",
use.phi=TRUE, optim.args=list(method="BFGS", gr=NULL), verbose=TRUE)
fit
plot(fit)
plot(fit, "trace")
# Non-stationary models
fit <- fevd(Prec, Fort, threshold=0.395,
scale.fun=~sin(2 * pi * (year - 1900)/365.25) + cos(2 * pi * (year - 1900)/365.25),
type="GP", use.phi=TRUE, verbose=TRUE)
fit
plot(fit)
plot(fit, "trace")
ci(fit, type="parameter")
# Non-constant threshold.
# GP
fit <- fevd(Prec, Fort, threshold=0.475, threshold.fun=~I(-0.15 * cos(2 * pi * month / 12)),
type="GP", verbose=TRUE)
fit
plot(fit)
par(mfrow=c(1,1))
plot(fit, "rl", xlim=c(0, 365))
# PP
fit <- fevd(Prec, Fort, threshold=0.475, threshold.fun=~I(-0.15 * cos(2 * pi * month / 12)),
type="PP", verbose=TRUE)
fit
plot(fit)
## Bayesian PP with blocks for computational efficiency
## Note that 1999 iterations may not be sufficient; used here to
## minimize time spent fitting.
# CJP2
## CJP2: Eric, CRAN won't like this being run as part of the examples
## as it takes a long time; we'll probably want to wrap this in a \dontrun{}
set.seed(0)
system.time(fit <- fevd(Prec, Fort, threshold=0.395,
scale.fun=~sin(2 * pi * (year - 1900)/365.25) + cos(2 * pi * (year - 1900)/365.25),
type="PP", method="Bayesian", iter=1999, use.phi=TRUE, verbose=TRUE))
fit
ci(fit, type="parameter")
set.seed(0)
FortSub <- Fort[Fort$Prec > 0.395, ]
system.time(fit2 <- fevd(Prec, FortSub, threshold=0.395,
scale.fun=~sin(2 * pi * (year - 1900)/365.25) + cos(2 * pi * (year -
1900)/365.25), type="PP", blocks = list(nBlocks= 100, data =
data.frame(year = 1900:1999)), use.phi=TRUE, method = "Bayesian",
iter=1999, verbose=TRUE))
# an order of magnitude faster
fit2
ci(fit2, type="parameter")
data(ftcanmax)
fit <- fevd(Prec, ftcanmax, units="inches")
fit
plot(fit)
par(mfrow=c(1,1))
plot(fit, "probprob")
plot(fit, "hist")
plot(fit, "hist", ylim=c(0,0.01))
plot(fit, "density", ylim=c(0,0.01))
plot(fit, "trace")
distill(fit)
distill(fit, cov=FALSE)
fit2 <- fevd(Prec, ftcanmax, location.fun=~Year)
fit2
plot(fit2)
##
# plot(fit2, "trace") # Gives warnings because of some NaNs produced
# (nothing to worry about).
lr.test(fit, fit2)
ci(fit)
ci(fit, type="parameter")
fit0 <- fevd(Prec, ftcanmax, type="Gumbel")
fit0
plot(fit0)
lr.test(fit0, fit)
plot(fit0, "trace")
ci(fit, return.period=c(2, 20, 100))
ci(fit, type="return.level", method="proflik", return.period=20, verbose=TRUE)
ci(fit, type="parameter", method="proflik", which.par=3, xrange=c(-0.1,0.5), verbose=TRUE)
# L-moments
fitLM <- fevd(Prec, ftcanmax, method="Lmoments", units="inches")
fitLM # less info.
plot(fitLM)
# above is slightly slower because of the parametric bootstrap
# for finding CIs in return levels.
par(mfrow=c(1,1))
plot(fitLM, "density", ylim=c(0,0.01))
# GP model.
# CJP2 : fixed so have 744/year (31 days *24 hours/day)
data(Denversp)
fitGP <- fevd(Prec, Denversp, threshold=0.5, type="GP", units="mm",
time.units="744/year", verbose=TRUE)
fitGP
plot(fitGP)
plot(fitGP, "trace")
# you can see the difficulty in getting good numerics here.
# the warnings are not a coding problem, but challenges in
# the likelihood for the data.
# PP model.
fitPP <- fevd(Prec, Denversp, threshold=0.5, type="PP", units="mm",
time.units="744/year", verbose=TRUE)
fitPP
plot(fitPP)
plot(fitPP, "trace")
fitPP <- fevd(Prec, Denversp, threshold=0.5, type="PP", optim.args=list(method="Nelder-Mead"),
time.units="744/year", units="mm", verbose=TRUE)
fitPP
plot(fitPP) # Much better.
plot(fitPP, "trace")
# Better than above, but can see the difficulty!
# Can see the importance of good starting values!
# Try out for small samples
# Using one of the data example from Martins and Stedinger (2000)
z <- c( -0.3955, -0.3948, -0.3913, -0.3161, -0.1657, 0.3129, 0.3386, 0.5979,
1.4713, 1.8779, 1.9742, 2.0540, 2.6206, 4.9880, 10.3371 )
tmpML <- fevd( z ) # Usual MLE.
# Find 0.999 quantile for the MLE fit.
# "True" 0.999 quantile is around 11.79
p <- tmpML$results$par
qevd( 0.999, loc = p[ 1 ], scale = p[ 2 ], shape = p[ 3 ] )
tmpLM <- fevd(z, method="Lmoments")
p <- tmpLM$results
qevd( 0.999, loc = p[ 1 ], scale = p[ 2 ], shape = p[ 3 ] )
tmpGML <- fevd(z, method="GMLE")
p <- tmpGML$results$par
qevd( 0.999, loc = p[ 1 ], scale = p[ 2 ], shape = p[ 3 ] )
plot(tmpLM)
dev.new()
plot(tmpGML)
# Bayesian
fitB <- fevd(Prec, ftcanmax, method="Bayesian", verbose=TRUE)
fitB
plot(fitB)
plot(fitB, "trace")
# Above looks good for scale and shape, but location does not appear to have found its way.
fitB <- fevd(Prec, ftcanmax, method="Bayesian", priorParams=list(v=c(1, 10, 10)), verbose=TRUE)
fitB
plot(fitB)
plot(fitB, "trace")
# Better, but what if we start with poor initial values?
fitB <- fevd(Prec, ftcanmax, method="Bayesian", priorParams=list(v=c(0.1, 10, 0.1)),
initial=list(location=0, scale=0.1, shape=-0.5)), verbose=TRUE)
fitB
plot(fitB)
plot(fitB, "trace")
##
## Non-constant threshold.
##
data(Tphap)
# Negative of minimum temperatures.
plot(-Tphap$MinT)
fitGP2 <- fevd(-MinT ~1, Tphap, threshold=c(-70,-7), threshold.fun=~I((Year - 48)/42), type="GP",
time.units="62/year", verbose=TRUE)
fitGP2
plot(fitGP2)
plot(fitGP2, "trace")
par(mfrow=c(1,1))
plot(fitGP2, "hist")
plot(fitGP2, "rl")
ci(fitGP2, type="parameter")
##
## Non-stationary models.
##
data(PORTw)
# GEV
fitPORTstdmax <- fevd(PORTw$TMX1, PORTw, scale.fun=~STDTMAX, use.phi=TRUE)
plot(fitPORTstdmax)
plot(fitPORTstdmax, "trace")
# One can see how finding the optimum value numerically can be tricky!
# Bayesian
fitPORTstdmaxB <- fevd(PORTw$TMX1, PORTw, scale.fun=~STDTMAX, use.phi=TRUE,
method="Bayesian", verbose=TRUE)
fitPORTstdmaxB
plot(fitPORTstdmaxB)
plot(fitPORTstdmaxB, "trace")
# Let us go crazy.
fitCrazy <- fevd(PORTw$TMX1, PORTw, location.fun=~AOindex + STDTMAX, scale.fun=~STDTMAX,
shape.fun=~STDMIN, use.phi=TRUE)
fitCrazy
plot(fitCrazy)
plot(fitCrazy, "trace")
# With so many parameters, you may need to stretch the device
# using your mouse in order to see them well.
ci(fitCrazy, type="parameter", which=2) # Hmmm. NA NA. Not good.
ci(fitCrazy, type="parameter", which=2, method="proflik", verbose=TRUE)
# Above not quite good enough (try to get better bounds).
ci(fitCrazy, type="parameter", which=2, method="proflik", xrange=c(0, 2), verbose=TRUE)
# Much better.
##
## Center and scale covariate.
##
data(Fort)
fitGPcross <- fevd(Prec, Fort, threshold=0.395,
scale.fun=~cos(day/365.25) + sin(day/365.25) + I((year - 1900)/99),
type="GP", use.phi=TRUE, units="inches")
fitGPcross
plot(fitGPcross) # looks good!
# Get a closer look at the effective return levels.
par(mfrow=c(1,1))
plot(fitGPcross, "rl", xlim=c(10000,12000))
lr.test(fitGPfc, fitGPcross)
# }
# NOT RUN {
# }
Run the code above in your browser using DataLab