[Robast-commits] r751 - in branches/robast-1.0/pkg/RobExtremes: R inst/AddMaterial/interpolation man

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Wed Apr 16 01:12:55 CEST 2014


Author: ruckdeschel
Date: 2014-04-16 01:12:55 +0200 (Wed, 16 Apr 2014)
New Revision: 751

Modified:
   branches/robast-1.0/pkg/RobExtremes/R/GEVFamily.R
   branches/robast-1.0/pkg/RobExtremes/R/GEVFamilyMuUnknown.R
   branches/robast-1.0/pkg/RobExtremes/R/interpolLM.R
   branches/robast-1.0/pkg/RobExtremes/inst/AddMaterial/interpolation/getLMInterpol.R
   branches/robast-1.0/pkg/RobExtremes/inst/AddMaterial/interpolation/interpolationscripts.R
   branches/robast-1.0/pkg/RobExtremes/man/GEVFamilyMuUnknown.Rd
   branches/robast-1.0/pkg/RobExtremes/man/internal-interpolate.Rd
Log:
RobExtremes: fixed buglets in GEVFamilyMuUnknown which hindered evaluation of LagrangeMults, prepared code for evaluation of LMs on xi grid for this family; .pretreat.of.interest and .define.tau.Dtau are more accurate now; cleaned small buglet in modifyPar

Modified: branches/robast-1.0/pkg/RobExtremes/R/GEVFamily.R
===================================================================
--- branches/robast-1.0/pkg/RobExtremes/R/GEVFamily.R	2014-04-14 23:24:49 UTC (rev 750)
+++ branches/robast-1.0/pkg/RobExtremes/R/GEVFamily.R	2014-04-15 23:12:55 UTC (rev 751)
@@ -15,34 +15,46 @@
     }
 
 ### pretreatment of of.interest
-.pretreat.of.interest <- function(of.interest,trafo){
+.pretreat.of.interest <- function(of.interest,trafo,withMu=FALSE){
     if(is.null(trafo)){
         of.interest <- unique(of.interest)
-        if(length(of.interest) > 2)
+        if(!withMu && length(of.interest) > 2)
             stop("A maximum number of two parameters resp. parameter transformations may be selected.")
-        if(!all(of.interest %in% c("scale", "shape", "quantile", "expected loss", "expected shortfall")))
+        if(withMu && length(of.interest) > 3)
+            stop("A maximum number of three parameters resp. parameter transformations may be selected.")
+        if(!withMu && !all(of.interest %in% c("scale", "shape", "quantile", "expected loss", "expected shortfall")))
             stop("Parameters resp. transformations of interest have to be selected from: ",
                 "'scale', 'shape', 'quantile', 'expected loss', 'expected shortfall'.")
+        if(withMu && !all(of.interest %in% c("loc", "scale", "shape", "quantile", "expected loss", "expected shortfall")))
+            stop("Parameters resp. transformations of interest have to be selected from: ",
+                "'loc', 'scale', 'shape', 'quantile', 'expected loss', 'expected shortfall'.")
 
         ## reordering of of.interest
-        if(("scale" %in% of.interest) && ("scale" != of.interest[1])){
-            of.interest[2] <- of.interest[1]
-            of.interest[1] <- "scale"
+        muAdd <- 0
+        if(withMu & "loc" %in% of.interest){
+           muAdd <- 1
+           muWhich <- which(of.interest=="loc")
+           notmuWhich <- which(!of.interest %in% "loc")
+           of.interest <- of.interest[c(muWhich,notmuWhich)]
         }
-        if(!("scale" %in% of.interest) && ("shape" %in% of.interest) && ("shape" != of.interest[1])){
-            of.interest[2] <- of.interest[1]
-            of.interest[1] <- "shape"
+        if(("scale" %in% of.interest) && ("scale" != of.interest[1+muAdd])){
+            of.interest[2+muAdd] <- of.interest[1+muAdd]
+            of.interest[1+muAdd] <- "scale"
         }
+        if(!("scale" %in% of.interest) && ("shape" %in% of.interest) && ("shape" != of.interest[1+muAdd])){
+            of.interest[2+muAdd] <- of.interest[1+muAdd]
+            of.interest[1+muAdd] <- "shape"
+        }
         if(!any(c("scale", "shape") %in% of.interest) && ("quantile" %in% of.interest)
-          && ("quantile" != of.interest[1])){
-            of.interest[2] <- of.interest[1]
-            of.interest[1] <- "quantile"
+          && ("quantile" != of.interest[1+muAdd])){
+            of.interest[2+muAdd] <- of.interest[1+muAdd]
+            of.interest[1+muAdd] <- "quantile"
         }
         if(!any(c("scale", "shape", "quantile") %in% of.interest)
           && ("expected shortfall" %in% of.interest)
-          && ("expected shortfall" != of.interest[1])){
-            of.interest[2] <- of.interest[1]
-            of.interest[1] <- "expected shortfall"
+          && ("expected shortfall" != of.interest[1+muAdd])){
+            of.interest[2+muAdd] <- of.interest[1+muAdd]
+            of.interest[1+muAdd] <- "expected shortfall"
         }
     }
   return(of.interest)
@@ -74,12 +86,20 @@
             }else{
                 tau1 <- tau
                 tau <- function(theta){ }
-                body(tau) <- substitute({ btq0; c(tau0(theta), q) },
-                                        list(btq0=btq, tau0 = tau1))
+                body(tau) <- substitute({ btq0
+                                          th0 <- tau0(theta)
+                                          th <- c(th0, q)
+                                          names(th) <- c(names(th0),"quantile")
+                                          th
+                                         }, list(btq0=btq, tau0 = tau1))
                 Dtau1 <- Dtau
                 Dtau <- function(theta){}
-                body(Dtau) <- substitute({ bDq0; rbind(Dtau0(theta), D) },
-                                         list(Dtau0 = Dtau1, bDq0 = bDq))
+                body(Dtau) <- substitute({ bDq0
+                                           D0 <- Dtau0(theta)
+                                           D1 <- rbind(D0, D)
+                                           rownames(D1) <- c(rownames(D0),"quantile")
+                                           D1
+                                           }, list(Dtau0 = Dtau1, bDq0 = bDq))
             }
         }
         if("expected shortfall" %in% of.interest){
@@ -90,12 +110,18 @@
             }else{
                 tau1 <- tau
                 tau <- function(theta){ }
-                body(tau) <- substitute({ btes0; c(tau0(theta), es) },
-                                        list(tau0 = tau1, btes0=btes))
+                body(tau) <- substitute({ btes0
+                                          th0 <- tau0(theta)
+                                          th <- c(th0, es)
+                                          names(th) <- c(names(th0),"expected shortfall")
+                                          th}, list(tau0 = tau1, btes0=btes))
                 Dtau1 <- Dtau
                 Dtau <- function(theta){}
-                body(Dtau) <- substitute({ bDes0; rbind(Dtau0(theta), D) },
-                                         list(Dtau0 = Dtau1, bDes0=bDes))
+                body(Dtau) <- substitute({ bDes0
+                                           D0 <- Dtau0(theta)
+                                           D1 <- rbind(D0, D)
+                                           rownames(D1) <- c(rownames(D0),"expected shortfall")
+                                           D1}, list(Dtau0 = Dtau1, bDes0=bDes))
             }
         }
         if("expected loss" %in% of.interest){
@@ -106,12 +132,18 @@
             }else{
                 tau1 <- tau
                 tau <- function(theta){ }
-                body(tau) <- substitute({ btel0; c(tau0(theta), el) },
-                                        list(tau0 = tau1, btel0=btel))
+                body(tau) <- substitute({ btel0
+                                          th0 <- tau0(theta)
+                                          th <- c(th0, el)
+                                          names(th) <- c(names(th0),"expected los")
+                                          th}, list(tau0 = tau1, btel0=btel))
                 Dtau1 <- Dtau
                 Dtau <- function(theta){}
-                body(Dtau) <- substitute({ bDel0; rbind(Dtau0(theta), D) },
-                                         list(Dtau0 = Dtau1, bDel0=bDel))
+                body(Dtau) <- substitute({ bDel0
+                                           D0 <- Dtau0(theta)
+                                           D1 <- rbind(D0, D)
+                                           rownames(D1) <- c(rownames(D0),"expected loss")
+                                           D1}, list(Dtau0 = Dtau1, bDel0=bDel))
             }
         }
         trafo <- function(x){ list(fval = tau(x), mat = Dtau(x)) }
@@ -287,7 +319,8 @@
 
     modifyPar <- function(theta){
         theta <- makeOKPar(theta)
-        if(..withWarningGEV).warningGEVShapeLarge(theta["shape"])
+        sh <- if(!is.null(names(theta))) theta["shape"] else theta[2]
+        if(..withWarningGEV).warningGEVShapeLarge(sh)
         if(!is.null(names(theta))){
             sc <- theta["scale"]
             sh <- theta["shape"]

Modified: branches/robast-1.0/pkg/RobExtremes/R/GEVFamilyMuUnknown.R
===================================================================
--- branches/robast-1.0/pkg/RobExtremes/R/GEVFamilyMuUnknown.R	2014-04-14 23:24:49 UTC (rev 750)
+++ branches/robast-1.0/pkg/RobExtremes/R/GEVFamilyMuUnknown.R	2014-04-15 23:12:55 UTC (rev 751)
@@ -28,19 +28,130 @@
 ## trafo: optional parameter transformation
 ## start0Est: startEstimator for MLE and MDE --- if NULL HybridEstimator is used;
 
+.define.tau.Dtau.withMu <- function(of.interest, btq, bDq, btes,
+                                    bDes, btel, bDel, p, N){
+        tau <- NULL
+        if("loc" %in% of.interest){
+            tau <- function(theta){ th <- theta[1]; names(th) <- "loc";  th}
+            Dtau <- function(theta){ D <- t(c(1, 0,0)); rownames(D) <- "loc"; D}
+        }
+        if("scale" %in% of.interest){
+            if(is.null(tau)){
+               tau <- function(theta){th <- theta[2]; names(th) <- "scale"; th}
+               Dtau <- function(theta){D <- t(c(0,1,0));rownames(D) <- "scale";D}
+            }else{
+               tau <- function(theta){ th <- theta;
+                                       names(th) <- c("loc","scale");  th}
+               Dtau <- function(theta){ D <- t(matrix(c(1,0,0,0,1, 0),3,2))
+                                        rownames(D) <- c("loc","scale"); D}
+            }
+        }
+        if("shape" %in% of.interest){
+            if(is.null(tau)){
+               tau <- function(theta){th <- theta[3]; names(th) <- "shape"; th}
+               Dtau <- function(theta){D <- t(c(0,0,1));rownames(D) <- "shape";D}
+            }else{
+                .tauo <- tau
+                .Dtauo <- Dtau
+                tau <- function(theta){
+                            th1 <- .tauo(theta)
+                            th <- c(th1,theta[3])
+                            names(th) <- c(names(th1),"shape")
+                            th}
+                Dtau <- function(theta){
+                            D0 <- .Dtauo(theta)
+                            D <- rbind(D0,t(c(0,0,1)))
+                            rownames(D) <- c(rownames(D0),"shape")
+                            D}
+            }
+        }
+        if("quantile" %in% of.interest){
+            if(is.null(p)) stop("Probability 'p' has to be specified.")
+            if(is.null(tau)){
+                tau <- function(theta){ }; body(tau) <- btq
+                Dtau <- function(theta){ };body(Dtau) <- bDq
+            }else{
+                tau1 <- tau
+                tau <- function(theta){ }
+                body(tau) <- substitute({ btq0
+                                          th0 <- tau0(theta)
+                                          th <- c(th0, q)
+                                          names(th) <- c(names(th0),"quantile")
+                                          th
+                                         }, list(btq0=btq, tau0 = tau1))
+                Dtau1 <- Dtau
+                Dtau <- function(theta){}
+                body(Dtau) <- substitute({ bDq0
+                                           D0 <- Dtau0(theta)
+                                           D1 <- rbind(D0, D)
+                                           rownames(D1) <- c(rownames(D0),"quantile")
+                                           D1
+                                           }, list(Dtau0 = Dtau1, bDq0 = bDq))
+            }
+        }
+        if("expected shortfall" %in% of.interest){
+            if(is.null(p)) stop("Probability 'p' has to be specified.")
+            if(is.null(tau)){
+                tau <- function(theta){ };  body(tau) <- btes
+                Dtau <- function(theta){ }; body(Dtau) <- bDes
+            }else{
+                tau1 <- tau
+                tau <- function(theta){ }
+                body(tau) <- substitute({ btes0
+                                          th0 <- tau0(theta)
+                                          th <- c(th0, es)
+                                          names(th) <- c(names(th0),"expected shortfall")
+                                          th}, list(tau0 = tau1, btes0=btes))
+                Dtau1 <- Dtau
+                Dtau <- function(theta){}
+                body(Dtau) <- substitute({ bDes0
+                                           D0 <- Dtau0(theta)
+                                           D1 <- rbind(D0, D)
+                                           rownames(D1) <- c(rownames(D0),"expected shortfall")
+                                           D1}, list(Dtau0 = Dtau1, bDes0=bDes))
+            }
+        }
+        if("expected loss" %in% of.interest){
+            if(is.null(N)) stop("Expected frequency 'N' has to be specified.")
+            if(is.null(tau)){
+                tau <- function(theta){ }; body(tau) <- btel
+                Dtau <- function(theta){ }; body(Dtau) <- bDel
+            }else{
+                tau1 <- tau
+                tau <- function(theta){ }
+                body(tau) <- substitute({ btel0
+                                          th0 <- tau0(theta)
+                                          th <- c(th0, el)
+                                          names(th) <- c(names(th0),"expected los")
+                                          th}, list(tau0 = tau1, btel0=btel))
+                Dtau1 <- Dtau
+                Dtau <- function(theta){}
+                body(Dtau) <- substitute({ bDel0
+                                           D0 <- Dtau0(theta)
+                                           D1 <- rbind(D0, D)
+                                           rownames(D1) <- c(rownames(D0),"expected loss")
+                                           D1}, list(Dtau0 = Dtau1, bDel0=bDel))
+            }
+        }
+        trafo <- function(x){ list(fval = tau(x), mat = Dtau(x)) }
+        return(trafo)
+}
+
+
 GEVFamilyMuUnknown <- function(loc = 0, scale = 1, shape = 0.5,
-                          of.interest = c("scale", "shape"),
+                          of.interest = c("loc","scale", "shape"),
                           p = NULL, N = NULL, trafo = NULL,
                           start0Est = NULL, withPos = TRUE,
                           secLevel = 0.7,
                           withCentL2 = FALSE,
                           withL2derivDistr  = FALSE,
                           ..ignoreTrafo = FALSE,
-                          ..withWarningGEV = TRUE){
+                          ..withWarningGEV = TRUE,
+                          ..name =""){
     theta <- c(loc, scale, shape)
     if(..withWarningGEV).warningGEVShapeLarge(shape)
     
-    of.interest <- .pretreat.of.interest(of.interest,trafo)
+    of.interest <- .pretreat.of.interest(of.interest,trafo,withMu=TRUE)
 
     ##symmetry
     distrSymm <- NoSymmetry()
@@ -110,8 +221,8 @@
 
     fromOfInt <- FALSE
     if(is.null(trafo)||..ignoreTrafo){fromOfInt <- TRUE
-       trafo <- .define.tau.Dtau(of.interest, btq, bDq, btes, bDes,
-                                 btel, bDel, p, N)
+       trafo <- .define.tau.Dtau.withMu(of.interest, btq, bDq, btes, bDes,
+                                        btel, bDel, p, N)
     }else if(is.matrix(trafo) & nrow(trafo) > 3)
            stop("number of rows of 'trafo' > 3")
 ####
@@ -174,7 +285,8 @@
 
     modifyPar <- function(theta){
         theta <- makeOKPar(theta)
-        if(..withWarningGEV).warningGEVShapeLarge(theta["shape"])
+        sh <- if(!is.null(names(theta))) theta["shape"] else theta[3]
+        if(..withWarningGEV).warningGEVShapeLarge(sh)
         if(!is.null(names(theta))){
             loc <- theta["loc"]
             sc <- theta["scale"]
@@ -274,7 +386,7 @@
 
 
     FisherInfo <- FisherInfo.fct(param)
-    name <- "GEV Family"
+    name <- if(..name=="") "GEV Family" else ..name
 
     ## initializing the GPareto family with components of L2-family
     L2Fam <- new("GEVFamilyMuUnknown")
@@ -288,8 +400,8 @@
     L2Fam at startPar <- startPar
     L2Fam at makeOKPar <- makeOKPar
     L2Fam at modifyParam <- modifyPar
-    L2Fam at L2derivSymm <- FunSymmList(NonSymmetric(), NonSymmetric())
-    L2Fam at L2derivDistrSymm <- DistrSymmList(NoSymmetry(), NoSymmetry())
+    L2Fam at L2derivSymm <- FunSymmList(NonSymmetric(), NonSymmetric(), NonSymmetric())
+    L2Fam at L2derivDistrSymm <- DistrSymmList(NoSymmetry(), NoSymmetry(), NoSymmetry())
 
     L2deriv <- EuclRandVarList(RealRandVariable(L2deriv.fct(param),
                                Domain = Reals()))
@@ -300,7 +412,7 @@
     }
 
     if(fromOfInt){
-       L2Fam at fam.call <- substitute(GEVFamily(loc = loc0, scale = scale0,
+       L2Fam at fam.call <- substitute(GEVFamilyMuUnknown(loc = loc0, scale = scale0,
                                  shape = shape0, of.interest = of.interest0,
                                  p = p0, N = N0,
                                  withPos = withPos0, withCentL2 = FALSE,
@@ -309,7 +421,7 @@
                               of.interest0 = of.interest, p0 = p, N0 = N,
                               withPos0 = withPos))
     }else{
-       L2Fam at fam.call <- substitute(GEVFamily(loc = loc0, scale = scale0,
+       L2Fam at fam.call <- substitute(GEVFamilyMuUnknown(loc = loc0, scale = scale0,
                                  shape = shape0, of.interest = NULL,
                                  p = p0, N = N0, trafo = trafo0,
                                  withPos = withPos0, withCentL2 = FALSE,

Modified: branches/robast-1.0/pkg/RobExtremes/R/interpolLM.R
===================================================================
--- branches/robast-1.0/pkg/RobExtremes/R/interpolLM.R	2014-04-14 23:24:49 UTC (rev 750)
+++ branches/robast-1.0/pkg/RobExtremes/R/interpolLM.R	2014-04-15 23:12:55 UTC (rev 751)
@@ -16,11 +16,11 @@
 .getLMGrid <- function(xiGrid = getShapeGrid(),
                       PFam = GParetoFamily(scale=1,shape=2),
                       optFct = .RMXE.xi, GridFileName="LMGrid.Rdata",
-                      withPrint = FALSE){
+                      withPrint = FALSE, len = 13){
    ### changed defaults and argnames (for historical reasons):
    ROptEst::.getLMGrid(thGrid = xiGrid, PFam = PFam, optFct = optFct,
            modifyfct = NULL, GridFileName = GridFileName,
-           withPrint = withPrint)}
+           withPrint = withPrint, len = len)}
 
 
 .svInt <- function(optF = .RMXE.th, xiGrid = getShapeGrid(700, cutoff.at.0=0.005),
@@ -30,12 +30,13 @@
                    maxiter = 150, tol = .Machine$double.eps^0.5,
                    loRad = 0, upRad = Inf, loRad0 = 1e-3,
                    loRad.s=0.2, up.Rad.s=1,
-                   withStartLM = TRUE){
+                   withStartLM = TRUE, len = 13){
              namF <- gsub("\\.th$","",paste(deparse(substitute(optF))))
              namF <- gsub(" ", "",namF)
              to <- gsub("XXXX",gsub(" ","",name(PFam)),
                     gsub("YYYY", namF, "interpolYYYYXXXX.csv"))
              print(to)
+             len0 <- if(name(PFam)=="GEVU Family") 25 else 13
              .generateInterpGrid(thGrid = xiGrid,
                   PFam = PFam, toFileCSV = to,
                   getFun =  ROptEst::.getLMGrid,
@@ -44,7 +45,7 @@
                   upper = upper, lower = lower, OptOrIter = OptOrIter,
                   maxiter = maxiter, tol = tol, loRad = loRad, upRad = upRad,
                   loRad0 = loRad0, loRad.s = loRad.s, up.Rad.s = up.Rad.s,
-                  withStartLM = withStartLM)
+                  withStartLM = withStartLM, len = len0)
 }
 
 

Modified: branches/robast-1.0/pkg/RobExtremes/inst/AddMaterial/interpolation/getLMInterpol.R
===================================================================
--- branches/robast-1.0/pkg/RobExtremes/inst/AddMaterial/interpolation/getLMInterpol.R	2014-04-14 23:24:49 UTC (rev 750)
+++ branches/robast-1.0/pkg/RobExtremes/inst/AddMaterial/interpolation/getLMInterpol.R	2014-04-15 23:12:55 UTC (rev 751)
@@ -1,4 +1,4 @@
-getLMs <- function(Gridnam,Famnam,xi=0.7, baseDir="C:/rtest/robast", withPrint=FALSE){
+getLMs <- function(Gridnam,Famnam,xi=0.7, baseDir="C:/rtest/robast", withPrint=FALSE, withLoc = FALSE){
    ## Gridnam in (Sn,OMSE,RMXE,MBRE) ## uses partial matching!!
    ## Famnam in "Generalized Pareto Family",
    ##           "GEV Family",
@@ -6,12 +6,15 @@
    ##           "Weibull Family"  ## uses partial matching!!
    ## xi Scaleparameter (can be vector)
    ## basedir: Oberverzeichnis des r-forge svn checkouts
+   ## withPrint: diagnostischer Output?
+   ## withLoc: anzuschalten bei GEVFamilyMuUnknown...
    file <- file.path(baseDir, "branches/robast-0.9/pkg/RobAStRDA/R/sysdata.rda")
    if(!file.exists(file)) stop("Fehler mit Checkout")
    nE <- new.env()
    load(file, envir=nE)
    Gnams <- c("Sn","OMSE","RMXE","MBRE")
    Fnams <- c("Generalized Pareto Family",
+              "GEVU Family",
               "GEV Family",
               "Gamma family",
               "Weibull Family")
@@ -38,8 +41,16 @@
       len <- length(fct)
       LM <- sapply(1:len, function(i) fct[[i]](xi))
       if(length(xi)==1) LM <- matrix(LM,ncol=len)
-      colnames(LM) <- c("b","a1.a", "a2.a", "a1.i", "a2.i", "A11.a",
-                 "A12.a", "A21.a", "A22.a", "A11.i", "A12.i", "A21.i", "A22.i")
+      if(withLoc){
+         colnames(LM) <- c("b","a1.a", "a2.a", "a3.a", "a1.i", "a2.i", "a3.i",
+                           "A11.a", "A12.a", "A13.a", "A21.a", "A22.a", "A23.a",
+                           "A31.a", "A32.a", "A33.a", "A11.i", "A12.i", "A13.i",
+                           "A21.i", "A22.i", "A23.i", "A31.i", "A32.i", "A33.i")
+      }else{
+         colnames(LM) <- c("b","a1.a", "a2.a", "a1.i", "a2.i", "A11.a",
+                           "A12.a", "A21.a", "A22.a", "A11.i", "A12.i",
+                           "A21.i", "A22.i")
+      }
       return(cbind(xi,LM))
    }else{
       Sn <- fct(xi)

Modified: branches/robast-1.0/pkg/RobExtremes/inst/AddMaterial/interpolation/interpolationscripts.R
===================================================================
--- branches/robast-1.0/pkg/RobExtremes/inst/AddMaterial/interpolation/interpolationscripts.R	2014-04-14 23:24:49 UTC (rev 750)
+++ branches/robast-1.0/pkg/RobExtremes/inst/AddMaterial/interpolation/interpolationscripts.R	2014-04-15 23:12:55 UTC (rev 751)
@@ -5,7 +5,7 @@
 ### open R session
 require(RobExtremes)
 ### -> 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-1.0./pkg"
 ## <-
 oldwd <- getwd()
 .myFolderTo <- file.path(.basepath,"RobExtremesBuffer")
@@ -17,7 +17,8 @@
 #
 #PF <- GParetoFamily()
 #PF <- GEVFamily()
-PF <- GammaFamily()
+PF <- GEVFamilyMuUnknown(withPos=FALSE, ..name="GEVU Family")
+#PF <- GammaFamily()
 #PF <- WeibullFamily()
 ###
 .svInt <- RobExtremes:::.svInt
@@ -25,7 +26,8 @@
 #    RobExtremes:::.generateInterpGridSn(PFam = PF)}
 ## to make this parallel, start this on several processors
 #.svInt1()
-.svInt(.OMSE.th, PFam=PF, xiGrid = getShapeGrid(3, cutoff.at.0=0.005))
+#.svInt(.OMSE.th, PFam=PF, xiGrid = getShapeGrid(3, cutoff.at.0=0.005))
+#.svInt(.OMSE.th, PFam=PF)
 #.svInt(.MBRE.th, PFam=PF)
 .svInt(.RMXE.th, PFam=PF)
 setwd(oldwd)

Modified: branches/robast-1.0/pkg/RobExtremes/man/GEVFamilyMuUnknown.Rd
===================================================================
--- branches/robast-1.0/pkg/RobExtremes/man/GEVFamilyMuUnknown.Rd	2014-04-14 23:24:49 UTC (rev 750)
+++ branches/robast-1.0/pkg/RobExtremes/man/GEVFamilyMuUnknown.Rd	2014-04-15 23:12:55 UTC (rev 751)
@@ -7,10 +7,11 @@
   represents a Generalized EV family with unknown location parameter \code{mu}.
 }
 \usage{
-GEVFamilyMuUnknown(loc = 0, scale = 1, shape = 0.5, of.interest = c("scale", "shape"),
-              p = NULL, N = NULL, trafo = NULL, start0Est = NULL, withPos = TRUE,
-              secLevel = 0.7, withCentL2 = FALSE, withL2derivDistr  = FALSE,
-              ..ignoreTrafo = FALSE, ..withWarningGEV = TRUE)
+GEVFamilyMuUnknown(loc = 0, scale = 1, shape = 0.5, of.interest = c("loc",
+              "scale", "shape"), p = NULL, N = NULL, trafo = NULL,
+              start0Est = NULL, withPos = TRUE, secLevel = 0.7,
+              withCentL2 = FALSE, withL2derivDistr  = FALSE,
+              ..ignoreTrafo = FALSE, ..withWarningGEV = TRUE, ..name = "")
 }
 \arguments{
   \item{loc}{ real: known/fixed threshold/location parameter }
@@ -38,6 +39,8 @@
       be computed? Defaults to \code{FALSE} (to speeds up computations).}
   \item{..ignoreTrafo}{logical: only used internally in \code{kStepEstimator}; do not change this.}
   \item{..withWarningGEV}{logical: shall warnings be issued if shape is large?}
+  \item{..name}{character: optional alternative name for the parametric family;
+                used in generating interpolating grids. }
 }
 \details{
   The slots of the corresponding L2 differentiable 

Modified: branches/robast-1.0/pkg/RobExtremes/man/internal-interpolate.Rd
===================================================================
--- branches/robast-1.0/pkg/RobExtremes/man/internal-interpolate.Rd	2014-04-14 23:24:49 UTC (rev 750)
+++ branches/robast-1.0/pkg/RobExtremes/man/internal-interpolate.Rd	2014-04-15 23:12:55 UTC (rev 751)
@@ -30,13 +30,14 @@
 .OMSE.xi(xi, PFam)
 
 .getLMGrid(xiGrid = getShapeGrid(), PFam = GParetoFamily(scale=1,shape=2),
-           optFct = .RMXE.xi, GridFileName="LMGrid.Rdata", withPrint = FALSE)
+           optFct = .RMXE.xi, GridFileName="LMGrid.Rdata", withPrint = FALSE,
+           len = 13)
 
 .svInt(optF = .RMXE.th, xiGrid = getShapeGrid(700, cutoff.at.0=0.005),
        PFam = GParetoFamily(shape=1,scale=2), radius = 0.5, upper = 1e4,
        lower = 1e-4, OptOrIter = "iterate",  maxiter = 150,
        tol = .Machine$double.eps^0.5, loRad = 0, upRad = Inf, loRad0 = 1e-3,
-       loRad.s = 0.2, up.Rad.s = 1, withStartLM = TRUE)
+       loRad.s = 0.2, up.Rad.s = 1, withStartLM = TRUE, len = 13)
 
 .generateInterpGridSn(xiGrid = getShapeGrid(500, cutoff.at.0=0.005),
                       PFam = GParetoFamily(), withPrint = TRUE)
@@ -94,6 +95,7 @@
    internally set to \code{max(loRad,loRad0)}. }
   \item{withStartLM}{ logical of length 1: shall the LM's of the preceding grid
     value serve as starting value for the next grid value? }
+  \item{len}{integer; number of Lagrange multipliers to be calibrated. }
 }
 \details{
    \code{.getpsi} reads the respective interpolating function



More information about the Robast-commits mailing list