[Robast-commits] r480 - branches/robast-0.9/pkg/RobExtremes/R

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Wed May 23 02:07:31 CEST 2012


Author: ruckdeschel
Date: 2012-05-23 02:07:31 +0200 (Wed, 23 May 2012)
New Revision: 480

Modified:
   branches/robast-0.9/pkg/RobExtremes/R/LDEstimator.R
   branches/robast-0.9/pkg/RobExtremes/R/PickandsEstimator.R
Log:
...and yet some correction as to variances

Modified: branches/robast-0.9/pkg/RobExtremes/R/LDEstimator.R
===================================================================
--- branches/robast-0.9/pkg/RobExtremes/R/LDEstimator.R	2012-05-22 23:57:17 UTC (rev 479)
+++ branches/robast-0.9/pkg/RobExtremes/R/LDEstimator.R	2012-05-23 00:07:31 UTC (rev 480)
@@ -144,6 +144,7 @@
       if(missing(k)) k <- 1
       asvar.fct <- function(L2Fam=ParamFamily, param){
                        asvarMedkMAD(model=L2Fam, k = k)}
+      asvar <- asvarMedkMAD(model=ParamFamily, k = k)
       es <- LDEstimator(x, loc.est = median, disp.est = kMAD,
                      loc.fctal = median, disp.fctal = kMAD,
                      ParamFamily = ParamFamily,
@@ -152,7 +153,7 @@
                      disp.fctal.ctrl=list(k=k),
                      q.lo =q.lo, q.up=q.up, log.q=TRUE,
                      name = "medkMAD", Infos="medkMAD",
-                     asvar = NULL, nuis.idx = nuis.idx, trafo = trafo, fixed = fixed,
+                     asvar = asvar, nuis.idx = nuis.idx, trafo = trafo, fixed = fixed,
                      asvar.fct = asvar.fct, na.rm = na.rm, ...)
       es at estimate.call <- es.call
       return(es)

Modified: branches/robast-0.9/pkg/RobExtremes/R/PickandsEstimator.R
===================================================================
--- branches/robast-0.9/pkg/RobExtremes/R/PickandsEstimator.R	2012-05-22 23:57:17 UTC (rev 479)
+++ branches/robast-0.9/pkg/RobExtremes/R/PickandsEstimator.R	2012-05-23 00:07:31 UTC (rev 480)
@@ -22,6 +22,7 @@
     name.est <- "PickandsEstimator"
     es.call <- match.call()
     error <- FALSE
+    if(missing(alpha)) alpha <- 2
     if(length(alpha)>1 || any(!is.finite(alpha)) || any(alpha<=1))
        stop("'alpha' has to be a numeric > 1 of length 1.")
 
@@ -31,23 +32,18 @@
 
     asvar.fct.0 <- function(L2Fam=ParamFamily, param){
                        asvarPickands(model=L2Fam, alpha = alpha)}
-    asvar.0 <- asvarPickands(model=ParamFamily, alpha = alpha)
+    asvar <- 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,
+                      asvar = asvar, 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
+    estimate at untransformed.asvar <- asvar(estimate)
 
 
     l.e <- length(estimate at untransformed.estimate)



More information about the Robast-commits mailing list