[Robast-commits] r605 - in branches/robast-0.9/pkg/RobExtremes: . R inst/AddMaterial/interpolation man

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Wed Feb 13 23:57:00 CET 2013


Author: ruckdeschel
Date: 2013-02-13 23:57:00 +0100 (Wed, 13 Feb 2013)
New Revision: 605

Added:
   branches/robast-0.9/pkg/RobExtremes/R/ParetoFamily.R
   branches/robast-0.9/pkg/RobExtremes/man/ParetoFamily.Rd
Modified:
   branches/robast-0.9/pkg/RobExtremes/NAMESPACE
   branches/robast-0.9/pkg/RobExtremes/R/AllClass.R
   branches/robast-0.9/pkg/RobExtremes/R/AllGeneric.R
   branches/robast-0.9/pkg/RobExtremes/R/AllInitialize.R
   branches/robast-0.9/pkg/RobExtremes/R/GEVFamily.R
   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/WeibullFamily.R
   branches/robast-0.9/pkg/RobExtremes/R/recomputeInterpolators.R
   branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/checkSn.R
   branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/interpolationscripts.R
   branches/robast-0.9/pkg/RobExtremes/man/GEVFamily.Rd
   branches/robast-0.9/pkg/RobExtremes/man/GParetoFamily.Rd
   branches/robast-0.9/pkg/RobExtremes/man/InternalReturnClasses-class.Rd
   branches/robast-0.9/pkg/RobExtremes/man/WeibullFamily.Rd
   branches/robast-0.9/pkg/RobExtremes/man/internal-interpolate.Rd
   branches/robast-0.9/pkg/RobExtremes/man/validParameter-methods.Rd
Log:
RobExtremes: several bug fixes & enhancements:
+ new Family: ParetoFamily 
+ GEVFamily, ParetoFamily, WeibullFamily, GParetoFamily now have optional arguments
  * withCentL2 = FALSE (should L2deriv be numerically centered?
        -> formerly this was done automatically, and there was an error as the distribution
            under which centering was done was not the same (parameter) as the one to which
            L2deriv was calculated
  * withL2derivDistr: for GEVFamily, WeibullFamily, GParetoFamily this involves calls to 
         imageDistr (hence random samples and calls to density()...) which was very costly
         now by default is skipped in slot call but not in direct calls
+ fixed error in initialize for Pareto-distribution (no lower endpoint was set)
+ .mergeF and .recomputeInterpolators gain functionality to skip grids when merging/recomputing
+ GEVFamily is now exported
+ new S4-method .loc to center GParetoFamily and GEVFamily objects in LDEstimators
+ minor changes in interpolation scripts
still warning in R CMD Check R-devel 

* checking for unstated dependencies in tests ... WARNING
'library' or 'require' call not declared from: 'RUnit'
* checking tests ...
** running tests for arch 'i386' OK
  Running 'doRUnit.R'
** running tests for arch 'x64' OK
  Running 'doRUnit.R'
   

    

Modified: branches/robast-0.9/pkg/RobExtremes/NAMESPACE
===================================================================
--- branches/robast-0.9/pkg/RobExtremes/NAMESPACE	2013-02-12 11:17:27 UTC (rev 604)
+++ branches/robast-0.9/pkg/RobExtremes/NAMESPACE	2013-02-13 22:57:00 UTC (rev 605)
@@ -11,7 +11,8 @@
 			  "GEVParameter",
 			  "LDEstimate")
 exportClasses("Gumbel", "Pareto", "GPareto", "GEV")
-exportClasses("GParetoFamily", "GumbelLocationFamily", "WeibullFamily")
+exportClasses("GParetoFamily", "GumbelLocationFamily", "WeibullFamily",
+              "ParetoFamily", "GEVFamily")
 exportClasses("DistributionsIntegratingByQuantiles")
 exportMethods("initialize", "show") 
 exportMethods("loc", "loc<-", "kMAD", "Sn", "Qn")
@@ -26,7 +27,8 @@
 
 export("EULERMASCHERONICONSTANT","APERYCONSTANT")
 export("Gumbel", "Pareto", "GPareto", "GEV")
-export("GParetoFamily", "GumbelLocationFamily", "WeibullFamily", "GEVFamily")
+export("GParetoFamily", "GumbelLocationFamily", "WeibullFamily", "GEVFamily",
+       "ParetoFamily")
 export("LDEstimator", "medkMAD", "medSn", "medQn", "medkMADhybr")
 export("getShapeGrid", "getSnGrid", 
        "PickandsEstimator","QuantileBCCEstimator")

Modified: branches/robast-0.9/pkg/RobExtremes/R/AllClass.R
===================================================================
--- branches/robast-0.9/pkg/RobExtremes/R/AllClass.R	2013-02-12 11:17:27 UTC (rev 604)
+++ branches/robast-0.9/pkg/RobExtremes/R/AllClass.R	2013-02-13 22:57:00 UTC (rev 605)
@@ -239,6 +239,7 @@
 
 
 ## models:
+setClass("ParetoFamily", contains="L2ParamFamily")
 setClass("GParetoFamily", contains="L2ScaleShapeUnion")
 setClass("GEVFamily", contains="L2ScaleShapeUnion")
 setClass("WeibullFamily", contains="L2ScaleShapeUnion")

Modified: branches/robast-0.9/pkg/RobExtremes/R/AllGeneric.R
===================================================================
--- branches/robast-0.9/pkg/RobExtremes/R/AllGeneric.R	2013-02-12 11:17:27 UTC (rev 604)
+++ branches/robast-0.9/pkg/RobExtremes/R/AllGeneric.R	2013-02-13 22:57:00 UTC (rev 605)
@@ -24,3 +24,7 @@
 if(!isGeneric("dispersion")){
    setGeneric("dispersion", function(object, ...) standardGeneric("dispersion"))
 }
+
+if(!isGeneric(".loc")){
+   setGeneric(".loc", function(L2Fam, ...) standardGeneric(".loc"))
+}

Modified: branches/robast-0.9/pkg/RobExtremes/R/AllInitialize.R
===================================================================
--- branches/robast-0.9/pkg/RobExtremes/R/AllInitialize.R	2013-02-12 11:17:27 UTC (rev 604)
+++ branches/robast-0.9/pkg/RobExtremes/R/AllInitialize.R	2013-02-13 22:57:00 UTC (rev 605)
@@ -81,8 +81,8 @@
                                       
                         q1 <- qpareto1(p0, shape = shapeSub,  min =  MinSub, 
                                     lower.tail = lower.tail, log.p = log.p) 
-                        q1[i0] <- if(lower.tail) -Inf else Inf
-                        q1[i1] <- if(!lower.tail) -Inf else Inf
+                        q1[i0] <- if(lower.tail) MinSub else Inf
+                        q1[i1] <- if(!lower.tail) MinSub else Inf
                         q1[in01] <- NaN
                         
                         return(q1)  

Modified: branches/robast-0.9/pkg/RobExtremes/R/GEVFamily.R
===================================================================
--- branches/robast-0.9/pkg/RobExtremes/R/GEVFamily.R	2013-02-12 11:17:27 UTC (rev 604)
+++ branches/robast-0.9/pkg/RobExtremes/R/GEVFamily.R	2013-02-13 22:57:00 UTC (rev 605)
@@ -135,7 +135,9 @@
 GEVFamily <- function(loc = 0, scale = 1, shape = 0.5,
                           of.interest = c("scale", "shape"),
                           p = NULL, N = NULL, trafo = NULL,
-                          start0Est = NULL, withPos = TRUE){
+                          start0Est = NULL, withPos = TRUE,
+                          withCentL2 = FALSE,
+                          withL2derivDistr  = FALSE){
     theta <- c(loc, scale, shape)
 
     of.interest <- .pretreat.of.interest(of.interest,trafo)
@@ -290,10 +292,13 @@
          return(y)
         }
         ## additional centering of scores to increase numerical precision!
-        suppressWarnings({
-        z1 <- E(distribution, fun=Lambda1)
-        z2 <- E(distribution, fun=Lambda2)
-        })
+        if(withCentL2){
+           dist0 <- GEV(scale = sc, shape = k, loc = tr)
+           suppressWarnings({
+             z1 <- E(dist0, fun=Lambda1)
+             z2 <- E(dist0, fun=Lambda2)
+           })
+        }else{z1 <- z2 <- 0}
         return(list(function(x){ Lambda1(x)-z1 },function(x){ Lambda2(x)-z2 }))
     }
 
@@ -342,11 +347,17 @@
 
     L2deriv <- EuclRandVarList(RealRandVariable(L2deriv.fct(param),
                                Domain = Reals()))
+    L2derivDistr <- NULL
+    if(withL2derivDistr){
+       suppressWarnings(L2derivDistr <-
+          imageDistr(RandVar = L2deriv, distr = distribution))
+    }
 
     L2Fam at fam.call <- substitute(GEVFamily(loc = loc0, scale = scale0,
                                  shape = shape0, of.interest = of.interest0,
                                  p = p0, N = N0, trafo = trafo0,
-                                 withPos = withPos0),
+                                 withPos = withPos0, withCentL2 = FALSE,
+                                 withL2derivDistr  = FALSE),
                          list(loc0 = loc, scale0 = scale, shape0 = shape,
                               of.interest0 = of.interest, p0 = p, N0 = N,
                               trafo0 = trafo, withPos0 = withPos))
@@ -358,12 +369,7 @@
                   }
 
     L2Fam at L2deriv <- L2deriv
-    wG <- getdistrOption("withgaps")
-    on.exit(distroptions(withgaps=wG))
-    distroptions(withgaps=FALSE)
-    suppressWarnings(
-    L2Fam at L2derivDistr <- imageDistr(RandVar = L2deriv, distr = distribution)
-    )
+    L2Fam at L2derivDistr <- L2derivDistr
     return(L2Fam)
 }
 

Modified: branches/robast-0.9/pkg/RobExtremes/R/GParetoFamily.R
===================================================================
--- branches/robast-0.9/pkg/RobExtremes/R/GParetoFamily.R	2013-02-12 11:17:27 UTC (rev 604)
+++ branches/robast-0.9/pkg/RobExtremes/R/GParetoFamily.R	2013-02-13 22:57:00 UTC (rev 605)
@@ -37,7 +37,9 @@
 GParetoFamily <- function(loc = 0, scale = 1, shape = 0.5, 
                           of.interest = c("scale", "shape"), 
                           p = NULL, N = NULL, trafo = NULL,
-                          start0Est = NULL, withPos = TRUE){
+                          start0Est = NULL, withPos = TRUE,
+                          withCentL2 = FALSE,
+                          withL2derivDistr  = FALSE){
     theta <- c(loc, scale, shape)
 
     of.interest <- .pretreat.of.interest(of.interest,trafo)
@@ -188,8 +190,13 @@
             return(y)
         }
         ## additional centering of scores to increase numerical precision!
-        z1 <- E(distribution, fun=Lambda1)
-        z2 <- E(distribution, fun=Lambda2)
+        if(withCentL2){
+           dist0 <- GPareto(scale = sc, shape = k, loc = tr)
+           suppressWarnings({
+             z1 <- E(dist0, fun=Lambda1)
+             z2 <- E(dist0, fun=Lambda2)
+           })
+        }else{z1 <- z2 <- 0}
         return(list(function(x){ Lambda1(x)-z1 },function(x){ Lambda2(x)-z2 }))
     }
 
@@ -228,21 +235,25 @@
 
     L2deriv <- EuclRandVarList(RealRandVariable(L2deriv.fct(param),
                                Domain = Reals()))
+    L2derivDistr <- NULL
+    if(withL2derivDistr){
+       suppressWarnings(L2derivDistr <-
+          imageDistr(RandVar = L2deriv, distr = distribution))
+    }
 
     L2Fam at fam.call <- substitute(GParetoFamily(loc = loc0, scale = scale0,
                                  shape = shape0, of.interest = of.interest0,
                                  p = p0, N = N0, trafo = trafo0,
-                                 withPos = withPos0),
+                                 withPos = withPos0, withCentL2 = FALSE,
+                                 withL2derivDistr  = FALSE),
                          list(loc0 = loc, scale0 = scale, shape0 = shape,
                               of.interest0 = of.interest, p0 = p, N0 = N,
                               trafo0 = trafo, withPos0 = withPos))
 
     L2Fam at LogDeriv <- function(x) (shape+1)/(scale+shape*(x-loc))
     L2Fam at L2deriv <- L2deriv
+    L2Fam at L2derivDistr <- L2derivDistr
 
-    suppressWarnings(
-      L2Fam at L2derivDistr <- imageDistr(RandVar = L2deriv, distr = distribution)
-    )
 
     return(L2Fam)
 }

Modified: branches/robast-0.9/pkg/RobExtremes/R/LDEstimator.R
===================================================================
--- branches/robast-0.9/pkg/RobExtremes/R/LDEstimator.R	2013-02-12 11:17:27 UTC (rev 604)
+++ branches/robast-0.9/pkg/RobExtremes/R/LDEstimator.R	2013-02-13 22:57:00 UTC (rev 605)
@@ -17,7 +17,19 @@
    }
    return(list1)
 }
+### in order to ensure that in case of GParetoFamily, GEVFamily,
+##  we fit the reference distribution with loc = 0, introduce
+##  function .loc
 
+setMethod(".loc", signature(L2Fam = "L2ParamFamily"),
+           function(L2Fam, ...) 0)
+
+setMethod(".loc", signature(L2Fam = "GParetoFamily"),
+           function(L2Fam,...) loc(L2Fam at distribution))
+setMethod(".loc", signature(L2Fam = "GEVFamily"),
+           function(L2Fam,...) loc(L2Fam at distribution))
+
+
 .LDMatch <- function(x.0, loc.est.0,disp.est.0,
                           loc.fctal.0, disp.fctal.0, ParamFamily.0,
                         loc.est.ctrl.0 = NULL, loc.fctal.ctrl.0=NULL,
@@ -25,7 +37,9 @@
                         q.lo.0 =0, q.up.0=Inf, log.q.0 =TRUE, ..., vdbg=FALSE
                         ){
     dots <- list(...)
-    loc.emp <- do.call(loc.est.0, args = .prepend(x.0,loc.est.ctrl.0, dots))
+
+    loc0 <- .loc(ParamFamily.0)
+    loc.emp <- do.call(loc.est.0, args = .prepend(x.0,loc.est.ctrl.0, dots))-loc0
     disp.emp <- do.call(disp.est.0, args = .prepend(x.0,disp.est.ctrl.0, dots))
     q.emp <- if(log.q.0) log(loc.emp)-log(disp.emp) else loc.emp/disp.emp
     q.f <- function(xi){
@@ -43,8 +57,8 @@
     th0 <- c(1,xi.0)
     names(th0) <- c("scale","shape")
     distr.new.0 <- ParamFamily.0 at modifyParam(theta=th0)
-    m1xi <- do.call(loc.fctal.0, args = .prepend(distr.new.0,loc.fctal.ctrl.0, dots))
-    val <-   c(loc.emp/m1xi, xi.0, loc.emp, disp.emp)
+    l1xi <- do.call(loc.fctal.0, args = .prepend(distr.new.0,loc.fctal.ctrl.0, dots))
+    val <-   c(loc.emp/l1xi, xi.0, loc.emp+loc0, disp.emp)
     names(val) <- c("scale", "shape", "loc","disp")
     return(val)
 }

Added: branches/robast-0.9/pkg/RobExtremes/R/ParetoFamily.R
===================================================================
--- branches/robast-0.9/pkg/RobExtremes/R/ParetoFamily.R	                        (rev 0)
+++ branches/robast-0.9/pkg/RobExtremes/R/ParetoFamily.R	2013-02-13 22:57:00 UTC (rev 605)
@@ -0,0 +1,135 @@
+#################################
+##
+## Class: GParetoFamily
+##
+################################
+
+
+## methods
+setMethod("validParameter",signature(object="ParetoFamily"),
+           function(object, param, tol =.Machine$double.eps){
+             if (is(param, "ParamFamParameter")) 
+                 param <- main(param)
+             if (!all(is.finite(param))) 
+                 return(FALSE)
+             if(object at param@withPosRestr)
+                 if (any(param[1] <= tol))
+                     return(FALSE)
+             return(TRUE)
+           })
+
+
+## generating function 
+## Min: known/fixed threshold/location parameter
+## shape: shape parameter
+## trafo: optional parameter transformation
+## start0Est: startEstimator for MLE and MDE
+
+ParetoFamily <- function(Min = 1, shape = 0.5, trafo = NULL, start0Est = NULL,
+                    withCentL2 = FALSE){
+    theta <- c(Min, shape)
+
+
+    ##symmetry
+    distrSymm <- NoSymmetry()
+
+    ## parameters
+    names(theta) <- c("Min", "shape")
+
+    if(missing(trafo)) trafo <- matrix(1, dimnames = list("shape","shape"))
+    if(is.matrix(trafo)) if(nrow(trafo) > 1)
+           stop("number of rows of 'trafo' > 1")
+           # code .define.tau.Dtau is in file GEVFamily.R
+
+    param <- ParamFamParameter(name = "theta", main = theta[2],
+                               fixed = theta[1],
+                               trafo = trafo)
+
+    ## distribution
+    distribution <- Pareto(Min = Min, shape = shape)
+
+    ## starting parameters
+    startPar <- function(x,...){
+        tr <- theta[1]
+        
+        ## Pickand estimator
+        if(is.null(start0Est)){
+           e0 <- log(2)/(log(median(x))-log(tr))
+        }else{
+           if(is(start0Est,"function")){
+              e1 <- start0Est(x, ...)
+              e0 <-  if(is(e1,"Estimate")) estimate(e1) else e1
+           }
+        }
+        if(any(x < tr))
+               stop("some data smaller than 'Min' ")
+        names(e0) <- NULL
+        return(e0)
+    }
+
+
+    ## what to do in case of leaving the parameter domain
+    makeOKPar <- function(theta) {
+        theta <- abs(theta)
+    }
+
+    modifyPar <- function(theta){
+        theta <- abs(theta)
+        Pareto(Min = Min, shape = theta)
+    }
+
+
+    ## L2-derivative of the distribution
+    L2deriv.fct <- function(param) {
+        k <- force(main(param))
+        Min0 <- fixed(param)
+
+        Lambda <- function(x) {
+            y <- x*0
+            ind <- (x > Min) #
+            y[ind] <- 1/k + log(Min0/x[ind])
+            return(y)
+        }
+        ## additional centering of scores to increase numerical precision!
+        z <- if(withCentL2) E(Pareto(Min = Min0, shape = k), fun=Lambda) else 0
+        fct <- function(x){Lambda(x)-z}
+        return(fct)
+    }
+
+    ## Fisher Information matrix as a function of parameters
+    FisherInfo.fct <- function(param) {
+        k <- force(main(param))
+        mat <- PosSemDefSymmMatrix(matrix(1/k^2,1,1))
+        dimnames(mat) <- list("shape","shape")
+        return(mat)
+    }
+
+    FisherInfo <- FisherInfo.fct(param)
+    name <- "Generalized Pareto Family"
+
+    ## initializing the GPareto family with components of L2-family
+    L2Fam <- new("ParetoFamily")
+    L2Fam at name <- name
+    L2Fam at param <- param
+    L2Fam at distribution <- distribution
+    L2Fam at L2deriv.fct <- L2deriv.fct
+    L2Fam at FisherInfo.fct <- FisherInfo.fct
+    L2Fam at FisherInfo <- FisherInfo
+    L2Fam at startPar <- startPar
+    L2Fam at makeOKPar <- makeOKPar
+    L2Fam at modifyParam <- modifyPar
+    L2Fam at L2derivSymm <- FunSymmList(NonSymmetric())
+    L2Fam at L2derivDistrSymm <- DistrSymmList(NoSymmetry())
+    L2derivDistr <- UnivarDistrList(1/shape+log(Min)-log(distribution))
+
+    L2deriv <- EuclRandVarList(RealRandVariable(list(L2deriv.fct(param)),
+                               Domain = Reals()))
+
+    L2Fam at fam.call <- substitute(ParetoFamily(Min = Min0, shape = shape0,
+                                     trafo = trafo0),
+                         list(Min0 = Min, shape0 = shape, trafo0 = trafo))
+
+    L2Fam at L2deriv <- L2deriv
+    return(L2Fam)
+}
+

Modified: branches/robast-0.9/pkg/RobExtremes/R/WeibullFamily.R
===================================================================
--- branches/robast-0.9/pkg/RobExtremes/R/WeibullFamily.R	2013-02-12 11:17:27 UTC (rev 604)
+++ branches/robast-0.9/pkg/RobExtremes/R/WeibullFamily.R	2013-02-13 22:57:00 UTC (rev 605)
@@ -36,7 +36,9 @@
 WeibullFamily <- function(scale = 1, shape = 0.5, 
                           of.interest = c("scale", "shape"), 
                           p = NULL, N = NULL, trafo = NULL,
-                          start0Est = NULL, withPos = TRUE){
+                          start0Est = NULL, withPos = TRUE,
+                          withCentL2 = FALSE,
+                          withL2derivDistr  = FALSE){
     theta <- c(scale, shape)
 
     of.interest <- .pretreat.of.interest(of.interest,trafo)
@@ -179,8 +181,11 @@
             return(y)
         }
         ## additional centering of scores to increase numerical precision!
-        z1 <- E(distribution, fun=Lambda1)
-        z2 <- E(distribution, fun=Lambda2)
+        if(withCentL2){
+           dist0 <- Weibull(scale = sc, shape = sh)
+           z1 <- E(dist0, fun=Lambda1)
+           z2 <- E(dist0, fun=Lambda2)
+        }else{z1 <- z2 <- 0}
         return(list(function(x){ Lambda1(x)-z1 },function(x){ Lambda2(x)-z2 }))
     }
 
@@ -220,11 +225,17 @@
 
     L2deriv <- EuclRandVarList(RealRandVariable(L2deriv.fct(param),
                                Domain = Reals()))
+    L2derivDistr <- NULL
+    if(withL2derivDistr){
+       suppressWarnings(L2derivDistr <-
+          imageDistr(RandVar = L2deriv, distr = distribution))
+    }
 
     L2Fam at fam.call <- substitute(WeibullFamily(scale = scale0,
                                  shape = shape0, of.interest = of.interest0,
                                  p = p0, N = N0, trafo = trafo0,
-                                 withPos = withPos0),
+                                 withPos = withPos0, withCentL2 = FALSE,
+                                 withL2derivDistr  = FALSE),
                          list(scale0 = scale, shape0 = shape,
                               of.interest0 = of.interest, p0 = p, N0 = N,
                               trafo0 = trafo, withPos0 = withPos))
@@ -233,11 +244,8 @@
             log(shape)-log(scale)+(shape-1)*log(z)-shape*z^(shape-1)
             }###
     L2Fam at L2deriv <- L2deriv
+    L2Fam at L2derivDistr <- L2derivDistr
 
-    suppressWarnings(
-    L2Fam at L2derivDistr <- imageDistr(RandVar = L2deriv, distr = distribution)
-    )
-
     return(L2Fam)
 }
 

Modified: branches/robast-0.9/pkg/RobExtremes/R/recomputeInterpolators.R
===================================================================
--- branches/robast-0.9/pkg/RobExtremes/R/recomputeInterpolators.R	2013-02-12 11:17:27 UTC (rev 604)
+++ branches/robast-0.9/pkg/RobExtremes/R/recomputeInterpolators.R	2013-02-13 22:57:00 UTC (rev 605)
@@ -1,4 +1,5 @@
 .recomputeInterpolators <- function(sysdataFiles, sysRdaFolder = ".",
+                                   excludeGrids = NULL, excludeNams = NULL,
                                    others = FALSE, onlyothers = FALSE,
                                    translate = TRUE, overwrite = TRUE, integrateto = FALSE,
                                    onlyCurrent = FALSE, withPrint =TRUE,
@@ -8,7 +9,8 @@
   wprint <- function(...){ if (withPrint) print(...)}
 
   sam <- new.env()
-  for(File in sysdataFiles) .mergeF(File, envir = sam)
+  for(File in sysdataFiles) .mergeF(File, envir = sam,
+            excludeGrids = excludeGrids , excludeNams = excludeNams)
 
   keep <- if(getRversion()>="2.16") "N" else "O"
   todo <- if(getRversion()>="2.16") "O" else "N"
@@ -164,9 +166,10 @@
    save(list=what, file=rdafileNew, envir=nE)
 }
 
-.mergeF <- function(file,envir){
+.mergeF <- function(file,envir, excludeGrids = NULL, excludeNams = NULL){
   envir2 <- new.env()
   load(file,envir=envir2)
+  rm(list=excludeGrids, envir=envir2)
   what1 <- ls(all.names=TRUE,envir=envir)
   what2 <- ls(all.names=TRUE,envir=envir2)
   for(w2 in what2){
@@ -174,6 +177,7 @@
       if(w2 %in% what1){
          wG1 <- get(w2, envir=envir)
          for(Fam1 in names(wG1)){
+             if( Fam1 %in% excludeNams)   wG2[[Fam1]] <- NULL
              if( ! Fam1 %in% names(wG2))  wG2[[Fam1]] <- wG1[[Fam1]]
          }
       }

Modified: branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/checkSn.R
===================================================================
--- branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/checkSn.R	2013-02-12 11:17:27 UTC (rev 604)
+++ branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/checkSn.R	2013-02-13 22:57:00 UTC (rev 605)
@@ -42,4 +42,4 @@
 lines(xig, S3ga, col="red")
 plot(xig, S4g, type="l")
 lines(xig, S4ga, col="red")
-par(mfrow=c(1,1))
\ No newline at end of file
+par(mfrow=c(1,1))

Modified: branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/interpolationscripts.R
===================================================================
--- branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/interpolationscripts.R	2013-02-12 11:17:27 UTC (rev 604)
+++ branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/interpolationscripts.R	2013-02-13 22:57:00 UTC (rev 605)
@@ -112,8 +112,8 @@
 .RMXE.xi <- RobExtremes:::.RMXE.xi
 .modify.xi.PFam.call <- RobExtremes:::.modify.xi.PFam.call
 .myFolder <- file.path(.basepath,"RobExtremes/R")
-.myFolder0 <- file.path(.basepath,"RobExtremesBuffer/tmp0")
-.myFolder1 <- file.path(.basepath,"RobExtremesBuffer/tmp1")
+.myFolder0 <- file.path(.basepath,"RobExtremesBuffer/rmp0")
+.myFolder1 <- file.path(.basepath,"RobExtremesBuffer/rmp1")
 .myFolder2 <- file.path(.basepath,"RobExtremesBuffer/tmp2")
 .myFolder3 <- file.path(.basepath,"RobExtremesBuffer/tmp3")
 chkExist <- function(fN) if(!file.exists(fN)) dir.create(fN, recursive = TRUE)
@@ -163,12 +163,12 @@
 .RMXE.xi <- RobExtremes:::.RMXE.xi
 .modify.xi.PFam.call <- RobExtremes:::.modify.xi.PFam.call
 ### -> change this according to where you checked out the svn repo:
-.basepath <- "C:/rtest/RobASt/branches/robast-0.9/pkg"
+#.basepath <- "C:/rtest/RobASt/branches/robast-0.9/pkg"
 ## <-
 .myFolder0 <- file.path(.basepath,"RobExtremesBuffer/tmp0")
-.myFolder1 <- file.path(.basepath,"RobExtremesBuffer/tmp1")
-.myFolder2 <- file.path(.basepath,"RobExtremesBuffer/tmp2")
-.myFolder3 <- file.path(.basepath,"RobExtremesBuffer/tmp3")
+.myFolder1 <- file.path(.basepath,"RobExtremesBuffer/tmp6")
+.myFolder2 <- file.path(.basepath,"RobExtremesBuffer/tmp7")
+.myFolder3 <- file.path(.basepath,"RobExtremesBuffer/tmp8")
 chkExist <- function(fN) if(!file.exists(fN)) dir.create(fN, recursive = TRUE)
 sapply(c(.myFolder0,.myFolder1,.myFolder2,.myFolder3), chkExist)
 PF <- GammaFamily()

Modified: branches/robast-0.9/pkg/RobExtremes/man/GEVFamily.Rd
===================================================================
--- branches/robast-0.9/pkg/RobExtremes/man/GEVFamily.Rd	2013-02-12 11:17:27 UTC (rev 604)
+++ branches/robast-0.9/pkg/RobExtremes/man/GEVFamily.Rd	2013-02-13 22:57:00 UTC (rev 605)
@@ -8,7 +8,8 @@
 }
 \usage{
 GEVFamily(loc = 0, scale = 1, shape = 0.5, of.interest = c("scale", "shape"),
-              p = NULL, N = NULL, trafo = NULL, start0Est = NULL, withPos = TRUE)
+              p = NULL, N = NULL, trafo = NULL, start0Est = NULL, withPos = TRUE,
+              withCentL2 = FALSE, withL2derivDistr  = FALSE)
 }
 \arguments{
   \item{loc}{ real: known/fixed threshold/location parameter }
@@ -22,6 +23,11 @@
   \item{trafo}{ matrix or NULL: transformation of the parameter }
   \item{start0Est}{ startEstimator --- if \code{NULL} \code{\link{PickandsEstimator}} is used }
   \item{withPos}{ logical of length 1: Is shape restricted to positive values? }
+  \item{withCentL2}{logical: shall L2 derivative be centered by substracting
+       the E()? Defaults to \code{FALSE}, but higher accuracy can be achieved
+       when set to \code{TRUE}.}
+  \item{withL2derivDistr}{logical: shall the distribution of the L2 derivative
+      be computed? Defaults to \code{FALSE} (to speeds up computations).}
 }
 \details{
   The slots of the corresponding L2 differentiable 

Modified: branches/robast-0.9/pkg/RobExtremes/man/GParetoFamily.Rd
===================================================================
--- branches/robast-0.9/pkg/RobExtremes/man/GParetoFamily.Rd	2013-02-12 11:17:27 UTC (rev 604)
+++ branches/robast-0.9/pkg/RobExtremes/man/GParetoFamily.Rd	2013-02-13 22:57:00 UTC (rev 605)
@@ -8,7 +8,8 @@
 }
 \usage{
 GParetoFamily(loc = 0, scale = 1, shape = 0.5, of.interest = c("scale", "shape"),
-              p = NULL, N = NULL, trafo = NULL, start0Est = NULL, withPos = TRUE)
+              p = NULL, N = NULL, trafo = NULL, start0Est = NULL, withPos = TRUE,
+              withCentL2 = FALSE, withL2derivDistr  = FALSE)
 }
 \arguments{
   \item{loc}{ real: known/fixed threshold/location parameter }
@@ -22,6 +23,11 @@
   \item{trafo}{ matrix or NULL: transformation of the parameter }
   \item{start0Est}{ startEstimator --- if \code{NULL} \code{\link{medkMADhybr}} is used }
   \item{withPos}{ logical of length 1: Is shape restricted to positive values? }
+  \item{withCentL2}{logical: shall L2 derivative be centered by substracting
+       the E()? Defaults to \code{FALSE}, but higher accuracy can be achieved
+       when set to \code{TRUE}.}
+  \item{withL2derivDistr}{logical: shall the distribution of the L2 derivative
+      be computed? Defaults to \code{FALSE} (to speeds up computations).}
 }
 \details{
   The slots of the corresponding L2 differentiable 

Modified: branches/robast-0.9/pkg/RobExtremes/man/InternalReturnClasses-class.Rd
===================================================================
--- branches/robast-0.9/pkg/RobExtremes/man/InternalReturnClasses-class.Rd	2013-02-12 11:17:27 UTC (rev 604)
+++ branches/robast-0.9/pkg/RobExtremes/man/InternalReturnClasses-class.Rd	2013-02-13 22:57:00 UTC (rev 605)
@@ -1,158 +1,32 @@
 \name{InternalReturnClasses-class}
 \docType{class}
 \alias{InternalReturnClasses-class}
-\alias{InternalReturnClasses-class}
-\alias{BinomFamily-class}
-\alias{PoisFamily-class}
-\alias{NormLocationFamily-class}
 \alias{GumbelLocationFamily-class}
-\alias{NormScaleFamily-class}
-\alias{ExpScaleFamily-class}
-\alias{LnormScaleFamily-class}
-\alias{GammaFamily-class}
+\alias{ParetoFamily-class}
+\alias{GEVFamily-class}
 \alias{GParetoFamily-class}
 \alias{WeibullFamily-class}
-\alias{BetaFamily-class}
-\alias{NormLocationScaleFamily-class}
-\alias{CauchyLocationScaleFamily-class}
 
 \title{Internal return classes for generating functions}
 \description{internal return classes for generating functions 'L2ParamFamily' and 
 'L2LocationFamily' (and friends); used for particular method dispatch only}
 
 \section{Described classes}{
-In this file we describe classes 
-\code{BinomFamily}, \code{PoisFamily}, \code{GammaFamily},
-\code{BetaFamily}, class \code{GParetoFamily} ``extending'' (no new slots!)
-class \code{L2ParamFamily},
-classes \code{NormLocationFamily} and \code{GumbelLocationFamily}, 
-``extending'' (no new slots!) class \code{"L2LocationFamily"}, classes
-\code{NormScaleFamily}, \code{ExpScaleFamily}, and \code{LnormScaleFamily} 
-``extending'' (no new slots!) class \code{"L2ScaleFamily"}, and classes
-\code{CauchyLocationScaleFamily} and \code{NormLocationScaleFamily},
-``extending'' (no new slots!) class \code{"L2LocationScaleFamily"}.
+In this file we describe classes \code{GParetoFamily}, \code{GEVFamily},
+\code{WeibullFamily} all ``extending'' (no new slots!) class union
+\code{"L2LocationScaleShapeUnion"} and \code{ParetoFamily} ``extending''
+ (no new slots!) class \code{L2ParamFamily}.
 }
 \section{Objects from these classes}{
   Objects are only generated internally by the mentioned generating functions. 
 }
-\section{Slots}{
-   \describe{
-   \item{\code{name}:}{[inherited from class \code{"ProbFamily"}] 
-      object of class \code{"character"}: 
-      name of the family. }
-    \item{\code{distribution}:}{[inherited from class \code{"ProbFamily"}] 
-      object of class \code{"Distribution"}:
-      member of the family. }
-    \item{\code{distrSymm}:}{[inherited from class \code{"ProbFamily"}] 
-      object of class \code{"DistributionSymmetry"}: 
-      symmetry of \code{distribution}. }
-    \item{\code{param}:}{[inherited from class \code{"ParamFamily"}]
-      object of class \code{"ParamFamParameter"}:
-      parameter of the family. }
-    \item{\code{fam.call}:}{[inherited from class \code{"ParamFamily"}]
-      object of class \code{"call"}:
-      call by which parametric family was produced.}
-    \item{\code{makeOKPar}:}{[inherited from class \code{"ParamFamily"}]
-           object of class \code{"function"}:
-           has argument \code{param} --- the (total) parameter, 
-           returns valid parameter; used if \code{optim} resp. \code{optimize}---
-           try to use ``illegal'' parameter values; then \code{makeOKPar} makes
-           a valid parameter value out of the illegal one.}
-    \item{\code{startPar}:}{[inherited from class \code{"ParamFamily"}]
-           object of class \code{"function"}:
-           has argument \code{x} --- the data, 
-           returns starting parameter for \code{optim} resp. \code{optimize}---
-           a starting estimator in case parameter is multivariate
-           or a search interval in case parameter is univariate.}
-    \item{\code{modifyParam}:}{[inherited from class \code{"ParamFamily"}]
-      object of class \code{"function"}:
-      mapping from the parameter space (represented by \code{"param"}) 
-      to the distribution space (represented by \code{"distribution"}). }
-    \item{\code{props}:}{[inherited from class \code{"ProbFamily"}]
-      object of class \code{"character"}:
-      properties of the family. }
-    \item{\code{L2deriv}:}{[inherited from class \code{"L2ParamFamily"}]
-      object of class \code{"EuclRandVariable"}:
-      L2 derivative of the family. }
-    \item{\code{L2deriv.fct}:}{[inherited from class \code{"L2ParamFamily"}]
-      object of class \code{"function"}: mapping from 
-      the parameter space (argument \code{param} of class 
-      \code{"ParamFamParameter"}) to a mapping from observation \code{x} to the  
-      value of the L2derivative; \code{L2deriv.fct} is then used from observation
-      \code{x} to value of the L2derivative; \code{L2deriv.fct} is used by 
-      \code{modifyModel} to  move the L2deriv according to a change in the 
-      parameter }
-    \item{\code{L2derivSymm}:}{[inherited from class \code{"L2ParamFamily"}]
-      object of class \code{"FunSymmList"}:
-      symmetry of the maps included in \code{L2deriv}. }
-    \item{\code{L2derivDistr}:}{[inherited from class \code{"L2ParamFamily"}]
-      object of class \code{"UnivarDistrList"}:
-      list which includes the distribution of \code{L2deriv}. }
-    \item{\code{L2derivDistrSymm}:}{[inherited from class \code{"L2ParamFamily"}]
-      object of class \code{"DistrSymmList"}:
-      symmetry of the distributions included in \code{L2derivDistr}. }
-    \item{\code{FisherInfo.fct}:}{[inherited from class \code{"L2ParamFamily"}]
-      object of class \code{"function"}: 
-      mapping from the parameter space (argument  \code{param} of class 
-      \code{"ParamFamParameter"}) to the set of positive
-      semidefinite matrices; \code{FisherInfo.fct} is used by \code{modifyModel} to 
-      move the Fisher information according to a change in the parameter } 
-    \item{\code{FisherInfo}:}{[inherited from class \code{"L2ParamFamily"}]
-      object of class \code{"PosDefSymmMatrix"}:
-      Fisher information of the family. }
-    \item{\code{LogDeriv}:}{(only loc/scale classes)[inherited from class \code{"L2GroupParamFamily"}]
-      object of class \code{"function"}: has argument \code{x}; 
-      the negative logarithmic derivative of the density of the model distribution at 
-      the "standard" parameter value. }
-    \item{\code{locscalename}:}{(only loc/scale classes)[inherited from class \code{"L2LocationScaleUnion"}]
-      object of class \code{"character"}: names of location and scale parameter. }
-}}
 
-
-
-\section{Extends}{
-Classes \code{BinomFamily}, \code{PoisFamily}, \code{GammaFamily}
-\code{BetaFamily} ``extend'' (no new slots!):\cr
-Class \code{"L2ParamFamily"},  directly.\cr
-Class \code{"ParamFamily"}, by class \code{"L2ParamFamily"}.\cr
-Class \code{"ProbFamily"}, by class \code{"ParamFamily"}.
-\cr
-Classes \code{NormLocationFamily} and \code{GumbelLocationFamily}, 
-``extend'' (no new slots!):\cr
-Class \code{"L2LocationFamily"}, directly.\cr
-Class \code{"L2LocationScaleUnion"}, by class \code{"L2LocationFamily"}.\cr
-Class \code{"L2GroupParamFamily"}, by class \code{"L2LocationScaleUnion"}.\cr
-Class \code{"L2ParamFamily"},  directly.\cr
-Class \code{"ParamFamily"}, by class \code{"L2ParamFamily"}.\cr
-Class \code{"ProbFamily"}, by class \code{"ParamFamily"}.
-\cr
-\code{NormScaleFamily}, \code{ExpScaleFamily}, and \code{LnormScaleFamily} 
-``extend'' (no new slots!):\cr
-Class \code{"L2ScaleFamily"}, directly.\cr
-Class \code{"L2LocationScaleUnion"}, by class \code{"L2ScaleFamily"}.\cr
-Class \code{"L2GroupParamFamily"}, by class \code{"L2LocationScaleUnion"}.\cr
-Class \code{"L2ParamFamily"},  directly.\cr
-Class \code{"ParamFamily"}, by class \code{"L2ParamFamily"}.\cr
-Class \code{"ProbFamily"}, by class \code{"ParamFamily"}.
-\cr
-\code{CauchyLocationScaleFamily} and \code{NormLocationScaleFamily}
-``extend'' (no new slots!):\cr
-Class \code{"L2LocationScaleFamily"}, directly.\cr
-Class \code{"L2LocationScaleUnion"}, by class \code{"L2LocationScaleFamily"}.\cr
-Class \code{"L2GroupParamFamily"}, by class \code{"L2LocationScaleUnion"}.\cr
-Class \code{"L2ParamFamily"},  directly.\cr
-Class \code{"ParamFamily"}, by class \code{"L2ParamFamily"}.\cr
-Class \code{"ProbFamily"}, by class \code{"ParamFamily"}.
-}
 \section{Methods}{
    not yet done...
 }
 \seealso{\code{\link[methods:BasicClasses]{numeric-class}},
 \code{\link{L2ParamFamily-class}},
-\code{\link{L2GroupParamFamily-class}},
-\code{\link{L2LocationFamily-class}},
-\code{\link{L2ScaleFamily-class}},
-\code{\link{L2LocationScaleFamily-class}},
+\code{\link{L2ScaleShapeUnion-class}},
 }
 
 \references{
@@ -161,8 +35,7 @@
[TRUNCATED]

To get the complete diff run:
    svnlook diff /svnroot/robast -r 605


More information about the Robast-commits mailing list