[Robast-commits] r1248 - in branches/robast-1.3/pkg/RobExtremes: R inst man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Jan 25 19:04:13 CET 2023
Author: ruckdeschel
Date: 2023-01-25 19:04:13 +0100 (Wed, 25 Jan 2023)
New Revision: 1248
Modified:
branches/robast-1.3/pkg/RobExtremes/R/PickandsEstimator.R
branches/robast-1.3/pkg/RobExtremes/R/asvarPickands.R
branches/robast-1.3/pkg/RobExtremes/inst/NEWS
branches/robast-1.3/pkg/RobExtremes/man/PickandsEstimator.Rd
branches/robast-1.3/pkg/RobExtremes/man/asvarPickands.Rd
Log:
triggered by a mail by mekontsodimitri at gmail.com, we enhanced PickandsEstimator();
(a) it no longer requires the location parameter to be 0
and (b) it now also can be applied to GEVFamilyMuUnknown models.
Modified: branches/robast-1.3/pkg/RobExtremes/R/PickandsEstimator.R
===================================================================
--- branches/robast-1.3/pkg/RobExtremes/R/PickandsEstimator.R 2023-01-25 12:53:43 UTC (rev 1247)
+++ branches/robast-1.3/pkg/RobExtremes/R/PickandsEstimator.R 2023-01-25 18:04:13 UTC (rev 1248)
@@ -42,13 +42,15 @@
...){
force(ParamFamily)
isGP <- is(ParamFamily,"GParetoFamily")
- if(!(isGP|is(ParamFamily,"GEVFamily")))
+ isGEV.mu <- is(ParamFamily,"GEVFamilyMuUnknown")
+ if(!(isGP|isGEV.mu|is(ParamFamily,"GEVFamily")))
stop("Pickands estimator only available for GPD and GEVD.")
es.call <- match.call()
if(missing(alpha)) alpha <- if(isGP) 2 else 2.248
if(length(alpha)>1 || any(!is.finite(alpha)) || any(alpha<=1))
stop("'alpha' has to be a numeric > 1 of length 1.")
-
+
+ if(isGEV.mu){mu.est <- quantile(x,exp(-1))}
if(missing(name))
name <- "PickandsEstimator"
@@ -59,9 +61,20 @@
if(is.null(fixed)) fixed <- fixed(ParamFamily)
fixed.0 <- fixed
na.rm.0 <- na.rm
- cent <- if(isGP) fixed else 0
- .mPick <- function(x) .PickandsEstimator(x-cent,alpha=alpha, GPD.l=isGP)
- estimate <- Estimator(x, .mPick, name, Infos,
+ cent <- if(!isGEV.mu) fixed else mu.est
+ .mPick <- if(!isGEV.mu){ function(x) .PickandsEstimator(x-cent,alpha=alpha, GPD.l=isGP)
+ }else{ function(x){
+ .mPick0 <- numeric(3)
+ .mPick0[2:3] <- .PickandsEstimator(x-cent,alpha=alpha, GPD.l=isGP)
+ .mPick0[1] <- mu.est
+ names(.mPick0) <- c("loc","scale","shape")
+ return(.mPick0)}}
+ if(isGEV.mu){para0 <- param(ParamFamily)
+ main(para0)["loc"] <- mu.est
+ ParamFamily at param <- para0
+ }
+
+ estimate <- Estimator(x, .mPick, name, Infos,
asvar.fct = asvar.fct.0, asvar = NULL,
nuis.idx = nuis.idx.0, trafo = trafo.0,
fixed = fixed.0, na.rm = na.rm.0, ...,
Modified: branches/robast-1.3/pkg/RobExtremes/R/asvarPickands.R
===================================================================
--- branches/robast-1.3/pkg/RobExtremes/R/asvarPickands.R 2023-01-25 12:53:43 UTC (rev 1247)
+++ branches/robast-1.3/pkg/RobExtremes/R/asvarPickands.R 2023-01-25 18:04:13 UTC (rev 1248)
@@ -1,7 +1,8 @@
asvarPickands <- function(model, alpha=2){
isGP <- is(model,"GParetoFamily")
- if(!(isGP|is(model,"GEVFamily")))
+ isGEV.mu <- is(model,"GEVFamilyMuUnknown")
+ if(!(isGP|isGEV.mu|is(model,"GEVFamily")))
stop("Pickands estimator only available for GPD and GEVD.")
scshn <- scaleshapename(model)
@@ -16,7 +17,8 @@
al2 <- exp(-1/alpha^2)
}
- c0 <- fixed(param(model))
+
+ c0 <- if(isGEV.mu) main(param(model))["loc"] else fixed(param(model))
M2 <- q.l(model)(al1)-c0
M4 <- q.l(model)(al2)-c0
@@ -67,13 +69,29 @@
s22 <- al2^(-1)*(1-al2)*(-log(al2))^(-2-2*xi)
}
S <- beta^2*matrix(c(s11,s12,s21,s22),2,2)
-
+ if(isGEV.mu){
+ ## var = a1(1-a2)/a1 /a2 * (log(a1)log(a2))^(-(1+xi)) * sig^2
+ ## = (1/a2-1) (log(a1)log(a2))^(-(1+xi)) * sig^2
+ ## [a1=a2=exp(-1)] = exp(1)-1
+ s31 <- exp(1)-1
+ s32 <- al1^(-1)*(1-al1)*(-log(al1))^(-1-1*xi)
+ s33 <- al2^(-1)*(1-al2)*(-log(al2))^(-1-1*xi)
+ S0 <- C0 <- matrix(NA,3,3)
+ S0[,1] <- S0[1,] <- c(s31,s32,s33)*beta^2
+ S0[2:3,2:3] <- S
+ S <- S0
+ C0[1,] <- C0[,1] <- c(1,0,0)
+ C0[2:3,2:3] <- C
+ C <- C0
+ }
ASV_Pick <- t(C) %*% S %*% (C)
ASV_Pick <- PosSemDefSymmMatrix(ASV_Pick)
- dimnames(ASV_Pick) <- list(scshn,scshn)
+ dimnames(ASV_Pick) <- if(isGEV.mu)
+ list(c("loc",scshn),c("loc",scshn)) else list(scshn,scshn)
return(ASV_Pick)
}
+
asvarQBCC <- function(model, p1 = 1/3, p2= 2/3){
if(!(is(model,"WeibullFamily")))
@@ -123,4 +141,3 @@
-
Modified: branches/robast-1.3/pkg/RobExtremes/inst/NEWS
===================================================================
--- branches/robast-1.3/pkg/RobExtremes/inst/NEWS 2023-01-25 12:53:43 UTC (rev 1247)
+++ branches/robast-1.3/pkg/RobExtremes/inst/NEWS 2023-01-25 18:04:13 UTC (rev 1248)
@@ -16,7 +16,9 @@
argument propagate.names in our functionals controlling whether names
obtained from parameter coordinates should be propagated to return values
of specific S4 methods for functionals for Gumbel, GEV, GPD, Pareto
-+ PickandsEstimator() no longer requires the location parameter to be 0
++ triggered by a mail by mekontsodimitri at gmail.com, we enhanced PickandsEstimator();
+ (a) it no longer requires the location parameter to be 0
+ and (b) it now also can be applied to GEVFamilyMuUnknown models.
under the hood
+ fixed some broken URLs and changed URLs from http to https where possible
Modified: branches/robast-1.3/pkg/RobExtremes/man/PickandsEstimator.Rd
===================================================================
--- branches/robast-1.3/pkg/RobExtremes/man/PickandsEstimator.Rd 2023-01-25 12:53:43 UTC (rev 1247)
+++ branches/robast-1.3/pkg/RobExtremes/man/PickandsEstimator.Rd 2023-01-25 18:04:13 UTC (rev 1248)
@@ -27,7 +27,7 @@
and for \code{alpha = 1/log(2)} for the GEVD.
If \code{alpha} is missing we set it to the optimal value (see note below).}
\item{ParamFamily}{an object of class \code{"GParetoFamily"} or
- \code{"GEVFamily"}. }
+ \code{"GEVFamily"} or \code{"GEVFamilyMuUnknown"}. }
\item{name}{ optional name for estimator. }
\item{Infos}{ character: optional informations about estimator }
\item{nuis.idx}{ optionally the indices of the estimate belonging
@@ -71,7 +71,10 @@
\eqn{\alpha=1/\log(2)}{alpha=1/log(2)} in the GEVD) in our setting gives
bdp's of \eqn{1/4} and \eqn{0.119} for GPD and GEVD, respectively, and
in the original setting, at \eqn{\xi=0.7}{xi=0.7}, gives bdp's
-\eqn{0.064} and \eqn{0.023}.
+\eqn{0.064} and \eqn{0.023}. In case the estimator is applied to
+a \code{ParamFamily} of class \code{GEVFamilyMuUnknown}, for the
+location parameter, we return the empirical \eqn{\exp(-1)}{exp(-1)} quantile,
+while scale and shape are computed as above; in this case, we return a 3x3 covariance matrix.
}
\value{
\item{.PickandsEstimator}{A numeric vector of length \code{2} with components
Modified: branches/robast-1.3/pkg/RobExtremes/man/asvarPickands.Rd
===================================================================
--- branches/robast-1.3/pkg/RobExtremes/man/asvarPickands.Rd 2023-01-25 12:53:43 UTC (rev 1247)
+++ branches/robast-1.3/pkg/RobExtremes/man/asvarPickands.Rd 2023-01-25 18:04:13 UTC (rev 1248)
@@ -4,7 +4,8 @@
\title{ Function to compute asymptotic variance of Pickands estimator}
\description{
Function \code{asvarPickands} computes the asymptotic (co)variance of
- a Pickands estimator at a GPD or GEVD model.
+ a Pickands estimator at a GPD or GEVD model -- the latter with location
+ mu known or unknown.
}
\usage{
asvarPickands( model, alpha=2)
@@ -21,13 +22,12 @@
All terms are analytic.
}
\value{
- A 2x2 matrix; the covariance. }
+ A 2x2 matrix (resp., for mu unknown in the GEV model a 3x3 matrix); the covariance. }
\references{
-Ruckdeschel, P. and Horbenko, N. (2011): Optimally-Robust Estimators in Generalized
-Pareto Models. ArXiv 1005.1476. To appear at \emph{Statistics}.
+Ruckdeschel, P. and Horbenko, N. (2013): Optimally-Robust Estimators in Generalized
+Pareto Models. \emph{Statistics} 47(4), 762--791.
DOI: 10.1080/02331888.2011.628022. \cr
-
}
%\references{ }
@@ -38,5 +38,10 @@
GP <- GParetoFamily(scale=1,shape=0.7)
asvarPickands(GP)
asvarPickands(GP,alpha=2.3)
+GE <- GEVFamily(loc=0,scale=1,shape=0.7)
+asvarPickands(GE)
+GE0 <- GEVFamilyMuUnknown(loc=0,scale=1,shape=0.7)
+asvarPickands(GE0)
+
}
\keyword{asymptotic variance}
More information about the Robast-commits
mailing list