[Robast-commits] r479 - in branches/robast-0.9/pkg/RobExtremes: . R man

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Wed May 23 01:57:17 CEST 2012


Author: ruckdeschel
Date: 2012-05-23 01:57:17 +0200 (Wed, 23 May 2012)
New Revision: 479

Added:
   branches/robast-0.9/pkg/RobExtremes/R/PickandsEstimator.R
   branches/robast-0.9/pkg/RobExtremes/R/asvarMedkMAD.R
   branches/robast-0.9/pkg/RobExtremes/R/asvarPickands.R
   branches/robast-0.9/pkg/RobExtremes/man/PickandsEstimator.Rd
   branches/robast-0.9/pkg/RobExtremes/man/asvarMedkMAD.Rd
   branches/robast-0.9/pkg/RobExtremes/man/asvarPickands.Rd
Modified:
   branches/robast-0.9/pkg/RobExtremes/NAMESPACE
   branches/robast-0.9/pkg/RobExtremes/R/GParetoFamily.R
   branches/robast-0.9/pkg/RobExtremes/R/LDEstimator.R
   branches/robast-0.9/pkg/RobExtremes/R/interpolLM.R
   branches/robast-0.9/pkg/RobExtremes/R/interpolSn.R
   branches/robast-0.9/pkg/RobExtremes/R/sysdata.rda
   branches/robast-0.9/pkg/RobExtremes/man/0RobExtremes-package.Rd
   branches/robast-0.9/pkg/RobExtremes/man/GParetoFamily.Rd
   branches/robast-0.9/pkg/RobExtremes/man/LDEstimator.Rd
   branches/robast-0.9/pkg/RobExtremes/man/internal-interpolateLM.Rd
   branches/robast-0.9/pkg/RobExtremes/man/internal-interpolateSn.Rd
Log:
RobExtremes:
new: + PickandsEstimator (incl. as.var)
     + as.var(MedkMAD)
some fixes in generating function to GParetoFamily


Modified: branches/robast-0.9/pkg/RobExtremes/NAMESPACE
===================================================================
--- branches/robast-0.9/pkg/RobExtremes/NAMESPACE	2012-05-22 22:59:49 UTC (rev 478)
+++ branches/robast-0.9/pkg/RobExtremes/NAMESPACE	2012-05-22 23:57:17 UTC (rev 479)
@@ -33,5 +33,5 @@
 export("Gumbel", "Pareto", "GPareto", "GEV")
 export("GParetoFamily", "GumbelLocationFamily")
 export("LDEstimator", "medkMAD", "medSn", "medQn", "medkMADhybr")
-export("getShapeGrid", "getSnGrid")
-export("loc", "loc<-")
\ No newline at end of file
+export("getShapeGrid", "getSnGrid", "PickandsEstimator")
+export("loc", "loc<-", "asvarMedkMAD","asvarPickands")
\ No newline at end of file

Modified: branches/robast-0.9/pkg/RobExtremes/R/GParetoFamily.R
===================================================================
--- branches/robast-0.9/pkg/RobExtremes/R/GParetoFamily.R	2012-05-22 22:59:49 UTC (rev 478)
+++ branches/robast-0.9/pkg/RobExtremes/R/GParetoFamily.R	2012-05-22 23:57:17 UTC (rev 479)
@@ -74,6 +74,7 @@
 
     ## parameters
     names(theta) <- c("loc", "scale", "shape")
+    scaleshapename <- c("scale", "shape")
 
     if(is.null(trafo)){
         tau <- NULL
@@ -337,7 +338,9 @@
         E11 <- sc^-2
         E12 <- (sc*(1+k))^-1
         E22 <- 2/(1+k)
-        return(PosSemDefSymmMatrix(matrix(c(E11,E12,E12,E22)/(1+2*k),2,2)))
+        mat <- PosSemDefSymmMatrix(matrix(c(E11,E12,E12,E22)/(1+2*k),2,2))
+        dimnames(mat) <- list(scaleshapename,scaleshapename)
+        return(mat)
     }
 
     FisherInfo <- FisherInfo.fct(param)
@@ -345,6 +348,7 @@
 
     ## initializing the GPareto family with components of L2-family
     L2Fam <- new("GParetoFamily")
+    L2Fam at scaleshapename <- scaleshapename
     L2Fam at name <- name
     L2Fam at param <- param
     L2Fam at distribution <- distribution

Modified: branches/robast-0.9/pkg/RobExtremes/R/LDEstimator.R
===================================================================
--- branches/robast-0.9/pkg/RobExtremes/R/LDEstimator.R	2012-05-22 22:59:49 UTC (rev 478)
+++ branches/robast-0.9/pkg/RobExtremes/R/LDEstimator.R	2012-05-22 23:57:17 UTC (rev 479)
@@ -138,10 +138,12 @@
 
 
 medkMAD <- function(x, k=1, ParamFamily, q.lo =1e-3, q.up=15, nuis.idx = NULL,
-                        trafo = NULL, fixed = NULL, asvar.fct = NULL, na.rm = TRUE,
+                        trafo = NULL, fixed = NULL, na.rm = TRUE,
                         ...){
       es.call <- match.call()
       if(missing(k)) k <- 1
+      asvar.fct <- function(L2Fam=ParamFamily, param){
+                       asvarMedkMAD(model=L2Fam, k = k)}
       es <- LDEstimator(x, loc.est = median, disp.est = kMAD,
                      loc.fctal = median, disp.fctal = kMAD,
                      ParamFamily = ParamFamily,
@@ -194,13 +196,13 @@
 
 medkMADhybr <- function(x, k=1, ParamFamily, q.lo =1e-3, q.up=15,
                         KK=20, nuis.idx = NULL,
-                        trafo = NULL, fixed = NULL, asvar.fct = NULL, na.rm = TRUE,
+                        trafo = NULL, fixed = NULL,  na.rm = TRUE,
                         ...){
  i <- 1
  es <- try(medkMAD(x, k = k, ParamFamily = ParamFamily,
                             q.lo = q.lo, q.up = q.up,
                             nuis.idx = nuis.idx, trafo = trafo,
-                            fixed = fixed, asvar.fct = asvar.fct, na.rm = na.rm,
+                            fixed = fixed, na.rm = na.rm,
                              ...), silent=TRUE)
  if(! any(is.na(es)) && !is(es,"try-error"))
    {return(es)}
@@ -211,9 +213,11 @@
       es <- try(medkMAD(x, k = k1, ParamFamily = ParamFamily,
                             q.lo = q.lo, q.up = q.up,
                             nuis.idx = nuis.idx, trafo = trafo,
-                            fixed = fixed, asvar.fct = asvar.fct, na.rm = na.rm,
+                            fixed = fixed, na.rm = na.rm,
                              ...), silent=TRUE)
       k1 <- k1 * 3
+      es at asvar.fct <- function(L2Fam=ParamFamily, param){
+                       asvarMedkMAD(model=L2Fam, k = k)}
       if(! any(is.na(es)) && !is(es,"try-error"))
          {return(es)}
       }

Added: branches/robast-0.9/pkg/RobExtremes/R/PickandsEstimator.R
===================================================================
--- branches/robast-0.9/pkg/RobExtremes/R/PickandsEstimator.R	                        (rev 0)
+++ branches/robast-0.9/pkg/RobExtremes/R/PickandsEstimator.R	2012-05-22 23:57:17 UTC (rev 479)
@@ -0,0 +1,80 @@
+.PickandsEstimator <- function(x, alpha = 2){
+ a1 <- 1-1/alpha
+ a2 <- 1-1/alpha^2
+
+ ms <- quantile(x,c(a1,a2))
+ names(ms) <- NULL
+ I <- ms[2]
+ m <- ms[1]
+ xi <- abs( log((I-m)/m)/log(1-a1))
+ beta <- xi*m^2/abs(I-2*m)
+ theta <- c(beta,xi)
+ names(theta) <- c("scale","shape")
+ return(theta)
+}
+
+PickandsEstimator <- function(x, alpha = 2, ParamFamily=GParetoFamily(),
+                        name, Infos, asvar = NULL, nuis.idx = NULL,
+                        trafo = NULL, fixed = NULL, asvar.fct  = NULL, na.rm = TRUE,
+                        ...){
+    if(!is(ParamFamily,"GParetoFamily"))
+         stop("Pickands estimator only available for GPD.")
+    name.est <- "PickandsEstimator"
+    es.call <- match.call()
+    error <- FALSE
+    if(length(alpha)>1 || any(!is.finite(alpha)) || any(alpha<=1))
+       stop("'alpha' has to be a numeric > 1 of length 1.")
+
+    if(missing(name))
+        name <- "Some estimator"
+
+
+    asvar.fct.0 <- function(L2Fam=ParamFamily, param){
+                       asvarPickands(model=L2Fam, alpha = alpha)}
+    asvar.0 <- asvarPickands(model=ParamFamily, alpha = alpha)
+    nuis.idx.0 <- nuis.idx
+    trafo.0 <- trafo
+    fixed.0 <- fixed
+    na.rm.0 <- na.rm
+
+    estimate <- Estimator(x, .PickandsEstimator, name, Infos,
+                      asvar = asvar.0, nuis.idx = nuis.idx.0,
+                      trafo = trafo.0, fixed = fixed.0,
+                      na.rm = na.rm.0, alpha = alpha, ...)
+    if(missing(asvar)) asvar <- NULL
+    if(is.null(asvar))
+       if(!missing(asvar.fct))
+          if(!is.null(asvar.fct))
+             asvar <- asvar.fct(ParamFamily, estimate, alpha = alpha, ...)
+
+    estimate at untransformed.asvar <- asvar
+
+
+    l.e <- length(estimate at untransformed.estimate)
+    idx <- NULL
+    idm <- 1:l.e
+    if(!is.null(nuis.idx))
+        {idx <- nuis.idx
+         idm <- idm[-idx]
+         mat <- diag(length(idm))}
+
+    if(!.isUnitMatrix(estimate at trafo$mat)){
+       estimate at estimate <- estimate at trafo$fct(estimate)
+       if(!is.null(asvar))
+           estimate at asvar <- estimate at trafo$mat%*%asvar[idm,idm]%*%t(estimate at trafo$mat)
+    }
+
+    estimate at estimate.call <- es.call
+
+    if(missing(Infos))
+        Infos <- matrix(c("PickandsEstimator", ""),
+                           ncol=2, dimnames=list(character(0), c("method", "message")))
+    else{
+        Infos <- matrix(c(rep("PickandsEstimator", length(Infos)+1), c("",Infos)),
+                          ncol = 2)
+        colnames(Infos) <- c("method", "message")
+    }
+    estimate at Infos <- Infos
+
+    return(estimate)
+}

Added: branches/robast-0.9/pkg/RobExtremes/R/asvarMedkMAD.R
===================================================================
--- branches/robast-0.9/pkg/RobExtremes/R/asvarMedkMAD.R	                        (rev 0)
+++ branches/robast-0.9/pkg/RobExtremes/R/asvarMedkMAD.R	2012-05-22 23:57:17 UTC (rev 479)
@@ -0,0 +1,81 @@
+asvarMedkMAD <- function( model, k=1){
+  if(! is(model, "L2ScaleShapeUnion"))
+     stop("This function only works for Scale-Shape models")
+
+  scshn <- scaleshapename(model)
+  par0 <- main(model at param)[scshn]
+  beta <- par0[1]; xi <- par0[2]
+
+  M <- kMAD(model at distribution, k=k)
+  m <- q(model)(.5)
+
+  x1.0 <- m - M
+  x2.0 <- m + k * M
+
+  ## joint Variance of median and kMAD, see Serfling Mazumder
+  dmm <- d(model)(x1.0)
+  dmp <- d(model)(x2.0)
+  dm <-  d(model)(m)
+  alpha <- p(model)(m-M)+p(model)(m+k*M)
+  betA <- dmm-dmp
+  ceta <- dmm+k*dmp
+  eta <- betA^2 + 4*(1-alpha)*betA*dm
+
+  g22 <- 1/4/dm^2
+  g12 <- 1/4/dm/ceta*(1-4*p(model)(m-M)+betA/dm)
+  g11 <- 1/4/ceta^2*(1+eta/dm^2)
+
+  V <- matrix(c(g11,g12,g12,g22),2,2)
+
+  if(is(model,"GParetoFamily")){
+      uf <- function(x) 1+xi*x/beta
+      u1.0 <- uf(x1.0)
+      u2.0 <- uf(x2.0)
+      um.0 <- uf(m)
+
+      dfc <- function(u1,u2,s1,s2,fct) s2*fct(u2)-s1*fct(u1)
+
+      uxi <- function(u) u^(-1/xi-1)
+
+      Gxi <- function(u) uxi(u)*(u*(1-log(u))-1)/xi^2
+      Gbet <- function(u) uxi(u)*(1-u)/xi/beta
+      Gx <- function(u) uxi(u)/beta
+
+      dG1_xi  <- dfc(u1=u1.0,u2=u2.0,s1= 1,s2=1,fct=Gxi)
+      dG1_beta <- dfc(u1=u1.0,u2=u2.0,s1= 1,s2=1,fct=Gbet)
+      dG1_M <-   dfc(u1=u1.0,u2=u2.0,s1=-1,s2=k,fct=Gx)
+      dG1_m <-   dfc(u1=u1.0,u2=u2.0,s1= 1,s2=1,fct=Gx)
+
+      dG2_xi  <- Gxi(um.0)
+      dG2_beta <- Gbet(um.0)
+      dG2_M <- 0
+      dG2_m <- Gx(um.0)
+
+      D1 <- matrix(c(dG1_beta,dG2_beta,dG1_xi,dG2_xi),2,2)
+      D2 <- matrix(c(dG1_M,dG2_M,dG1_m,dG2_m),2,2)
+
+      D <- -solve(D1)%*%D2
+  }else{
+   psi_med <- function(x) (0.5-(x<=m))/dm
+   psi_kMad <- function(x){
+       cp <- k*dmp+dmm
+       cm = dmp-dmm
+       return((0.5-((x<=m+k*M)&(x>=m-M)))/cp + cm/cp*((x<=m)-0.5)/dm)
+   }
+
+   L2d <- model at L2deriv[[1]]
+   L_xi.f = function(x) evalRandVar(L2d,x)[2,]
+   L_beta.f = function(x) evalRandVar(L2d,x)[1,]
+
+   E11 <- E(distribution(model),fun=function(x) psi_kMad(x) * L_beta.f(x))
+   E12 <- E(distribution(model),fun=function(x) psi_kMad(x) * L_xi.f(x))
+   E21 <- E(distribution(model),fun=function(x) psi_med(x) * L_beta.f(x))
+   E22 <- E(distribution(model),fun=function(x) psi_med(x) * L_xi.f(x))
+   D <- solve(matrix(c(E11,E21,E12,E22),2,2))
+  }
+
+  ASV_Med <- PosSemDefSymmMatrix(D %*% V %*% t(D))
+  dimnames(ASV_Med) <- list(scshn,scshn)
+  return(ASV_Med)
+}
+

Added: branches/robast-0.9/pkg/RobExtremes/R/asvarPickands.R
===================================================================
--- branches/robast-0.9/pkg/RobExtremes/R/asvarPickands.R	                        (rev 0)
+++ branches/robast-0.9/pkg/RobExtremes/R/asvarPickands.R	2012-05-22 23:57:17 UTC (rev 479)
@@ -0,0 +1,55 @@
+asvarPickands <- function( model, alpha=2){
+
+  if(! is(model, "GParetoFamily"))
+     stop("This function only works for GPD models")
+  scshn <- scaleshapename(model)
+  par0 <- main(model at param)[scshn]
+  beta <- par0[1]; xi <- par0[2]
+
+
+  al1 <- 1-1/alpha
+  al2 <- 1-1/alpha^2
+  M2 <- q(model)(al1)
+  M4 <- q(model)(al2)
+
+  h11 <- -M4/(M2*(M4-M2))/log(alpha)
+  h12 <- 1/(M4-M2)/log(alpha)
+  t1 <- 2*M2*(M4-M2)/(M4-2*M2)^2
+  t2 <- -M2^2/(M4-2*M2)^2
+  h21 <- h11*M2^2/(M4-2*M2) + t1*log((M4-M2)/M2)/log(alpha)
+  h22 <- h12*M2^2/(M4-2*M2) + t2*log((M4-M2)/M2)/log(alpha)
+
+
+  C <- matrix(c(h21,h22,h11,h12),2,2)
+
+#  f1 <- (1-al1)^(1+xi)/beta
+#  f2 <- (1-al2)^(1+xi)/beta
+#  M <- matrix(c(al1-1,al2-1,al1,al2-1,al1,al2),ncol=3)
+#  Werte <- t(C) %*% diag(1/c(f1,f2)) %*% M
+#  GES <- max(colSums(Werte^2)^.5)
+#  GES
+
+  s11 <- al1*(1-al1)^(-1-2*xi)
+  s12 <- al1*(1-al1)^(-1-xi)*(1-al2)^(-xi)
+  s21 <- s12
+  s22 <- al2*(1-al2)^(-1-2*xi)
+
+  S <- beta^2*matrix(c(s11,s12,s21,s22),2,2)
+
+  ASV_Pick <- t(C) %*% S %*% (C)
+  ASV_Pick <- PosSemDefSymmMatrix(ASV_Pick)
+  dimnames(ASV_Pick) <- list(scshn,scshn)
+  return(ASV_Pick)
+}
+
+
+
+
+
+
+
+
+
+
+
+

Modified: branches/robast-0.9/pkg/RobExtremes/R/interpolLM.R
===================================================================
--- branches/robast-0.9/pkg/RobExtremes/R/interpolLM.R	2012-05-22 22:59:49 UTC (rev 478)
+++ branches/robast-0.9/pkg/RobExtremes/R/interpolLM.R	2012-05-22 23:57:17 UTC (rev 479)
@@ -10,7 +10,7 @@
 .RMXE.xi <- function(xi, PFam){
       PFam <- .modify.xi.PFam.call(xi,PFam)
       IC <- radiusMinimaxIC(L2Fam=PFam, neighbor= ContNeighborhood(),
-                            risk = asMSE(), verbose = FALSE)
+                            risk = asMSE(), verbose = TRUE)
       return(c(b=clip(IC), a=cent(IC), a.w = cent(weight(IC)),
                            A=stand(IC),  A.w = stand(weight(IC))))
 }
@@ -47,7 +47,7 @@
                itLM <<- itLM + 1
                if(withPrint) cat("Evaluation Nr.", itLM," at xi = ",xi,"\n")
                a <- try(optFct(xi,PFam), silent=TRUE)
-               if(is(a,"try-error")) a <- rep(NA,14)
+               if(is(a,"try-error")) a <- rep(NA,13)
                return(a)
                }
 
@@ -68,6 +68,7 @@
 
             })
    LMGrid <- sapply(xiGrid,getLM)
+   save("LMGrid.Rdata")
    res <- .MakeGridList(xiGrid, Y=t(LMGrid), withSmooth = withSmooth)
    print(res)
    return(list(grid = res$grid,
@@ -113,16 +114,17 @@
                fct = fct))
 }
 
+.myFolder <- "C:/rtest/RobASt/branches/robast-0.9/pkg/RobExtremes/R"
 .svInt <- function(optF = .RMXE.xi, nam = ".RMXE")
-                  .saveInterpGrid(xiGrid = getShapeGrid(400,
-                  cutoff.at.0=0.005),
+             .saveInterpGrid(xiGrid = getShapeGrid(250,
+                  cutoff.at.0=0.01),
                   PFam = GParetoFamily(shape=1,scale=2),
-                  sysRdaFolder = .myFolder, optFct = optF,
+                  sysRdaFolder=.myFolder, optFct = optF,
                   nameInSysdata = nam, getFun = .getLMGrid,
                   withSmooth = TRUE, withPrint = TRUE)
 
 if(FALSE){
-.myFolder <- "C:/rtest/RobASt/branches/robast-0.9/pkg/ROptEst/R"
+.myFolder <- "C:/rtest/RobASt/branches/robast-0.9/pkg/RobExtremes/R"
 svInt <- RobExtremes:::.svInt;
 .OMSE.xi <- RobExtremes:::.OMSE.xi
 .MBRE.xi <- RobExtremes:::.MBRE.xi
@@ -130,4 +132,34 @@
 .svInt(.OMSE.xi, ".OMSE")
 .svInt(.MBRE.xi, ".MBRE")
 .svInt(.RMXE.xi, ".RMXE")
+
+###  to move it from ROptEst to RobExtremes:
+  oldEnv <- new.env()
+  newEnv <- new.env()
+  oldfolder <- "C:/rtest/RobASt/branches/robast-0.9/pkg/ROptEst/R"
+  newfolder <- "C:/rtest/RobASt/branches/robast-0.9/pkg/RobExtremes/R"
+  sysdataFile.old <- file.path(oldfolder,"sysdata.rda")
+  sysdataFile.new <- file.path(newfolder,"sysdata.rda")
+  cat("sysdataFiles = ", sysdataFile.old,",\n",sysdataFile.new, "\n")
+
+  load(file=sysdataFile.old,envir=oldEnv)
+  load(file=sysdataFile.new,envir=newEnv)
+  whatIsThereAlready.old <- ls(envir=oldEnv, all.names=TRUE)
+  cat("whatIsThereAlready (old) = ", head(whatIsThereAlready.old), "\n")
+
+  whatIsThereAlready.new <- ls(envir=newEnv, all.names=TRUE)
+  cat("whatIsThereAlready (new) = ", head(whatIsThereAlready.new), "\n")
+
+  for(what in whatIsThereAlread.old){
+      assign(get(what, envir=oldEnv), envir=newEnv)
+  }
+  whatIsThereAlready <- ls(envir=newEnv, all.names=TRUE)
+  cat("whatIsThereAlready (now) = ", head(whatIsThereAlready.new), "\n")
+
+  save(list=whatIsThereAlready, file=sysdataFile, envir=newEnv)
+  tools::resaveRdaFiles(newfolder)
+
+  cat(gettextf("%s successfully written to sysdata.rda file.\n",
+            whatIsThereAlready))
+
 }

Modified: branches/robast-0.9/pkg/RobExtremes/R/interpolSn.R
===================================================================
--- branches/robast-0.9/pkg/RobExtremes/R/interpolSn.R	2012-05-22 22:59:49 UTC (rev 478)
+++ branches/robast-0.9/pkg/RobExtremes/R/interpolSn.R	2012-05-22 23:57:17 UTC (rev 479)
@@ -28,7 +28,7 @@
  n.u <- 7*n.d + (gridsize-l.xi.g)%%8
 
  if(n.u>0){
-    p.u <- pnorm((xi.g[l.xi.g]-centralvalue)/fac, lower=FALSE)
+    p.u <- pnorm((xi.g[l.xi.g]-centralvalue)/fac, lower.tail=FALSE)
     p.u2 <- 1-p.u + p.u*(1:n.u)/(n.u+1)
     xi.u <- centralvalue + fac * qnorm(p.u2)
     xi.g <- c(xi.g,xi.u)
@@ -68,6 +68,7 @@
                return(Sn(x=distr, accuracy = accuracy, low=low, upp = upp))
                }
    SnGrid <- sapply(xiGrid,getSn)
+   rm(PFam)
    iNA <- is.na(SnGrid)
    SnGrid <- SnGrid[!iNA]
    xiGrid <- xiGrid[!iNA]

Modified: branches/robast-0.9/pkg/RobExtremes/R/sysdata.rda
===================================================================
(Binary files differ)

Modified: branches/robast-0.9/pkg/RobExtremes/man/0RobExtremes-package.Rd
===================================================================
--- branches/robast-0.9/pkg/RobExtremes/man/0RobExtremes-package.Rd	2012-05-22 22:59:49 UTC (rev 478)
+++ branches/robast-0.9/pkg/RobExtremes/man/0RobExtremes-package.Rd	2012-05-22 23:57:17 UTC (rev 479)
@@ -92,9 +92,13 @@
 \section{Functions}{
 
 \preformatted{
-
-
-
+LDEstimator   Estimators for scale-shape models based on location and dispersion
+medSn                    loc=median disp=Sn
+medQn                    loc=median disp=Qn
+medkMAD                  loc=median disp=kMAD
+asvarMedkMAD               [asy. variance to MedkMADE]
+PickandsEstimator        PickandsEstimator
+asvarPickands              [asy. variance to PickandsE]
 }}
 
 \section{Generating Functions}{
@@ -128,10 +132,16 @@
 Qn                     Generic functions for the computation of
                         functionals
 
-
 }
 }
+\section{Constants}{
+\preformatted{
 
+EULERMASCHERONICONSTANT
+APERYCONSTANT
+
+}}
+
 \section{Start-up-Banner}{
 You may suppress the start-up banner/message completely by setting 
 \code{options("StartupBanner"="off")} somewhere before loading this package by 

Modified: branches/robast-0.9/pkg/RobExtremes/man/GParetoFamily.Rd
===================================================================
--- branches/robast-0.9/pkg/RobExtremes/man/GParetoFamily.Rd	2012-05-22 22:59:49 UTC (rev 478)
+++ branches/robast-0.9/pkg/RobExtremes/man/GParetoFamily.Rd	2012-05-22 23:57:17 UTC (rev 479)
@@ -49,7 +49,7 @@
         Peter Ruckdeschel \email{peter.ruckdeschel at itwm.fraunhofer.de}\cr
         Nataliya Horbenko \email{nataliya.horbenko at itwm.fraunhofer.de}}
 %\note{}
-\seealso{\code{\link{[distrMod:L2ParamFamily-class]L2ParamFamily-class}}, \code{\link{GPareto-class}}}
+\seealso{\code{\link{[distrMod:"L2ParamFamily-class"]L2ParamFamily-class}}, \code{\link{GPareto-class}}}
 \examples{
 (G1 <- GParetoFamily())
 FisherInfo(G1)

Modified: branches/robast-0.9/pkg/RobExtremes/man/LDEstimator.Rd
===================================================================
--- branches/robast-0.9/pkg/RobExtremes/man/LDEstimator.Rd	2012-05-22 22:59:49 UTC (rev 478)
+++ branches/robast-0.9/pkg/RobExtremes/man/LDEstimator.Rd	2012-05-22 23:57:17 UTC (rev 479)
@@ -22,10 +22,10 @@
             trafo = NULL, fixed = NULL, asvar.fct  = NULL, na.rm = TRUE,
             ...)
 medkMAD(x, k=1, ParamFamily, q.lo =1e-3, q.up=15, nuis.idx = NULL,
-        trafo = NULL, fixed = NULL, asvar.fct = NULL, na.rm = TRUE,
+        trafo = NULL, fixed = NULL, na.rm = TRUE,
         ...)
 medkMADhybr(x, k=1, ParamFamily, q.lo =1e-3, q.up=15, KK = 20, nuis.idx = NULL,
-        trafo = NULL, fixed = NULL, asvar.fct = NULL, na.rm = TRUE,
+        trafo = NULL, fixed = NULL, na.rm = TRUE,
         ...)
 medSn(x, ParamFamily, q.lo =1e-3, q.up=10, nuis.idx = NULL,
       trafo = NULL, fixed = NULL, asvar.fct = NULL, na.rm = TRUE,
@@ -58,7 +58,8 @@
                         for the location functional. }
   \item{disp.fctal.ctrl}{a list (or \code{NULL}); optional additional arguments
                         for the dispersion functional.  }
-  \item{k}{numeric; additional parameter for \code{\link{kMAD}}. }
+  \item{k}{numeric; additional parameter for \code{\link{kMAD}}; must be positive
+           and of length 1.}
   \item{KK}{numeric; Maximal number of trials with different \code{k} in
    \code{medkMADhybr} . }
   \item{q.lo}{numeric; lower bound for search intervall in shape parameter. }

Added: branches/robast-0.9/pkg/RobExtremes/man/PickandsEstimator.Rd
===================================================================
--- branches/robast-0.9/pkg/RobExtremes/man/PickandsEstimator.Rd	                        (rev 0)
+++ branches/robast-0.9/pkg/RobExtremes/man/PickandsEstimator.Rd	2012-05-22 23:57:17 UTC (rev 479)
@@ -0,0 +1,74 @@
+\name{PickandsEstimator}
+\alias{PickandsEstimator}
+\alias{.PickandsEstimator}
+
+\title{ Function to compute Pickands estimates for the GPD}
+\description{
+  Function \code{PickandsEstimator} computes Pickands estimator
+  (for the GPD) at real data and returns an object of class \code{Estimate}.
+}
+\usage{
+PickandsEstimator(x, alpha=2, ParamFamily=GParetoFamily(),
+            name, Infos, asvar = NULL, nuis.idx = NULL,
+            trafo = NULL, fixed = NULL, asvar.fct  = NULL, na.rm = TRUE,
+            ...)
+.PickandsEstimator(x, alpha=2)
+}
+\arguments{
+  \item{x}{ (empirical) data }
+  \item{alpha}{ numeric > 1; determines the variant of the Pickands-Estimator
+   based on matching the empirical \eqn{a_1=1-1/\alpha}{a1=1-1/alpha} and
+   \eqn{a_1=1-1/\alpha^2}{a1=1-1/alpha^2} quantiles against the
+   population counter parts. The ``classical'' Pickands Estimator is
+   obtained for \code{alpha=2}. }
+  \item{ParamFamily}{an object of class \code{"GParetoFamily"}. }
+  \item{name}{ optional name for estimator. }
+  \item{Infos}{ character: optional informations about estimator }
+  \item{asvar}{ optionally the asymptotic (co)variance of the estimator }
+  \item{nuis.idx}{ optionally the indices of the estimate belonging
+                  to nuisance parameter}
+  \item{fixed}{ optionally (numeric) the fixed part of the parameter}
+  \item{trafo}{ an object of class \code{MatrixorFunction} -- a transformation
+  for the main parameter}
+  \item{asvar.fct}{optionally: a function to determine the corresponding
+    asymptotic variance; if given, \code{asvar.fct} takes arguments
+    \code{L2Fam}((the parametric model as object of class \code{L2ParamFamily})) 
+    and \code{param} (the parameter value as object of class 
+    \code{ParamFamParameter}); arguments are called by name; \code{asvar.fct}
+     may also process further arguments passed through the \code{\dots} argument}              
+  \item{na.rm}{logical: if  \code{TRUE}, the estimator is evaluated at \code{complete.cases(x)}.}
+  \item{\dots}{not yet used. }
+}
+\details{
+  The actual work is done in \code{.PickandsEstimator}.
+  The wrapper \code{PickandsEstimator} pre-treats the data,
+  and constructs a respective \code{Estimate} object.
+}
+\value{
+  \item{.PickandsEstimator}{A numeric vector of length \code{2} with components
+   named \code{scale} and \code{shape}. }
+  \item{PickandsEstimator}{An object of S4-class \code{"Estimate"}. }
+}
+\references{
+P. Ruckdeschel, N. Horbenko (2011): Yet another breakdown point notion:
+EFSBP --illustrated at scale-shape models. ArXiv 1005.1480. To appear at Metrika.
+DOI: 10.1007/s00184-011-0366-4.
+
+}
+
+%\references{  }
+\author{Nataliya Horbenko \email{Nataliya.Horbenko at itwm.fraunhofer.de},\cr
+        Peter Ruckdeschel \email{Peter.Ruckdeschel at itwm.fraunhofer.de}}
+%\note{}
+\seealso{\code{\link{ParamFamily-class}}, \code{\link{ParamFamily}}, 
+         \code{\link{Estimate-class}} }
+\examples{
+## (empirical) Data
+x <- rgpd(50, scale = 0.5, shape = 3)
+
+## parametric family of probability measures
+G <- GParetoFamily(scale = 1, shape = 2)
+
+PickandsEstimator(x = x, ParamFamily = G)
+}
+\keyword{univar}

Added: branches/robast-0.9/pkg/RobExtremes/man/asvarMedkMAD.Rd
===================================================================
--- branches/robast-0.9/pkg/RobExtremes/man/asvarMedkMAD.Rd	                        (rev 0)
+++ branches/robast-0.9/pkg/RobExtremes/man/asvarMedkMAD.Rd	2012-05-22 23:57:17 UTC (rev 479)
@@ -0,0 +1,44 @@
+\name{asvarMedkMAD}
+\alias{asvarMedkMAD}
+
+\title{ Function to compute asymptotic variance of MedkMAD estimator}
+\description{
+  Function \code{asvarMedkMAD} computes the asymptotic (co)variance of
+  a MedkMAD estimator at a Scale-Shape model.
+}
+\usage{
+asvarMedkMAD( model, k=1)
+}
+\arguments{
+  \item{model}{an object of class \code{"ScaleShapeUnion"}. }
+  \item{k}{numeric (>0); additional parameter for \code{\link{kMAD}}. }
+}
+\details{
+For the Generalized Pareto Family all terms are analytic; in case
+of the general scale-shape model, numerical integration is used.
+}
+\value{
+  A 2x2 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}.
+DOI: 10.1080/02331888.2011.628022. \cr
+
+}
+
+%\references{  }
+\author{Peter Ruckdeschel \email{Peter.Ruckdeschel at itwm.fraunhofer.de}}
+%\note{}
+\seealso{\code{\link{LDEstimator}} }
+\examples{
+GP <- GParetoFamily(scale=1,shape=0.7)
+asvarMedkMAD(GP,k=1)
+
+## for didactical purposes turn GP into a non-GPD
+setClass("noGP",contains="L2ScaleShapeUnion")
+GP2 <- GP
+class(GP2) <- "noGP"
+asvarMedkMAD(GP2,k=1) ### uses numerical integration
+}
+\keyword{asymptotic variance}

Added: branches/robast-0.9/pkg/RobExtremes/man/asvarPickands.Rd
===================================================================
--- branches/robast-0.9/pkg/RobExtremes/man/asvarPickands.Rd	                        (rev 0)
+++ branches/robast-0.9/pkg/RobExtremes/man/asvarPickands.Rd	2012-05-22 23:57:17 UTC (rev 479)
@@ -0,0 +1,42 @@
+\name{asvarPickands}
+\alias{asvarPickands}
+
+\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 model.
+}
+\usage{
+asvarPickands( model, alpha=2)
+}
+\arguments{
+  \item{model}{an object of class \code{"ScaleShapeUnion"}. }
+  \item{alpha}{ numeric > 1; determines the variant of the Pickands-Estimator
+   based on matching the empirical \eqn{a_1=1-1/\alpha}{a1=1-1/alpha} and
+   \eqn{a_1=1-1/\alpha^2}{a1=1-1/alpha^2} quantiles against the
+   population counter parts. The ``classical'' Pickands Estimator is
+   obtained for \code{alpha=2}. }
+}
+\details{
+All terms are analytic.
+}
+\value{
+  A 2x2 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}.
+DOI: 10.1080/02331888.2011.628022. \cr
+
+}
+
+%\references{  }
+\author{Peter Ruckdeschel \email{Peter.Ruckdeschel at itwm.fraunhofer.de}}
+%\note{}
+\seealso{\code{\link{PickandsEstimator}} }
+\examples{
+GP <- GParetoFamily(scale=1,shape=0.7)
+asvarPickands(GP)
+asvarPickands(GP,alpha=2.3)
+}
+\keyword{asymptotic variance}

Modified: branches/robast-0.9/pkg/RobExtremes/man/internal-interpolateLM.Rd
===================================================================
--- branches/robast-0.9/pkg/RobExtremes/man/internal-interpolateLM.Rd	2012-05-22 22:59:49 UTC (rev 478)
+++ branches/robast-0.9/pkg/RobExtremes/man/internal-interpolateLM.Rd	2012-05-22 23:57:17 UTC (rev 479)
@@ -23,7 +23,7 @@
 .OMSE.xi(xi, PFam)
 
 .getLMGrid(xiGrid = getShapeGrid(),
-                      PFam = GParetoFamily(scale=1),
+                      PFam = GParetoFamily(scale=1, shape=2),
                       optFct = .RMXE.xi,
                       withSmooth = TRUE,
                       withPrint = FALSE)

Modified: branches/robast-0.9/pkg/RobExtremes/man/internal-interpolateSn.Rd
===================================================================
--- branches/robast-0.9/pkg/RobExtremes/man/internal-interpolateSn.Rd	2012-05-22 22:59:49 UTC (rev 478)
+++ branches/robast-0.9/pkg/RobExtremes/man/internal-interpolateSn.Rd	2012-05-22 23:57:17 UTC (rev 479)
@@ -66,7 +66,8 @@
 \examples{
 \dontrun{
 ### code to produce grid for GPareto:
-RobExtremes:::.saveInterpGrid(sysRdaFolder =
+RobExtremes:::.saveInterpGrid(getShapeGrid(gridsize=500,
+                  cutoff.at.0=0.005),sysRdaFolder =
         "C:/rtest/RobASt/branches/robast-0.9/pkg/RobExtremes/R",
               accuracy = 5000,upp=10)
 }



More information about the Robast-commits mailing list