[Robast-commits] r790 - in branches/robast-1.0/pkg/RobExtremes: . R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Thu Oct 16 14:10:54 CEST 2014
Author: ruckdeschel
Date: 2014-10-16 14:10:53 +0200 (Thu, 16 Oct 2014)
New Revision: 790
Modified:
branches/robast-1.0/pkg/RobExtremes/NAMESPACE
branches/robast-1.0/pkg/RobExtremes/R/AllGeneric.R
branches/robast-1.0/pkg/RobExtremes/R/gevgpddiag.R
branches/robast-1.0/pkg/RobExtremes/man/ismevgpdgevdiag-methods.Rd
Log:
[RobExtremes] forgot to commit my changes from Oct 07. Should work now.
(concerns the gev.diag gpd.diag S4 methods...)
Modified: branches/robast-1.0/pkg/RobExtremes/NAMESPACE
===================================================================
--- branches/robast-1.0/pkg/RobExtremes/NAMESPACE 2014-10-05 21:23:40 UTC (rev 789)
+++ branches/robast-1.0/pkg/RobExtremes/NAMESPACE 2014-10-16 12:10:53 UTC (rev 790)
@@ -47,4 +47,7 @@
exportMethods("rescaleFunction")
S3method(print, riskMeasure)
exportMethods("gev.diag", "gpd.diag","gev.prof", "gpd.prof",
- "gev.profxi", "gpd.profxi")
\ No newline at end of file
+ "gev.profxi", "gpd.profxi")
+export("gev.diag", "gpd.diag","gev.prof", "gpd.prof",
+ "gev.profxi", "gpd.profxi")
+
\ No newline at end of file
Modified: branches/robast-1.0/pkg/RobExtremes/R/AllGeneric.R
===================================================================
--- branches/robast-1.0/pkg/RobExtremes/R/AllGeneric.R 2014-10-05 21:23:40 UTC (rev 789)
+++ branches/robast-1.0/pkg/RobExtremes/R/AllGeneric.R 2014-10-16 12:10:53 UTC (rev 790)
@@ -38,7 +38,7 @@
setGeneric("gev.profxi", function(z, ...) standardGeneric("gev.profxi"))
}
if(!isGeneric("gpd.diag")){
- setGeneric("gpd.diag", function(z) standardGeneric("gpd.diag"))
+ setGeneric("gpd.diag", function(z,...) standardGeneric("gpd.diag"))
}
if(!isGeneric("gpd.prof")){
setGeneric("gpd.prof", function(z, ...) standardGeneric("gpd.prof"))
Modified: branches/robast-1.0/pkg/RobExtremes/R/gevgpddiag.R
===================================================================
--- branches/robast-1.0/pkg/RobExtremes/R/gevgpddiag.R 2014-10-05 21:23:40 UTC (rev 789)
+++ branches/robast-1.0/pkg/RobExtremes/R/gevgpddiag.R 2014-10-16 12:10:53 UTC (rev 790)
@@ -1,25 +1,36 @@
setMethod("gev.diag", "gev.fit", function(z) ismev::gev.diag(z))
setMethod("gpd.diag", "gpd.fit", function(z) ismev::gpd.diag(z))
-setMethod("gev.diag", "GEVEstimate", function(z)ismev::gev.diag(..gevgpd.diag.fct(z)))
-setMethod("gpd.diag", "GPDEstimate", function(z)ismev::gev.diag(..gevgpd.diag.fct(z)))
+setMethod("gev.diag", "GEVEstimate", function(z)
+ ismev::gev.diag(..gevgpd.diag.fct(z)))
+setMethod("gpd.diag", "GPDEstimate", function(z, npy=365)
+ ismev::gpd.diag(..gevgpd.diag.fct(z, GPD=TRUE, npy=npy)))
setMethod("gev.prof", "gev.fit", function(z, m, xlow, xup, conf = 0.95, nint = 100)
- ismev::gev.prof(z, m, xlow, xup, conf = 0.95, nint = 100))
-setMethod("gpd.prof", "gpd.fit", function(z, m, xlow, xup, npy = 365, conf = 0.95, nint = 100)
- ismev::gpd.prof(z, m, xlow, xup, npy, conf, nint))
-setMethod("gev.prof", "GEVEstimate", function(z, m, xlow, xup, conf = 0.95, nint = 100)
- ismev::gev.prof(..gevgpd.diag.fct(z), m, xlow, xup, conf = 0.95, nint = 100))
-setMethod("gpd.prof", "GPDEstimate", function(z, m, xlow, xup, npy = 365, conf = 0.95, nint = 100)
- ismev::gev.prof(..gevgpd.diag.fct(z), m, xlow, xup, npy = 365, conf = 0.95, nint = 100))
-setMethod("gev.profxi", "gev.fit", function(z, xlow, xup, conf = 0.95, nint = 100)
- ismev::gev.profxi(z, xlow, xup, conf = 0.95, nint = 100))
-setMethod("gpd.profxi", "gpd.fit", function(z, xlow, xup, conf = 0.95, nint = 100)
- ismev::gpd.profxi(z, xlow, xup, conf = 0.95, nint = 100))
-setMethod("gev.profxi", "GEVEstimate", function(z, xlow, xup, conf = 0.95, nint = 100)
- ismev::gev.profxi(..gevgpd.diag.fct(z), xlow, xup, conf = 0.95, nint = 100))
-setMethod("gpd.profxi", "GPDEstimate", function(z, xlow, xup, conf = 0.95, nint = 100)
- ismev::gev.profxi(..gevgpd.diag.fct(z), xlow, xup, conf = 0.95, nint = 100))
+ ismev::gev.prof(z, m, xlow, xup, conf = conf, nint = nint))
+setMethod("gpd.prof", "gpd.fit", function(z, m, xlow, xup, npy = 365,
+ conf = 0.95, nint = 100) ismev::gpd.prof(z, m, xlow, xup, npy = npy,
+ conf = conf, nint = nint))
+setMethod("gev.prof", "GEVEstimate",
+ function(z, m, xlow, xup, conf = 0.95, nint = 100)
+ ismev::gev.prof(..gevgpd.diag.fct(z), m, xlow, xup,
+ conf = conf, nint = nint))
+setMethod("gpd.prof", "GPDEstimate", function(z, m, xlow, xup, npy = 365,
+ conf = 0.95, nint = 100)
+ ismev::gpd.prof(..gevgpd.diag.fct(z, GPD=TRUE, npy = npy), m,
+ xlow, xup, npy = npy, conf = conf, nint = nint))
+setMethod("gev.profxi", "gev.fit", function(z, xlow, xup, conf = 0.95,
+ nint = 100) ismev::gev.profxi(z, xlow, xup, conf = conf,
+ nint = nint))
+setMethod("gpd.profxi", "gpd.fit", function(z, xlow, xup, conf = 0.95,
+ nint = 100) ismev::gpd.profxi(z, xlow, xup, conf = conf,
+ nint = nint))
+setMethod("gev.profxi", "GEVEstimate", function(z, xlow, xup, conf = 0.95,
+ nint = 100) ismev::gev.profxi(..gevgpd.diag.fct(z), xlow, xup,
+ conf = 0.95, nint = 100))
+setMethod("gpd.profxi", "GPDEstimate", function(z, xlow, xup, npy=365,
+ conf = 0.95, nint = 100) ismev::gpd.profxi(..gevgpd.diag.fct(z,
+ GPD=TRUE, npy), xlow, xup, conf = 0.95, nint = 100))
-..gevgpd.diag.fct <- function(z){
+..gevgpd.diag.fct <- function(z, GPD=FALSE, npy=365){
utfe <- untransformed.estimate(z)
if(length(utfe)==2)
param <- ParamFamParameter(main=utfe, nuisance=nuisance(z),
@@ -33,20 +44,59 @@
if(is.null(PFam))
stop("There is no object of class 'ProbFamily' in the call of 'z'")
PFam0 <- modifyModel(PFam, param)
+
+ thresh <- if(GPD) fixed(param) else NULL
x <- eval(es.call$x)
+ n0 <- length(x)
z0 <- list()
+ if(GPD){
+ z0$threshold <- thresh
+ z0$npy <- npy
+ z0$xdata <- x
+ x <- x[x > thresh]
+ }
+
+ z0$data <- x
z0$trans <- FALSE
- z0$model <- list(NULL,NULL,NULL)
- z0$link <- rep("identity",3)
+ z0$model <- if(GPD) list(NULL,NULL) else list(NULL,NULL,NULL)
+ z0$link <- rep("identity",if(GPD) 2 else 3)
z0$conv <- 0
- z0$nllh <- sum(d(PFam0)(x,log=TRUE))
- z0$data <- x
+ z0$nllh <- -sum(d(PFam0)(x,log=TRUE))
+
ml0 <- c(untransformed.estimate(z))
- if(!is.null(fixed(z))) ml0 <- c(fixed(z),ml0)
+
+ if(!GPD){
+ if(!is.null(fixed(z))) ml0 <- c(fixed(z),ml0)
+ nam <- c("loc", "scale", "shape")
+ }else nam <- c("scale", "shape")
+
+ names(ml0) <- nam
z0$mle <- ml0
- z0$cov <- asvar(z)/length(x)
- z0$se <- diag(z0$cov)^.5
- z0$vals <- t(matrix(z0$mle,3,length(x)))
+
+ if (GPD){
+ n <- length(x)
+ z0$nexc <- n
+ z0$n <- n0
+ z0$rate <- n/n0
+ }else n <- n0
+
+ cova <- asvar(z)/n
+ dimnames(cova) <- list(nam,nam)
+ z0$cov <- cova
+
+ se <- diag(z0$cov)^.5
+ names(se) <- nam
+ z0$se <- se
+
+ if(GPD){
+ vals <- cbind(t(matrix(z0$mle,2,n)),rep(thresh,n))
+ dimnames(vals) <- list(NULL, c("","","u"))
+ z0$vals <- vals
+ }else
+ z0$vals <- t(matrix(z0$mle,3,n))
+ if(GPD) z0 <- z0[c(5:7,1,11,4,8,9,16,10,13:15,12,2,3)]
+ else z0 <- z0[c(2:6, 1,7:10)]
+ class(z0) <- if(GPD) "gpd.fit" else "gev.fit"
return(z0)
#ismev::gev.fit(z0)
}
Modified: branches/robast-1.0/pkg/RobExtremes/man/ismevgpdgevdiag-methods.Rd
===================================================================
--- branches/robast-1.0/pkg/RobExtremes/man/ismevgpdgevdiag-methods.Rd 2014-10-05 21:23:40 UTC (rev 789)
+++ branches/robast-1.0/pkg/RobExtremes/man/ismevgpdgevdiag-methods.Rd 2014-10-16 12:10:53 UTC (rev 790)
@@ -29,9 +29,9 @@
\code{gev.profxi}. }
\usage{
-gpd.diag(z)
+gpd.diag(z,...)
\S4method{gpd.diag}{gpd.fit}(z)
-\S4method{gpd.diag}{GPDEstimate}(z)
+\S4method{gpd.diag}{GPDEstimate}(z, npy = 365)
gev.diag(z)
\S4method{gev.diag}{gev.fit}(z)
\S4method{gev.diag}{GEVEstimate}(z)
@@ -43,7 +43,7 @@
\S4method{gev.prof}{GEVEstimate}(z, m, xlow, xup, conf = 0.95, nint = 100)
gpd.profxi(z,...)
\S4method{gpd.profxi}{gpd.fit}(z, xlow, xup, conf = 0.95, nint = 100)
-\S4method{gpd.profxi}{GPDEstimate}(z, xlow, xup, conf = 0.95, nint = 100)
+\S4method{gpd.profxi}{GPDEstimate}(z, xlow, xup, npy = 365, conf = 0.95, nint = 100)
gev.profxi(z,...)
\S4method{gev.profxi}{gev.fit}(z, xlow, xup, conf = 0.95, nint = 100)
\S4method{gev.profxi}{GEVEstimate}(z, xlow, xup, conf = 0.95, nint = 100)
@@ -114,18 +114,30 @@
if(require(ismev)){
## from ismev
data(portpirie)
- ppfit <- gev.fit(portpirie[,2])
+ data(rain)
+
+ detach(package:ismev)
+ ppfit <- ismev::gev.fit(portpirie[,2])
gev.diag(ppfit)
##
mlE <- MLEstimator(portpirie[,2], GEVFamilyMuUnknown(withPos=FALSE))
- RobExtremes::gev.diag(mlE)
+ gev.diag(mlE)
\dontrun{
- RobExtremes::gev.prof(mlE)
- RobExtremes::gev.profxi(mlE)
+ gev.prof(mlE, m = 10, 4.1, 5)
+ gev.profxi(mlE, -0.3, 0.3)
}
-}
+ rnfit <- ismev::gpd.fit(rain,10)
+ gpd.diag(rnfit)
+ ##
+ mlE2 <- MLEstimator(rain[rain>10], GParetoFamily(loc=10))
+ gpd.diag(mlE2)
+ \dontrun{
+ gpd.prof(mlE, m = 10, 55, 77)
+ gpd.profxi(mlE, -0.02, 0.02)
+ }
}
+}
\keyword{graphics}
More information about the Robast-commits
mailing list