From noreply at r-forge.r-project.org Wed Mar 6 16:34:42 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 6 Mar 2013 16:34:42 +0100 (CET) Subject: [Robast-commits] r622 - in branches/robast-0.9/pkg/RobExtremes: . R man Message-ID: <20130306153442.A6258184ECF@r-forge.r-project.org> Author: ruckdeschel Date: 2013-03-06 16:34:42 +0100 (Wed, 06 Mar 2013) New Revision: 622 Modified: branches/robast-0.9/pkg/RobExtremes/DESCRIPTION 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/WeibullFamily.R branches/robast-0.9/pkg/RobExtremes/R/getStartIC.R branches/robast-0.9/pkg/RobExtremes/R/internal-getpsi.R branches/robast-0.9/pkg/RobExtremes/man/internal-interpolate.Rd Log: RobExtremes: scaleshapename in Weibull, GPareto, GEV erh?\195?\164lt benamte Eintr?\195?\164ge .getPsi und getStartIC f?\195?\188r interpolRisk verwenden nun ParamFamParameter Klasse Modified: branches/robast-0.9/pkg/RobExtremes/DESCRIPTION =================================================================== --- branches/robast-0.9/pkg/RobExtremes/DESCRIPTION 2013-02-26 11:43:41 UTC (rev 621) +++ branches/robast-0.9/pkg/RobExtremes/DESCRIPTION 2013-03-06 15:34:42 UTC (rev 622) @@ -9,6 +9,7 @@ distrMod(>= 2.5), RobAStBase(>= 0.9), ROptEst(>= 0.9), robustbase(>= 0.8-0), evd, actuar Imports: RobAStRDA +Suggests: RUnit Author: Peter Ruckdeschel, Matthias Kohl, Nataliya Horbenko Maintainer: Peter Ruckdeschel LazyLoad: yes Modified: branches/robast-0.9/pkg/RobExtremes/R/GEVFamily.R =================================================================== --- branches/robast-0.9/pkg/RobExtremes/R/GEVFamily.R 2013-02-26 11:43:41 UTC (rev 621) +++ branches/robast-0.9/pkg/RobExtremes/R/GEVFamily.R 2013-03-06 15:34:42 UTC (rev 622) @@ -147,7 +147,7 @@ ## parameters names(theta) <- c("loc", "scale", "shape") - scaleshapename <- c("scale", "shape") + scaleshapename <- c("scale"="scale", "shape"="shape") btq <- bDq <- btes <- bDes <- btel <- bDel <- NULL Modified: branches/robast-0.9/pkg/RobExtremes/R/GParetoFamily.R =================================================================== --- branches/robast-0.9/pkg/RobExtremes/R/GParetoFamily.R 2013-02-26 11:43:41 UTC (rev 621) +++ branches/robast-0.9/pkg/RobExtremes/R/GParetoFamily.R 2013-03-06 15:34:42 UTC (rev 622) @@ -50,7 +50,7 @@ ## parameters names(theta) <- c("loc", "scale", "shape") - scaleshapename <- c("scale", "shape") + scaleshapename <- c("scale"="scale", "shape"="shape") btq <- bDq <- btes <- bDes <- btel <- bDel <- NULL if(!is.null(p)){ Modified: branches/robast-0.9/pkg/RobExtremes/R/WeibullFamily.R =================================================================== --- branches/robast-0.9/pkg/RobExtremes/R/WeibullFamily.R 2013-02-26 11:43:41 UTC (rev 621) +++ branches/robast-0.9/pkg/RobExtremes/R/WeibullFamily.R 2013-03-06 15:34:42 UTC (rev 622) @@ -49,7 +49,7 @@ ## parameters names(theta) <- c("scale", "shape") - scaleshapename <- c("scale", "shape") + scaleshapename <- c("scale"="scale", "shape"="shape") btq <- bDq <- btes <- bDes <- btel <- bDel <- NULL if(!is.null(p)){ Modified: branches/robast-0.9/pkg/RobExtremes/R/getStartIC.R =================================================================== --- branches/robast-0.9/pkg/RobExtremes/R/getStartIC.R 2013-02-26 11:43:41 UTC (rev 621) +++ branches/robast-0.9/pkg/RobExtremes/R/getStartIC.R 2013-03-06 15:34:42 UTC (rev 622) @@ -5,8 +5,9 @@ gridn <- type(risk) nam <- name(model) - xi <- main(param(model))["shape"] #[scaleshapename(model)["shape"]] - beta <- main(param(model))["scale"] #[scaleshapename(model)["scale"]] + param1 <- param(model) +# xi <- main(param(model))["shape"] #[scaleshapename(model)["shape"]] +# beta <- main(param(model))["scale"] #[scaleshapename(model)["scale"]] nsng <- character(0) sng <- try(getFromNamespace(.versionSuff(gridn), ns = "RobAStRDA"), silent=TRUE) @@ -16,10 +17,10 @@ interpolfct <- sng[[nam]]$fct .modifyIC <- function(L2Fam, IC){ para <- param(L2Fam) - xi0 <- main(para)["shape"]#[scaleshapename(L2Fam)["scale"]] - beta0 <- main(para)["scale"]#[scaleshapename(L2Fam)["scale"]] - .getPsi(xi0,beta0, interpolfct, L2Fam, type(risk))} - IC0 <- .getPsi(xi, beta, interpolfct, model, type(risk)) + #xi0 <- main(para)["shape"]#[scaleshapename(L2Fam)["scale"]] + #beta0 <- main(para)["scale"]#[scaleshapename(L2Fam)["scale"]] + .getPsi(para, interpolfct, L2Fam, type(risk))} + IC0 <- .getPsi(param1, interpolfct, model, type(risk)) IC0 at modifyIC <- .modifyIC return(IC0) } Modified: branches/robast-0.9/pkg/RobExtremes/R/internal-getpsi.R =================================================================== --- branches/robast-0.9/pkg/RobExtremes/R/internal-getpsi.R 2013-02-26 11:43:41 UTC (rev 621) +++ branches/robast-0.9/pkg/RobExtremes/R/internal-getpsi.R 2013-03-06 15:34:42 UTC (rev 622) @@ -1,6 +1,17 @@ -.getPsi <- function(xi, beta, fct, L2Fam , type){ +.getPsi <- function(param, fct, L2Fam , type){ - L2deriv <- L2Fam at L2deriv + scshnm <- scaleshapename(L2Fam) + shnam <- scshnm["shape"] + scnam <- scshnm["scale"] + xi <- main(param)[shnam] #[["shape"]] + beta <- main(param)[scnam] #[scaleshapename(model)["scale"]] + + #print(param) + #L2deriv <- L2Fam at L2deriv # .fct(param) + #print(get("tr",environment(get("Lambda1", environment(L2deriv[[1]]@Map[[1]]))))) + #print(get("k",environment(get("Lambda1", environment(L2deriv[[1]]@Map[[1]]))))) + #print(get("sc",environment(get("Lambda1", environment(L2deriv[[1]]@Map[[1]]))))) + .dbeta <- diag(c(beta,1)) b <- fct[[1]](xi) a <- c(.dbeta%*%c(fct[[2]](xi),fct[[3]](xi))) Modified: branches/robast-0.9/pkg/RobExtremes/man/internal-interpolate.Rd =================================================================== --- branches/robast-0.9/pkg/RobExtremes/man/internal-interpolate.Rd 2013-02-26 11:43:41 UTC (rev 621) +++ branches/robast-0.9/pkg/RobExtremes/man/internal-interpolate.Rd 2013-03-06 15:34:42 UTC (rev 622) @@ -18,7 +18,7 @@ respective \file{sysdata.rda} file. } \usage{ -.getPsi(xi, beta, fct, L2Fam , type) +.getPsi(param, fct, L2Fam , type) .modify.xi.PFam.call(xi, PFam) @@ -41,6 +41,7 @@ } \arguments{ + \item{param}{object of class \code{"ParamFamParameter"}. } \item{xi}{numeric of length 1; shape value. } \item{PFam}{an object of class \code{"ParamFamily"}, the parametric family at which to evaluate the Lagrange multipliers or LDEstimators; From noreply at r-forge.r-project.org Tue Mar 12 19:54:53 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 12 Mar 2013 19:54:53 +0100 (CET) Subject: [Robast-commits] r623 - in branches/robast-0.9/pkg: ROptEst/R ROptEst/man RobAStRDA RobAStRDA/R RobAStRDA/inst RobAStRDA/inst/AddMaterial RobAStRDA/inst/AddMaterial/interpolation RobAStRDA/man RobExtremes/R RobExtremes/inst/AddMaterial/interpolation RobExtremes/man Message-ID: <20130312185453.F1134184F6D@r-forge.r-project.org> Author: ruckdeschel Date: 2013-03-12 19:54:53 +0100 (Tue, 12 Mar 2013) New Revision: 623 Added: branches/robast-0.9/pkg/RobAStRDA/R/interpolAux.R branches/robast-0.9/pkg/RobAStRDA/inst/AddMaterial/ branches/robast-0.9/pkg/RobAStRDA/inst/AddMaterial/interpolation/ branches/robast-0.9/pkg/RobAStRDA/inst/AddMaterial/interpolation/WriteUp-Interpolators.txt branches/robast-0.9/pkg/RobAStRDA/inst/AddMaterial/interpolation/interpolationscripts.R branches/robast-0.9/pkg/RobAStRDA/man/internal-interpolate.Rd Removed: branches/robast-0.9/pkg/ROptEst/R/recomputeInterpolators.R branches/robast-0.9/pkg/RobAStRDA/R/sysdata.rda branches/robast-0.9/pkg/RobExtremes/R/recomputeInterpolators.R branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/interpolationsmanipulations.R Modified: branches/robast-0.9/pkg/ROptEst/R/interpolLM.R branches/robast-0.9/pkg/ROptEst/man/internal-interpolate.Rd branches/robast-0.9/pkg/RobAStRDA/DESCRIPTION branches/robast-0.9/pkg/RobAStRDA/NAMESPACE branches/robast-0.9/pkg/RobExtremes/R/GEVFamily.R branches/robast-0.9/pkg/RobExtremes/R/SnQn.R branches/robast-0.9/pkg/RobExtremes/R/getStartIC.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/inst/AddMaterial/interpolation/WriteUp-Interpolators.txt branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/interpolationscripts.R branches/robast-0.9/pkg/RobExtremes/man/internal-interpolate.Rd branches/robast-0.9/pkg/RobExtremes/man/interpolateSn.Rd Log: realized Gerald's suggestion: %----------------------------------- separate (1) time-consuming step to generate grids and (2) step to generate interpolator; %----------------------------------- (1) remains in ROptEst/RobExtremes, (2) moves to RobAStRDA (2) does not need to know anything from RobAStFamily, the grids are sufficient; hence RobAStRDA no longer imports ROptEst. In addition changed data structure in system.rda -> now we have one combination grid-family (for both < and > R-2.16) and instead items fct.O and fct.N, and, in addition possibly two grids, one original on (item grid) and one smoothed out one (item gridS). Correspondingly, have updated WriteUp-Interpolators.txt (which is now in both RobExtremes and RobAStRDA) and separated tasks in interpolationscripts.R in both packages; interpolationmanipulations.R is no longer needed and deleted. Currently the csv files with the grids are produced... %--------------- ROptEst: %--------------- + deleted recomputeInterpolators.R; this is now RobAStRDA-functionality + similarly, smoothing is removed from .getLMgrid (and is now in RobAStRDA) + .saveInterpGrid becomes .saveGridToCSV and .generateInterpGrid + .MakeGridList is separated into .MakeSmoothGridList (in RobAStRDA) and . + new functionality .readGridFromCSV + .versionSuff is moved to RobAStRDA %--------------- RobExtremes: %--------------- + Sn methods now all use helper function .Sn.intp which in return uses new data structure + deleted recomputeInterpolators.R (no longer needed) + getSnGrid now only produces a grid (and no longer smoothes) + .saveInterpGrid is replaced by .generateInterpGridSn + .versionSuff is now imported directly from RobAStRDA + .getLMGrid only produces a grid + .svInt only produces a grid + GEVFamily gets a shorter slot name + getStartIC now uses the new data structure in sysdata.rda %--------------- RobAStRDA: %--------------- +sysdata.rda is deleted (but saved locally and still available from earlier revisions); it will be recreated once all csv-files have been produced +obtains new R code in interpolAux.R with functions to - distinguish R-2.16 * .versionSuff - write grids to rda-files * .readGridFromCSV * .saveGridToRda - smooth out grids * .MakeSmoothGridList - produce interpolators * .generateInterpolators * .computeInterpolators - manipulate rda-files * .mergeGrid * .mergeF * .copy_smoothGrid * .renameGridName Modified: branches/robast-0.9/pkg/ROptEst/R/interpolLM.R =================================================================== --- branches/robast-0.9/pkg/ROptEst/R/interpolLM.R 2013-03-06 15:34:42 UTC (rev 622) +++ branches/robast-0.9/pkg/ROptEst/R/interpolLM.R 2013-03-12 18:54:53 UTC (rev 623) @@ -25,17 +25,17 @@ return(res) } + .getLMGrid <- function(thGrid, PFam, optFct = .RMXE.th, modifyfct, - GridFileName="LMGrid.Rdata", - withSmooth = TRUE, withPrint = FALSE, withCall = FALSE){ - print(match.call()) - call <- match.call() + GridFileName="LMGrid.Rdata", withPrint = FALSE){ + wprint <- function(...){ if (withPrint) print(...)} thGrid <- unique(sort(thGrid)) itLM <- 0 getLM <- function(th){ itLM <<- itLM + 1 if(withPrint) cat("Evaluation Nr.", itLM," at th = ",th,"\n") - a <- try(optFct(th=th,PFam=PFam,modifyfct=modifyfct), silent=TRUE) + a <- try( + optFct(th=th,PFam=PFam,modifyfct=modifyfct) , silent=TRUE) if(is(a,"try-error")) a <- rep(NA,13) return(a) } @@ -56,144 +56,47 @@ do.call(distroptions,args=distroptions.old) }) LMGrid <- sapply(thGrid,getLM) - if(GridFileName!="") save(LMGrid, file=GridFileName) - res <- .MakeGridList(thGrid, Y=t(LMGrid), withSmooth = withSmooth) - print(res) - rm(itLM,getLM) - if(withCall) rm(call) - return(list(grid = res$grid, - fct = res$fct, call = if(withCall) call else NULL)) -} + if(length(dim(LMGrid))==3) + LMGrid <- LMGrid[,1,,drop=TRUE] + else LMGrid <- LMGrid[,drop=FALSE] -.MakeGridList <- function(thGrid, Y, withSmooth = TRUE){ - if(length(dim(Y))==3) - LMGrid <- Y[,1,,drop=TRUE] - else LMGrid <- Y[,drop=FALSE] - iNA <- apply(LMGrid,1, function(u) any(is.na(u))) LMGrid <- LMGrid[!iNA,,drop=FALSE] thGrid <- thGrid[!iNA] oG <- order(thGrid) thGrid <- thGrid[oG] LMGrid <- LMGrid[oG,,drop=FALSE] - if(withSmooth) - LMGrid2 <- apply(LMGrid,2,function(u) smooth.spline(thGrid,u)$y) + Grid <- cbind(xi=thGrid,LM=LMGrid) - fctL <- vector("list",ncol(LMGrid)) - xm <- thGrid[1] - xM <- (rev(thGrid))[1] - for(i in 1:ncol(LMGrid)){ - LMG <- LMGrid[,i] - fct <- splinefun(x=thGrid,y=LMG) - ym <- LMG[1] - dym <- (LMG[2]-LMG[1])/(thGrid[2]-thGrid[1]) - yM <- (rev(LMG))[1] - dyM <- ((rev(LMG))[2]-(rev(LMG))[1])/((rev(thGrid))[2]-(rev(thGrid))[1]) - fctX <- function(x){ - y0 <- fct(x) - y1 <- y0 - y1[xxM] <- yM+dyM*(x[x>xM]-xM) - if(any(is.na(y0))) - warning("There have been xi-values out of range of the interpolation grid.") - return(y1) - } - environment(fctX) <- nE <- new.env() - assign("fct",fct, envir=nE) - assign("yM",yM, envir=nE) - assign("ym",ym, envir=nE) - assign("dyM",dyM, envir=nE) - assign("dym",dym, envir=nE) - fctL[[i]] <- fctX - } - if(ncol(LMGrid)==1) fctL <- fctL[[1]] - rm(LMG,fct,fctX,iNA,ym,yM,dym,dyM) - return(list(grid = cbind(xi=thGrid,LM=LMGrid), - fct = fctL)) + if(GridFileName!="") save(Grid, file=GridFileName) + wprint(Grid) + return(Grid) } -.saveInterpGrid <- function(thGrid, PFam, sysRdaFolder, - sysdataWriteFile = "sysdata.rda", getFun = .getLMGrid, ..., - modifyfct, nameInSysdata, GridFileName, withSmooth = TRUE, - withPrint = TRUE, withCall = FALSE, Y = NULL, elseFun = NULL){ - if(missing(sysRdaFolder)) stop("You must specify argument 'sysRdaFolder'.") +.saveGridToCSV <- function(Grid, toFileCSV, namPFam, nameInSysdata){ + write.table(format(Grid,digits=21), + file=toFileCSV, row.names=FALSE, col.names=FALSE) + toFileTXT <- gsub("(.+\\.)csv$","\\1txt",toFileCSV) + cat(file=toFileTXT,namPFam,"\n",nameInSysdata) + return(invisible(NULL)) +} +.readGridFromCSV <- function(fromFileCSV){ + Grid <- as.matrix(read.csv(fromFileCSV)); dimnames(Grid) <- NULL + fromFileTXT <- gsub("(.+\\.)csv$","\\1txt",fromFileCSV) + res2 <- scan(file=fromFileTXT, what=c("character","character")) + return(list(Grid=Grid, namPFam=res2[1], namInSysdata=res2[2])) +} + +.generateInterpGrid <- function(thGrid, PFam, toFileCSV = "temp.csv", + getFun = .getLMGrid, ..., modifyfct, nameInSysdata, + GridFileName, withPrint = TRUE){ if(missing(GridFileName)) GridFileName <- paste(sub("^\\.(.+)","\\1",nameInSysdata),".Rdata",sep="") - newEnv <- new.env() - sysdataFile <- file.path(sysRdaFolder, sysdataWriteFile) - cat("sysdataFile = ", sysdataFile, "\n") - - if(file.exists(sysdataFile)){ - load(file=sysdataFile,envir=newEnv) - whatIsThereAlready <- ls(envir=newEnv, all.names=TRUE) - }else whatIsThereAlready <- character(0) - - cat("whatIsThereAlready = ", head(whatIsThereAlready), "\n") - - if(exists(.versionSuff(nameInSysdata),envir=newEnv,inherits=FALSE)){ - InterpGrids <- get(.versionSuff(nameInSysdata), envir=newEnv) - namesInterpGrids <- names(InterpGrids) - cat(gettext("Names of existing grids:\n")) - cat(paste(" ", namesInterpGrids , "\n")) - - if(name(PFam)%in% namesInterpGrids){ - cat(gettext("There already is a grid for family "), name(PFam),".\n",sep="") - if(!is.null(InterpGrids[[name(PFam)]]$call)){ - cat(gettextf("It was generated by\n"),sep="") - print(InterpGrids[[name(PFam)]]$call) - } - cat("\n", - gettext("Do you really want to overwrite it (yes=1/no else)?"),"\n", - sep="") - ans <- try(scan(what=integer(1)), silent = TRUE) - if(is(ans,"try-error")) ans <- 0 - if(ans==1){ - if(is.null(Y)) { - InterpGrids[[name(PFam)]] <- getFun(thGrid = thGrid, PFam = PFam, - ..., modifyfct = modifyfct, withSmooth = withSmooth, - withPrint = withPrint, withCall = withCall, - GridFileName = GridFileName) - }else{ if(!is.null(elseFun)){ - InterpGrids[[name(PFam)]] <- elseFun(thGrid, Y, - withSmooth = withSmooth) - }else return(NULL) - } - - l.ng <- -1 - cat(gettext("SnGrid successfully produced.\n")) - }else l.ng <- -2 - }else l.ng <- length(InterpGrids)+1 - }else{ - l.ng <- 1 - InterpGrids <- vector("list",1) - whatIsThereAlready <- c(whatIsThereAlready,.versionSuff(nameInSysdata)) - } - - if(l.ng>0){ - if(is.null(Y)) { - InterpGrids[[l.ng]] <- getFun(thGrid = thGrid, PFam = PFam, - ..., modifyfct = modifyfct, withSmooth = withSmooth, - withPrint = withPrint, withCall = withCall, - GridFileName = GridFileName) - }else{ if(!is.null(elseFun)){ - InterpGrids[[l.ng]] <- elseFun(thGrid, Y, withSmooth = withSmooth) - }else return(NULL) - } - cat(gettext("Grid successfully produced.\n")) - names(InterpGrids)[l.ng] <- name(PFam) - } - - if(l.ng> -2){ - assign(.versionSuff(nameInSysdata), InterpGrids, envir=newEnv) - save(list=whatIsThereAlready, file=sysdataFile, envir=newEnv) - tools::resaveRdaFiles(sysdataFile) - cat(gettextf("%s successfully written to sysdata.rda file.\n", - nameInSysdata)) - } - rm(list=whatIsThereAlready,envir=newEnv) - gc() + Grid <- getFun(thGrid = thGrid, PFam = PFam, ..., modifyfct = modifyfct, + withPrint = withPrint, GridFileName = GridFileName) + .saveGridToCSV(Grid,toFileCSV,name(PFam),nameInSysdata) return(invisible(NULL)) } Deleted: branches/robast-0.9/pkg/ROptEst/R/recomputeInterpolators.R =================================================================== --- branches/robast-0.9/pkg/ROptEst/R/recomputeInterpolators.R 2013-03-06 15:34:42 UTC (rev 622) +++ branches/robast-0.9/pkg/ROptEst/R/recomputeInterpolators.R 2013-03-12 18:54:53 UTC (rev 623) @@ -1,228 +0,0 @@ -.recomputeInterpolators <- function(sysdataFiles, sysRdaFolder = ".", - sysdataWriteFile = "sysdata.rda", - excludeGrids = NULL, excludeNams = NULL, - others = FALSE, onlyothers = FALSE, - translate = TRUE, overwrite = TRUE, integrateto = FALSE, - onlyCurrent = FALSE, withPrint =TRUE, - withSmooth = TRUE, - debug = FALSE){ - - wprint <- function(...){ if (withPrint) print(...)} - - sam <- new.env() - 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" - - whatIsThereAlready <- ls(all.names=TRUE, envir=sam) - whatIsThereAlready.N <- grep(paste("^\\..+\\.",keep,"$",sep=""), - whatIsThereAlready,value=T) - - whatIsThereAlready.O <- grep(paste("^\\..+\\.",todo,"$",sep=""), - whatIsThereAlready,value=T) - whatIsThereAlready.E <- setdiff(setdiff(whatIsThereAlready, - whatIsThereAlready.N),whatIsThereAlready.O) - - wprint(whatIsThereAlready.N) - - only.grid <- new.env() - - if(others){ - wprint("recomputed anew from neither .O nor .N architecture") - - for(what in whatIsThereAlready.E){ - wprint(what) - what.to <- paste(what,".",keep,sep="") - vec <- get(what, envir=sam) - for(Fam in names(vec)){ - wprint(Fam) - grid <- vec[[Fam]]$grid - wprint(head(grid)) - a0 <- .MakeGridList(grid[,1], Y=grid[,-1,drop=FALSE], - withSmooth = withSmooth) - vec[[Fam]] <- a0 - } - assign(what.to, vec, envir=only.grid) - } - lsA <- ls(all.names=T,envir=only.grid) - wprint(lsA) - } - - if(!onlyothers){ - - wprint("copied/recomputed anew from from current architecture") - - for(what in whatIsThereAlready.N){ - wprint(what) - vec <- get(what, envir=sam) - if(overwrite){ - for(Fam in names(vec)){ - wprint(Fam) - grid <- vec[[Fam]]$grid - wprint(head(grid)) - a0 <- .MakeGridList(grid[,1], Y=grid[,-1,drop=FALSE], - withSmooth = withSmooth) - vec[[Fam]] <- a0 - } - } - if(integrateto){ - vec.E <- get(what, envir = only.grid) - for(Fam in names(vec)){ - wprint(Fam) - grid.E <- vec.E[[Fam]]$grid - grid <- vec[[Fam]]$grid - grid.0 <- rbind(grid.E, grid) - oI <- order(grid.0[,1]) - wI <- !duplicated(grid.0[oI,1]) - grid <- grid.0[wI,] - wprint(head(grid)) - a0 <- .MakeGridList(grid[,1], Y=grid[,-1,drop=FALSE], - withSmooth = withSmooth) - vec[[Fam]] <- a0 - } - } - assign(what, vec, envir=only.grid) - } - lsA <- ls(all.names=T,envir=only.grid) - wprint(lsA) - - if(!onlyCurrent){ - wprint("copy foreign architecture") - for(what in whatIsThereAlready.O){ - wprint(what) - assign(what, get(what, envir=sam), envir=only.grid) - } - } - lsA <- ls(all.names=T,envir=only.grid) - wprint(lsA) - - if(translate) - for(what in whatIsThereAlready.O){ - wprint("translating foreign to current architecture") - what.N <- sub(paste("\\.", todo, "$", sep=""), - paste(".", keep, sep=""),what) - wprint(c(from=what, to=what.N)) - - wG <- get(what, envir=sam) - anyFam <- FALSE - vec <- NULL - if(onlyCurrent) if(what.N %in% whatIsThereAlready.N) - vec <- get(what.N,envir=sam) - for(Fam in names(wG)){ - wprint(Fam) - if(! Fam %in% names(vec)){ - anyFam <- TRUE - grid <- wG[[Fam]]$grid - wprint(head(grid)) - a0 <- .MakeGridList(grid[,1], Y=grid[,-1,drop=FALSE], - withSmooth = withSmooth) - vec[[Fam]] <- a0 - } - } - if(integrateto){ - vec.E <- get(what, envir = only.grid) - anyFam <- TRUE - for(Fam in names(wG)){ - wprint(Fam) - grid.E <- vec.E[[Fam]]$grid - grid <- wG[[Fam]]$grid - grid.0 <- rbind(grid.E, grid) - oI <- order(grid.0[,1]) - wI <- !duplicated(grid.0[oI,1]) - grid <- grid.0[wI,] - wprint(head(grid)) - a0 <- .MakeGridList(grid[,1], Y=grid[,-1,drop=FALSE], - withSmooth = withSmooth) - vec[[Fam]] <- a0 - } - } - if(anyFam) assign(what.N, vec, envir=only.grid) - } - lsA <- ls(all.names=T,envir=only.grid) - wprint(lsA) - } - - sysFile <- file.path(sysRdaFolder, sysdataWriteFile) - - if(!debug){ - save(list=lsA, envir=only.grid, file=sysFile) - tools::resaveRdaFiles(sysFile) - }else{ - print(paste("save(list=lsA, envir=only.grid, file=", sysFile,")", sep="")) - } -} - -.renameGridName <- function(gridnam, namOld, namNew, rdafileOld, rdafileNew){ - nE <- new.env() - load(rdafileOld,envir=nE) - what <- ls(all.names=TRUE,envir=nE) - a <- get(gridnam, envir=nE) - na <- names(a) - wi <- which(namOld==na) - na[wi] <- namNew - names(a) <- na - assign(gridnam,a,envir=nE) - save(list=what, file=rdafileNew, envir=nE) -} - -.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){ - wG2 <- get(w2, envir=envir2) - 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]] - } - } - assign(w2,wG2,envir=envir) - } - return(invisible(NULL)) -} -if(FALSE){ - a <- NULL; a[["TU"]] = 2 - save(a,file="testA.Rdata") - a <- NULL; a[["HU"]] = 3 - nE <- new.env(); assign("a",a,envir=nE) - .mergeF("testA.Rdata",nE) - get("a",envir=nE) -} - -.copyGrid <- function(grid, gridnam, namOld, namNew, rdafileOld, rdafileNew){ - nE <- new.env() - load(rdafileOld,envir=nE) - gr <- get(gridnam,envir=nE) - gr[[namNew]] <- gr[[namOld]] - gr[[namNew]]$grid <- grid - assign(gridnam,gr,envir=nE) - what <- ls(envir=nE, all.names = TRUE) - save(list=what, file= rdafileNew, envir=nE) -} - -if(FALSE){ - source("makegridlist.R") - .myFolder <- "C:/rtest/RobASt/branches/robast-0.9/pkg" - source(file.path(.myFolder,"RobExtremes/R","recomputeinterpolators.R")) - .myfiles1 <- file.path(.myFolder, - c("ROptEst/R", "RobExtremes/R", "RobExtremesBuffer"), - "sysdata.rda") - - .myfiles <- file.path(.myFolder, "RobExtremes/R/sysdata.rda") - - .recomputeInterpolators(file.path(.myFolder,"RobExtremes/R/sysdata.rda"), - sysRdaFolder = file.path(.myFolder,"RobExtremes/R"), debug = TRUE) - - wha <- c(".OMSE",".RMXE",".MBRE",".SnGrids") - for(w in wha) assign(w,get(w, envir=asNamespace("RobExtremes")),envir=nE) - save(list=wha,envir=nE, file="sysdata-oold.rda") - - .recomputeInterpolators(c("sysdata-ooold.rda","sysdata-0.rda"), others = TRUE, onlyothers = FALSE, sysRdaFolder = ".", integrateto = TRUE) - -} \ No newline at end of file Modified: branches/robast-0.9/pkg/ROptEst/man/internal-interpolate.Rd =================================================================== --- branches/robast-0.9/pkg/ROptEst/man/internal-interpolate.Rd 2013-03-06 15:34:42 UTC (rev 622) +++ branches/robast-0.9/pkg/ROptEst/man/internal-interpolate.Rd 2013-03-12 18:54:53 UTC (rev 623) @@ -1,20 +1,16 @@ \name{internal_interpolate_helpers} \alias{internal_interpolate_helpers} \alias{internalInterpolate} -\alias{.mergeF} -\alias{.copyGrid} -\alias{.renameGridName} -\alias{.MakeGridList} -\alias{.saveInterpGrid} -\alias{.recomputeInterpolators} -\alias{.versionSuff} +\alias{.saveGridToCSV} +\alias{.readGridFromCSV} +\alias{.generateInterpGrid} \alias{.getLMGrid} \alias{.RMXE.th} \alias{.MBRE.th} \alias{.OMSE.th} \title{Internal helper functions for generating interpolation grids for - speed up in package RobExtremes} + speed up in package ROptEst} \description{ These functions are used internally to generate interpolation grids, @@ -23,37 +19,25 @@ respective \file{sysdata.rda} file. } \usage{ -.versionSuff(name) .RMXE.th(th, PFam, modifyfct) .MBRE.th(th, PFam, modifyfct) .OMSE.th(th, PFam, modifyfct) .getLMGrid(thGrid, PFam, optFct = .RMXE.th, modifyfct, - GridFileName="LMGrid.Rdata", withSmooth = TRUE, - withPrint = FALSE, withCall = FALSE) + GridFileName = "LMGrid.Rdata", withPrint = FALSE) -.MakeGridList(thGrid, Y, withSmooth = TRUE) -.saveInterpGrid(thGrid, PFam, sysRdaFolder, sysdataWriteFile = "sysdata.rda", - getFun = .getLMGrid, ..., modifyfct, nameInSysdata, GridFileName, - withSmooth = TRUE, withPrint = TRUE, withCall = FALSE, Y = NULL, - elseFun = NULL) +.saveGridToCSV(Grid, toFileCSV, namPFam, nameInSysdata) -.recomputeInterpolators(sysdataFiles, sysRdaFolder = ".", - sysdataWriteFile = "sysdata.rda", excludeGrids = NULL, - excludeNams = NULL, others = FALSE, - onlyothers = FALSE, translate = TRUE, overwrite = TRUE, - integrateto = FALSE, onlyCurrent = FALSE, withPrint =TRUE, - withSmooth = TRUE, debug = FALSE) +.readGridFromCSV <- function(fromFileCSV) -.renameGridName(gridnam, namOld, namNew, rdafileOld, rdafileNew) -.copyGrid(grid, gridnam, namOld, namNew, rdafileOld, rdafileNew) -.mergeF(file,envir, excludeGrids = NULL, excludeNams = NULL) +.generateInterpGrid(thGrid, PFam, toFileCSV = "temp.csv", + getFun = .getLMGrid, ..., modifyfct, nameInSysdata, + GridFileName, withPrint = TRUE) } \arguments{ - \item{name}{Grid name to append a suffix according to the R-version. } \item{th}{numeric of length 1; the grid value at which to compute LMs. } \item{PFam}{an object of class \code{"ParamFamily"}, the parametric family at which to evaluate the Lagrange multipliers or LDEstimators; @@ -65,124 +49,41 @@ \item{withSmooth}{logical of length 1: shall a smoothing spline be used?} \item{withPrint}{logical of length 1: shall current grid value be printed out?} \item{thGrid}{numeric; grid values. } - \item{Y}{in case \code{.MakeGridList}: array or matrix; in case - \code{.saveInterpGrid} array or \code{NULL}; if non-null, - contains precomputed y-values, so that call to \code{getFun} - resp. \code{optFct} can be omitted. } \item{optFct}{function with arguments \code{theta}, \code{PFam}, and modifyfct; determines the Lagrange multipliers. } \item{GridFileName}{character; if \code{GridFileName!=""}, the pure y-grid values are saved under this filename. } - \item{withCall}{logical of length 1: shall the call be saved, too?} - \item{thGrid}{numeric; grid values. } - \item{sysRdaFolder}{the folder where \pkg{RobExtremes} - (or the respective package) is being developed; must not be missing. } + \item{Grid}{numeric; grid matrix (x- and y-values). } + \item{toFileCSV}{character; name of the csv file to which the grid is written. } + \item{namPFam}{character; name of the parametric family for which the grid + was generated. } + \item{nameInSysdata}{character; grid name (e.g., 'OMSE', 'Sn') for which the grid + was generated. } + \item{fromFileCSV}{character; name of the csv file from which the grid is read. } \item{getFun}{function with first argument \code{th}, second argument \code{PFam} and last arguments \code{GridFileName}, - \code{withSmooth}, \code{withPrint}, and \code{withCall}; - produces the y-values for the interpolation grid. } + \code{withPrint}; produces the y-values for the + interpolation grid. } \item{\dots}{further arguments to be passed on to \code{getFun}. } - \item{nameInSysdata, nam}{name under which the list of interpolated grids is stored - in file \file{sysdata.rda}. } - \item{elseFun}{function or \code{NULL}; if \code{Y} is non-null, contains - function to transform \code{Y} to desired return value. } - - \item{sysdataFiles}{character; filenames of \file{sysdata.rda} files from - where to extract the interpolation grids. } - \item{sysdataWriteFile}{filename for the \file{sysdata.rda} on which to write - the results.} - \item{excludeGrids}{character (or \code{NULL}); grids to be excluded - from recomputation} - \item{excludeNams}{character (or \code{NULL}); families to be excluded - from recomputation} - \item{overwrite}{logical; if \code{TRUE} foreign grids are translated - to current R version. } - \item{overwrite}{logical; if \code{TRUE} existing interpolation functions - for the current R version get recomputed.} - \item{others}{logical; if \code{TRUE} and in the \file{sysdata.rda} files - to be modified, there are grids not ending to \code{.N} (for R>2.16) - or \code{.O} (for R<2.16), we also recompute the interpolation - functions for these grids. } - \item{onlyothers}{logical; if \code{TRUE}, only the interpolation functions - for \code{others}-grids (see argument \code{others}) are recomupted. } - \item{onlyCurrent}{logical; if \code{TRUE} existing interpolation functions - for the foreign R version are not included in the new \file{sysdata.rda} - file.} - \item{integrateto}{logical; if \code{TRUE} and there are grids with - ending \code{.N}, \code{.O} and ``others'', these are merged. } - \item{debug}{logical; if \code{TRUE} the \file{sysdata.rda} file is not - created/overwritten in the end. } - \item{gridnam}{character; name of the grid to be renamed. } - \item{namOld}{character; name of the parametric family to be renamed (from). } - \item{namNew}{character; name of the parametric family to be renamed (to). } - \item{grid}{matrix or array; grid to be inserted. } - \item{rdafileOld}{character; filename of the \file{sysdata.rda}-type file - to be read out.} - \item{rdafileNew}{character; filename of the \file{sysdata.rda}-type file - to be written on.} - \item{file}{character; the name of a file to be read out} - \item{envir}{an environment} - \item{name}{character; name of the symbol in the \file{sysdata.rda} - interpolation object without suffix} - \item{xi}{numeric; shape parameter} - \item{beta}{numeric; scale parameter} - \item{fct}{a list of functions} - \item{L2Fam}{ object of class \code{L2ParamFamily} } - \item{type}{type of the IC; one of the values \code{".OMSE"}, - \code{".RMXE"}, \code{".MBRE"}.} } \details{ - \code{.versionSuff}, according to the current R-version, appends a suffix - ".O" for R<2.16 and ".N" otherwise to argument \code{name}. Needed as - the return values of \code{splinefun} are incompatible in these two - situations: i.e., a function with body of type - \code{.C("R_splinefun", as.double(x),....}) respectively - a function with body of type \code{.splinefun(....))}); - a similar case happens with \code{approxfun}. - \code{.MBRE.th} computes the Lagrange multipliers for the MBRE estimator, \code{.OMSE.th} for the OMSE estimator at radius \code{r=0.5}, and \code{.RMXE.th} the RMXE estimator. - \code{.MakeGridList} transforms the return values of the preceding functions - gathered in matrices in respective grids and can also be used for - Lagrange multiplier matrices already computed otherwise. - - \code{.saveInterpGrid} is the utility to do the actual computation. - More specifically, the code first loads the contents of file - \file{sysdata.rda} into an environment which is particularly created - for this purpose (if this file exists). It then looks up whether a - respective entry for family \code{PFam} already exists in - \file{sysdata.rda}-object \code{nameInSysdata}. - If this is the case the developer is asked whether he wants to overwrite - the respective entry, and if so he does so with the results of a respective - call to \code{getFun}. + \code{.getLMGrid} in a large loop computes the Lagrange multipliers for + optimally robust IFs for each element of a given grid. + + \code{.saveGridToCSV} saves a given grid to a csv file, and in addition, + in a file with same name but with file extension ".txt" writes the + parametric family and the grid name. - In case there has not been an \file{sysdata.rda}-object \code{nameInSysdata} - so far, the code creates one and writes the results of a respective - call to \code{getFun} to it. + \code{.readGridFromCSV} reads in a grid from a csv file together with the + information given in the corresponding ".txt" file. - \code{.recomputeInterpolators} recomputes the interpolating functions from - grids in existing \file{sysdata.rda} files -- either to translate them - to another R version, or to shrink the respective file. - - \code{.renameGridName} is a utility to rename items from a grid. It takes - grid \code{gridnam} from file \code{rdafileOld} and takes - the name \code{namOld} of a respective item (i.e., a parametric family), - renames it to \code{namNew} and writes the result back - to file \code{rdafileNew}. - - \code{.copyGrid} takes out a respective item \code{namOld} (i.e., a parametric - family) of grid \code{gridnam} from file \code{rdafileOld} - copies it to a new grid object onto item \code{namNew}, replaces - the respective grid-entry by \code{grid}, and saves the result to - to file \code{rdafileNew}. - - \code{.mergeF} merges the contents of file \code{file} into environment - \code{envir} in the sense, that if both \code{file} and \code{envir} - contain a list object \code{a} also the items of \code{a} are merged, - where---as for objects themselves--- contents of \code{file} overwrite - contents of \code{envir}. + \code{.generateInterpGrid} by means of calls to function-argument \code{getFun} + (e.g. \code{getLMGrid} computes the grid, if desired smoothes it, and + then saves it to \code{.csv}. } \note{These functions are only meant for the developers of package \pkg{ROptEst} (or respective packages). @@ -196,7 +97,6 @@ which is why we use \code{.versionSuff}. } \value{ - \item{.versionSuff}{A character with appended suffix. } \item{.MBRE.th}{A list with items \code{b} (a number; clipping height), \code{a} (a 2-vector; outer centering), \code{a.w} (a 2-vector; inner centering, in @@ -205,16 +105,16 @@ } \item{.OMSE.th}{as \code{.MBRE.th}. } \item{.RMXE.th}{as \code{.MBRE.th}. } - \item{.getLMGrid}{A list with items \code{grid}, a matrix with the interpolation - grid and \code{fct} a function in \code{x} (the shape) - and \code{i} deciding on the Lagrange multiplier. } - \item{.MakeGridList}{A list with items \code{grid} and \code{fct} as - in the return value of \code{.getLMGrid}. } - \item{.saveInterpGrid}{\code{invisible(NULL)}. } - \item{.recomputeInterpolators}{\code{invisible(NULL)}. } - \item{.renameGridName}{\code{invisible(NULL)}. } - \item{.mergeF}{\code{invisible(NULL)}. } - \item{.copyGrid}{\code{invisible(NULL)}. } + \item{.getLMGrid}{A grid (in form of a matrix of x and y-values) pasted + together by \code{cbind}. } + + \code{.saveGridToCSV}{\code{invisible(NULL)}. } + + \code{.readGridFromCSV}{ a list with the read-in items, i.e., + an item \code{Grid} with the grid, an item \code{namPFam} with the name of + the parametric family, and \code{namInSysdata}, the name of the read in grid. } + + \code{.generateInterpGrid}{\code{invisible(NULL)}. } } \keyword{internal} \concept{utilities} Modified: branches/robast-0.9/pkg/RobAStRDA/DESCRIPTION =================================================================== --- branches/robast-0.9/pkg/RobAStRDA/DESCRIPTION 2013-03-06 15:34:42 UTC (rev 622) +++ branches/robast-0.9/pkg/RobAStRDA/DESCRIPTION 2013-03-12 18:54:53 UTC (rev 623) @@ -4,7 +4,6 @@ Title: sysdata.rda for packages of RobASt - Family of Pkgs Description: sysdata.rda for packages of RobASt - Family of Pkgs; is currently used by pkg RobExtremes only. Depends: R (>= 2.14.0), methods -Imports: ROptEst (>= 0.9) Author: Peter Ruckdeschel, Matthias Kohl Maintainer: Peter Ruckdeschel LazyData: yes Modified: branches/robast-0.9/pkg/RobAStRDA/NAMESPACE =================================================================== --- branches/robast-0.9/pkg/RobAStRDA/NAMESPACE 2013-03-06 15:34:42 UTC (rev 622) +++ branches/robast-0.9/pkg/RobAStRDA/NAMESPACE 2013-03-12 18:54:53 UTC (rev 623) @@ -1 +0,0 @@ -import("ROptEst") \ No newline at end of file Added: branches/robast-0.9/pkg/RobAStRDA/R/interpolAux.R =================================================================== --- branches/robast-0.9/pkg/RobAStRDA/R/interpolAux.R (rev 0) +++ branches/robast-0.9/pkg/RobAStRDA/R/interpolAux.R 2013-03-12 18:54:53 UTC (rev 623) @@ -0,0 +1,292 @@ +.versionSuff <- function(name){ + paste(sep="", name, if(getRversion()<"2.16") ".O" else ".N") +} + +.MakeSmoothGridList <- function(thGrid, Y, df=NULL){ + if(length(dim(Y))==3) + LMGrid <- Y[,1,,drop=TRUE] + else LMGrid <- Y[,drop=FALSE] + + iNA <- apply(LMGrid,1, function(u) any(is.na(u))) + LMGrid <- LMGrid[!iNA,,drop=FALSE] + thGrid <- thGrid[!iNA] + oG <- order(thGrid) + thGrid <- thGrid[oG] + LMGrid <- LMGrid[oG,,drop=FALSE] + + LMGrid <- apply(LMGrid,2,function(u) if(is.null(df)) + smooth.spline(thGrid,u)$y else smooth.spline(thGrid,u,df=df)$y + ) + return(cbind(xi=thGrid,LM=LMGrid)) +} + +.readGridFromCSV <- function(fromFileCSV){ + Grid <- as.matrix(read.csv(fromFileCSV)); dimnames(Grid) <- NULL + fromFileTXT <- gsub("(.+\\.)csv$","\\1txt",fromFileCSV) + res2 <- scan(file=fromFileTXT, what=c("character","character")) + return(list(Grid=Grid, namPFam=res2[1], namInSysdata=res2[2])) +} + +############################################################################ +# .generateInterpolators generates the interpolators to a given grid +# and returns a list of the given grid and the function list +############################################################################ +.generateInterpolators <- function(Grid, approxOrspline = "spline"){ + thGrid <- Grid[,1] + LMGrid <- Grid[,-1,drop=FALSE] + fctL <- vector("list",ncol(LMGrid)) + xm <- thGrid[1] + xM <- (rev(thGrid))[1] + for(i in 1:ncol(LMGrid)){ + LMG <- LMGrid[,i] + fct <- if(approxOrspline=="spline") + splinefun(x=thGrid,y=LMG) else approxfun(x=thGrid,y=LMG) + ym <- LMG[1] + dym <- (LMG[2]-LMG[1])/(thGrid[2]-thGrid[1]) + yM <- (rev(LMG))[1] + dyM <- ((rev(LMG))[2]-(rev(LMG))[1])/((rev(thGrid))[2]-(rev(thGrid))[1]) + fctX <- function(x){ + y0 <- fct(x) + y1 <- y0 + y1[xxM] <- yM+dyM*(x[x>xM]-xM) + if(any(is.na(y0))) + warning(paste("There have been xi-values out of range ", + "of the interpolation grid.", sep = "")) + return(y1) + } + environment(fctX) <- nE <- new.env() + assign("fct",fct, envir=nE) + assign("yM",yM, envir=nE) + assign("ym",ym, envir=nE) + assign("dyM",dyM, envir=nE) + assign("dym",dym, envir=nE) + fctL[[i]] <- fctX + } + if(ncol(LMGrid)==1) fctL <- fctL[[1]] + rm(LMG,fct,fctX,ym,yM,dym,dyM) + return(list(grid = Grid, fct = fctL)) +} + + +############################################################################ +# .saveGridToRda loads in one or more grids from one ore more csv file(s) +# (argument fromFileCSV) and writes the respective merged grid to an +# rda-file generated from toFileRDA, sysRdaFolder +# if withMerge == FALSE corresponding entries are not merged but overwritten +############################################################################ +.saveGridToRda <- function(fromFileCSV, toFileRDA = "sysdata.rda", + withMerge =FALSE, withPrint = TRUE, + withSmooth = TRUE, df = NULL){ + [TRUNCATED] To get the complete diff run: svnlook diff /svnroot/robast -r 623 From noreply at r-forge.r-project.org Tue Mar 12 20:32:17 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 12 Mar 2013 20:32:17 +0100 (CET) Subject: [Robast-commits] r624 - in branches/robast-0.9/pkg: ROptEst/R RobExtremes/R RobExtremes/inst/AddMaterial/interpolation Message-ID: <20130312193217.2BCB118423B@r-forge.r-project.org> Author: ruckdeschel Date: 2013-03-12 20:32:16 +0100 (Tue, 12 Mar 2013) New Revision: 624 Modified: branches/robast-0.9/pkg/ROptEst/R/interpolLM.R branches/robast-0.9/pkg/RobExtremes/R/interpolLM.R branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/interpolationscripts.R Log: ROptEst: corrected a bug in .getLMGrid (missed on transposition) Modified: branches/robast-0.9/pkg/ROptEst/R/interpolLM.R =================================================================== --- branches/robast-0.9/pkg/ROptEst/R/interpolLM.R 2013-03-12 18:54:53 UTC (rev 623) +++ branches/robast-0.9/pkg/ROptEst/R/interpolLM.R 2013-03-12 19:32:16 UTC (rev 624) @@ -55,10 +55,7 @@ on.exit({do.call(distrExOptions,args=distrExOptions.old) do.call(distroptions,args=distroptions.old) }) - LMGrid <- sapply(thGrid,getLM) - if(length(dim(LMGrid))==3) - LMGrid <- LMGrid[,1,,drop=TRUE] - else LMGrid <- LMGrid[,drop=FALSE] + LMGrid <- t(sapply(thGrid,getLM)) iNA <- apply(LMGrid,1, function(u) any(is.na(u))) LMGrid <- LMGrid[!iNA,,drop=FALSE] @@ -78,7 +75,7 @@ write.table(format(Grid,digits=21), file=toFileCSV, row.names=FALSE, col.names=FALSE) toFileTXT <- gsub("(.+\\.)csv$","\\1txt",toFileCSV) - cat(file=toFileTXT,namPFam,"\n",nameInSysdata) + cat(file=toFileTXT,gsub(" ","",namPFam),"\n",nameInSysdata) return(invisible(NULL)) } Modified: branches/robast-0.9/pkg/RobExtremes/R/interpolLM.R =================================================================== --- branches/robast-0.9/pkg/RobExtremes/R/interpolLM.R 2013-03-12 18:54:53 UTC (rev 623) +++ branches/robast-0.9/pkg/RobExtremes/R/interpolLM.R 2013-03-12 19:32:16 UTC (rev 624) @@ -28,6 +28,7 @@ .svInt <- function(optF = .RMXE.th, xiGrid = getShapeGrid(500, cutoff.at.0=0.005), +#.svInt <- function(optF = .RMXE.th, xiGrid = getShapeGrid(5, cutoff.at.0=0.005), PFam = GParetoFamily(shape=1,scale=2)){ namF <- gsub("\\.th$","",paste(deparse(substitute(optF)))) to <- gsub("XXXX",gsub(" ","",name(PFam)), Modified: branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/interpolationscripts.R =================================================================== --- branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/interpolationscripts.R 2013-03-12 18:54:53 UTC (rev 623) +++ branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/interpolationscripts.R 2013-03-12 19:32:16 UTC (rev 624) @@ -25,7 +25,7 @@ RobExtremes:::.generateInterpGridSn(PFam = PF)} ## to make this parallel, start this on several processors #.svInt1() -#.svInt0(.OMSE.th, PFam=PF) +#.svInt(.OMSE.th, PFam=PF) .svInt(.MBRE.th, PFam=PF) -.svInt0(.RMXE.th, PFam=PF) +.svInt(.RMXE.th, PFam=PF) setwd(oldwd) From noreply at r-forge.r-project.org Tue Mar 12 21:46:31 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 12 Mar 2013 21:46:31 +0100 (CET) Subject: [Robast-commits] r625 - in branches/robast-0.9/pkg: ROptEst/R RobAStRDA/R RobAStRDA/inst/AddMaterial/interpolation RobExtremes/R Message-ID: <20130312204631.C8F231848DC@r-forge.r-project.org> Author: ruckdeschel Date: 2013-03-12 21:46:31 +0100 (Tue, 12 Mar 2013) New Revision: 625 Modified: branches/robast-0.9/pkg/ROptEst/R/interpolLM.R branches/robast-0.9/pkg/RobAStRDA/R/interpolAux.R branches/robast-0.9/pkg/RobAStRDA/inst/AddMaterial/interpolation/interpolationscripts.R branches/robast-0.9/pkg/RobExtremes/R/SnQn.R branches/robast-0.9/pkg/RobExtremes/R/getStartIC.R Log: Some bug fixing: .readGridFromCSV, spaces get deleted in names of parametric Families (SnQn.R, getStartIC), lists must grow incrementally (.saveGridToRda); case includeGrids=NULL must be treated separately... Modified: branches/robast-0.9/pkg/ROptEst/R/interpolLM.R =================================================================== --- branches/robast-0.9/pkg/ROptEst/R/interpolLM.R 2013-03-12 19:32:16 UTC (rev 624) +++ branches/robast-0.9/pkg/ROptEst/R/interpolLM.R 2013-03-12 20:46:31 UTC (rev 625) @@ -80,7 +80,11 @@ } .readGridFromCSV <- function(fromFileCSV){ - Grid <- as.matrix(read.csv(fromFileCSV)); dimnames(Grid) <- NULL + rg <- read.table(CSVFiles[1], colClasses=rep("character",2), sep=" ", header=FALSE) + nrg <- nrow(rg) + Grid <- matrix(as.numeric(as.matrix(rg)),nrow=nrg) + + as.matrix(read.csv(fromFileCSV)); dimnames(Grid) <- NULL fromFileTXT <- gsub("(.+\\.)csv$","\\1txt",fromFileCSV) res2 <- scan(file=fromFileTXT, what=c("character","character")) return(list(Grid=Grid, namPFam=res2[1], namInSysdata=res2[2])) Modified: branches/robast-0.9/pkg/RobAStRDA/R/interpolAux.R =================================================================== --- branches/robast-0.9/pkg/RobAStRDA/R/interpolAux.R 2013-03-12 19:32:16 UTC (rev 624) +++ branches/robast-0.9/pkg/RobAStRDA/R/interpolAux.R 2013-03-12 20:46:31 UTC (rev 625) @@ -21,7 +21,11 @@ } .readGridFromCSV <- function(fromFileCSV){ - Grid <- as.matrix(read.csv(fromFileCSV)); dimnames(Grid) <- NULL + rg <- read.table(CSVFiles[1], colClasses=rep("character",2), sep=" ", header=FALSE) + nrg <- nrow(rg) + Grid <- matrix(as.numeric(as.matrix(rg)),nrow=nrg) + + as.matrix(read.csv(fromFileCSV)); dimnames(Grid) <- NULL fromFileTXT <- gsub("(.+\\.)csv$","\\1txt",fromFileCSV) res2 <- scan(file=fromFileTXT, what=c("character","character")) return(list(Grid=Grid, namPFam=res2[1], namInSysdata=res2[2])) @@ -102,7 +106,6 @@ nameInSysdata <- CSVlist[[i]]$namInSysdata namPFam <- CSVlist[[i]]$namPFam Grid <- CSVlist[[i]]$Grid - GridFileName <- paste(sub("^\\.(.+)","\\1",nameInSysdata),".Rdata",sep="") ### check whether object nameInSysdata already exists (ie. some ## grids for this family already exist) or not @@ -141,7 +144,12 @@ } l.ng <- -1 }else l.ng <- -2 - }else l.ng <- length(InterpGrids)+1 + }else { + l.ng <- length(InterpGrids)+1 + InterpGrids[[l.ng]] <- InterpGrids[[l.ng-1]] + InterpGrids[[l.ng]]$fct.O <- NULL + InterpGrids[[l.ng]]$fct.N <- NULL + } } if(l.ng>0){ ## a new family is entered InterpGrids[[l.ng]]$grid <- Grid @@ -194,7 +202,7 @@ includeGrids = includeGrids , includeNams = includeNams, excludeGrids = excludeGrids , excludeNams = excludeNams) - funN <- paste("fun.", if(getRversion()>="2.16") "N" else "O", sep = "") + funN <- .versionSuff("fun") whatIsThereAlready <- ls(all.names=TRUE, envir=samEnv) wprint(whatIsThereAlready) @@ -221,7 +229,8 @@ envir2 <- new.env() load(file,envir=envir2) what0 <- ls(all.names=TRUE,envir=envir2) - rm(list=what0[! what0 %in% includeGrids], envir=envir2) + if(!is.null(includeGrids)) + rm(list=what0[! what0 %in% includeGrids], envir=envir2) rm(list=excludeGrids, envir=envir2) what1 <- ls(all.names=TRUE,envir=envir) what2 <- ls(all.names=TRUE,envir=envir2) Modified: branches/robast-0.9/pkg/RobAStRDA/inst/AddMaterial/interpolation/interpolationscripts.R =================================================================== --- branches/robast-0.9/pkg/RobAStRDA/inst/AddMaterial/interpolation/interpolationscripts.R 2013-03-12 19:32:16 UTC (rev 624) +++ branches/robast-0.9/pkg/RobAStRDA/inst/AddMaterial/interpolation/interpolationscripts.R 2013-03-12 20:46:31 UTC (rev 625) @@ -15,12 +15,14 @@ oldwd <- getwd() .basepath <- "C:/rtest/RobASt/branches/robast-0.9/pkg" .myFolderFrom <- file.path(.basepath,"RobExtremesBuffer") -myRDA0 <- file.path(.basepath,"RobAStRDA/R/sysdata0.rda") -myRDA <- file.path(.basepath,"RobAStRDA/R/sysdata.rda") +#myRDA0 <- file.path(.basepath,"RobAStRDA/R/sysdata0.rda") +#myRDA <- file.path(.basepath,"RobAStRDA/R/sysdata.rda") +myRDA0 <- file.path(.basepath,"RobExtremesBuffer/sysdata0.rda") +myRDA <- file.path(.basepath,"RobExtremesBuffer/sysdata.rda") CSVFiles <- grep("\\.csv$", dir(.myFolderFrom), value=TRUE) CSVFiles <- paste(.myFolderFrom, CSVFiles, sep="/") .saveGridToRda(CSVFiles, toFileRDA = myRDA0, withMerge = FALSE, withPrint = TRUE, withSmooth = TRUE, df = NULL) ## -.computeInterpolators(myRDA0, myRDA) \ No newline at end of file +.computeInterpolators(myRDA0, myRDA) Modified: branches/robast-0.9/pkg/RobExtremes/R/SnQn.R =================================================================== --- branches/robast-0.9/pkg/RobExtremes/R/SnQn.R 2013-03-12 19:32:16 UTC (rev 624) +++ branches/robast-0.9/pkg/RobExtremes/R/SnQn.R 2013-03-12 20:46:31 UTC (rev 625) @@ -116,13 +116,13 @@ } setMethod("Sn", signature(x = "GPareto"), - function(x, ...).Sn.intp(x,"Generalized Pareto Family") ) + function(x, ...).Sn.intp(x,"GeneralizedParetoFamily") ) setMethod("Sn", signature(x = "GEV"), - function(x, ...).Sn.intp(x,"GEV Family") ) + function(x, ...).Sn.intp(x,"GEVFamily") ) setMethod("Sn", signature(x = "Gammad"), - function(x, ...).Sn.intp(x,"Gamma Family") ) + function(x, ...).Sn.intp(x,"GammaFamily") ) setMethod("Sn", signature(x = "Weibull"), - function(x, ...).Sn.intp(x,"Weibull Family") ) + function(x, ...).Sn.intp(x,"WeibullFamily") ) Modified: branches/robast-0.9/pkg/RobExtremes/R/getStartIC.R =================================================================== --- branches/robast-0.9/pkg/RobExtremes/R/getStartIC.R 2013-03-12 19:32:16 UTC (rev 624) +++ branches/robast-0.9/pkg/RobExtremes/R/getStartIC.R 2013-03-12 20:46:31 UTC (rev 625) @@ -4,7 +4,7 @@ mc <- match.call(expand.dots=TRUE) gridn <- type(risk) - nam <- name(model) + nam <- gsub(" ","",name(model)) param1 <- param(model) nsng <- character(0) sng <- try(getFromNamespace(gridn, ns = "RobAStRDA"), silent=TRUE) From noreply at r-forge.r-project.org Tue Mar 12 22:03:33 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 12 Mar 2013 22:03:33 +0100 (CET) Subject: [Robast-commits] r626 - branches/robast-0.9/pkg/RobExtremes/R Message-ID: <20130312210333.E981B1848DC@r-forge.r-project.org> Author: ruckdeschel Date: 2013-03-12 22:03:33 +0100 (Tue, 12 Mar 2013) New Revision: 626 Modified: branches/robast-0.9/pkg/RobExtremes/R/interpolLM.R Log: argh: yet another buglet: wrote the wrong name as Gridname Modified: branches/robast-0.9/pkg/RobExtremes/R/interpolLM.R =================================================================== --- branches/robast-0.9/pkg/RobExtremes/R/interpolLM.R 2013-03-12 20:46:31 UTC (rev 625) +++ branches/robast-0.9/pkg/RobExtremes/R/interpolLM.R 2013-03-12 21:03:33 UTC (rev 626) @@ -31,14 +31,15 @@ #.svInt <- function(optF = .RMXE.th, xiGrid = getShapeGrid(5, cutoff.at.0=0.005), PFam = GParetoFamily(shape=1,scale=2)){ namF <- gsub("\\.th$","",paste(deparse(substitute(optF)))) + namF <- gsub("^\\.(.+)","\\1",namF) to <- gsub("XXXX",gsub(" ","",name(PFam)), - gsub("YYYY", gsub("^\\.(.+)","\\1",namF), "interpolYYYYXXXX.csv")) + gsub("YYYY", namF, "interpolYYYYXXXX.csv")) print(to) ROptEst:::.generateInterpGrid(thGrid = xiGrid, PFam = PFam, toFileCSV = to, getFun = ROptEst:::.getLMGrid, modifyfct = .modify.xi.PFam.call, optFct = optF, - nameInSysdata = name(PFam), withPrint = TRUE) + nameInSysdata = namF, withPrint = TRUE) } From noreply at r-forge.r-project.org Tue Mar 12 22:21:35 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 12 Mar 2013 22:21:35 +0100 (CET) Subject: [Robast-commits] r627 - in branches/robast-0.9/pkg: RobAStRDA/R RobExtremesBuffer Message-ID: <20130312212135.6622A184FAC@r-forge.r-project.org> Author: ruckdeschel Date: 2013-03-12 22:21:35 +0100 (Tue, 12 Mar 2013) New Revision: 627 Added: branches/robast-0.9/pkg/RobAStRDA/R/sysdata.rda branches/robast-0.9/pkg/RobExtremesBuffer/interpolMBREGammafamily.csv branches/robast-0.9/pkg/RobExtremesBuffer/interpolMBREGammafamily.txt branches/robast-0.9/pkg/RobExtremesBuffer/interpolMBREGeneralizedParetoFamily.csv branches/robast-0.9/pkg/RobExtremesBuffer/interpolMBREGeneralizedParetoFamily.txt branches/robast-0.9/pkg/RobExtremesBuffer/interpolMBREWeibullFamily.csv branches/robast-0.9/pkg/RobExtremesBuffer/interpolMBREWeibullFamily.txt branches/robast-0.9/pkg/RobExtremesBuffer/interpolOMSEGammafamily.csv branches/robast-0.9/pkg/RobExtremesBuffer/interpolOMSEGammafamily.txt branches/robast-0.9/pkg/RobExtremesBuffer/interpolOMSEGeneralizedParetoFamily.csv branches/robast-0.9/pkg/RobExtremesBuffer/interpolOMSEGeneralizedParetoFamily.txt branches/robast-0.9/pkg/RobExtremesBuffer/interpolOMSEWeibullFamily.csv branches/robast-0.9/pkg/RobExtremesBuffer/interpolOMSEWeibullFamily.txt branches/robast-0.9/pkg/RobExtremesBuffer/interpolSnGEVFamily.csv branches/robast-0.9/pkg/RobExtremesBuffer/interpolSnGEVFamily.txt branches/robast-0.9/pkg/RobExtremesBuffer/interpolSnGammafamily.csv branches/robast-0.9/pkg/RobExtremesBuffer/interpolSnGammafamily.txt branches/robast-0.9/pkg/RobExtremesBuffer/interpolSnGeneralizedParetoFamily.csv branches/robast-0.9/pkg/RobExtremesBuffer/interpolSnGeneralizedParetoFamily.txt branches/robast-0.9/pkg/RobExtremesBuffer/interpolSnWeibullFamily.csv branches/robast-0.9/pkg/RobExtremesBuffer/interpolSnWeibullFamily.txt Log: generated a first small sysdata.rda file and saved grid-.csv/.txt files Added: branches/robast-0.9/pkg/RobAStRDA/R/sysdata.rda =================================================================== (Binary files differ) Property changes on: branches/robast-0.9/pkg/RobAStRDA/R/sysdata.rda ___________________________________________________________________ Added: svn:mime-type + application/octet-stream Added: branches/robast-0.9/pkg/RobExtremesBuffer/interpolMBREGammafamily.csv =================================================================== --- branches/robast-0.9/pkg/RobExtremesBuffer/interpolMBREGammafamily.csv (rev 0) +++ branches/robast-0.9/pkg/RobExtremesBuffer/interpolMBREGammafamily.csv 2013-03-12 21:21:35 UTC (rev 627) @@ -0,0 +1,500 @@ +" 5.00000000000000010408e-03" "-1.00982070065940998426e-18" "-2.55339651962768687810e+00" "-3.36339197511809628871e-01" "-1.09420186122047313759e+00" "-2.89997302653269883876e+00" "-3.16739094666169507253e-01" "-5.32073335005194159031e-01" " 1.00000000000000000000e+00" " 3.16739094666169507253e-01" "-3.16739094666171061565e-01" "-5.32073335005193270852e-01" " 1.00000000000000000000e+00" " 3.16739094666171117076e-01" +" 2.14517304631997030029e-02" "-4.82935842320461980165e-18" "-2.55631808657576309329e+00" "-3.36681107037086535527e-01" "-1.09752117803523097095e+00" "-2.90428449749350647835e+00" "-3.17047605173607527362e-01" "-5.32213270445117681007e-01" " 1.00000000000000000000e+00" " 3.17047605173607582874e-01" "-3.17047602296437025515e-01" "-5.32213268340001710577e-01" " 1.00000000000000000000e+00" " 3.17047602296437025515e-01" +" 3.98406374501992024961e-02" " 4.90621395856920025835e+03" "-3.98398313356505967553e-02" "-3.48882163125406033130e-03" "-3.98398876049943853617e-02" " 3.06352929382583509532e-02" " 1.00000000000000000000e+00" " 8.75711967348501152397e-02" "-2.90319538573563761074e-08" "-4.46233044040541911273e-11" " 1.00000000000000000000e+00" " 8.75740784383949311120e-02" "-3.30122362061888898291e-08" " 2.56855752674618789588e-09" +" 4.27829746040001568375e-02" " 2.77339001383300546877e+03" "-4.27827479086906187211e-02" " 2.02671172511600765354e-03" "-4.27825299988003338036e-02" " 9.43577965186521705476e-02" " 1.00000000000000000000e+00" "-4.73721731215045460672e-02" "-9.48617519369253703530e-09" " 2.85879222752357087970e-10" " 1.00000000000000000000e+00" "-4.73735907828344363080e-02" "-1.75385915318706266801e-08" "-5.05135549671046610339e-10" +" 6.40397156295258174197e-02" " 1.96374730836904149101e+02" "-6.39444211915746602015e-02" " 2.18334437280984705251e-03" "-6.39435935032025143387e-02" " 2.21579034034090557870e-02" " 1.00000000000000000000e+00" "-3.41443659780056793518e-02" "-6.08900811209607751895e-06" " 3.27043249306490112761e-07" " 1.00000000000000000000e+00" "-3.41861217825643881607e-02" "-6.07903779274325831107e-06" " 3.02586384499666559125e-07" +" 7.96812749003984049923e-02" " 6.72468849997740250046e+01" "-7.90650307974002097833e-02" "-3.61759439461398007391e-04" "-7.90673449296141750420e-02" " 5.56360687599799647041e-02" " 1.00000000000000000000e+00" " 4.57539095843064423652e-03" "-4.87416150044930036422e-05" "-3.31012054164604161152e-07" " 1.00000000000000000000e+00" " 4.60188481579702074464e-03" "-4.82158824086786495702e-05" "-3.12997946534180187310e-07" +" 8.52248570399394278496e-02" " 5.05748216106388710500e+01" "-8.42004669904919261780e-02" "-1.04011013969844824494e-03" "-8.41789966559226277010e-02" " 6.99990051207389496479e-02" " 1.00000000000000000000e+00" " 1.23526396013706046828e-02" "-8.75920143719367301624e-05" "-1.25512218715515417241e-06" " 1.00000000000000000000e+00" " 1.23056821080785080275e-02" "-8.78399930126633188537e-05" "-7.63287308261674394481e-07" +" 1.06341241002067987687e-01" " 2.27607270978044340382e+01" "-1.02044444064894351820e-01" "-1.02625174943695297684e-03" "-1.02006256296263114747e-01" " 8.01759650782425253857e-02" " 1.00000000000000000000e+00" " 1.00580634132519820129e-02" "-4.76299457000312824288e-04" "-3.32213102073979413327e-06" " 1.00000000000000000000e+00" " 1.00580634132519820129e-02" "-4.76299457000312824288e-04" "-3.32213102073979413327e-06" +" 1.19521912350597614427e-01" " 1.61776060707747397771e+01" "-1.11453214525131238943e-01" " 1.28226892463310096970e-04" "-1.11405978653921405863e-01" " 3.88413652716798341036e-02" " 1.00000000000000000000e+00" "-1.14997122461011963210e-03" "-1.01257719309189074888e-03" " 2.69417595710865643359e-06" " 1.00000000000000000000e+00" "-1.34371776413331686650e-03" "-1.01036221825988640176e-03" " 3.06417983145056861677e-06" +" 1.27391651478953704668e-01" " 1.37169550104189461592e+01" "-1.16575017489961935135e-01" "-1.35830526555490681273e-03" "-1.16486163073868526086e-01" " 4.32274218002321047871e-02" " 1.00000000000000000000e+00" " 1.16534164431970465453e-02" "-1.47141381203633246459e-03" "-1.27020108450981448128e-05" " 1.00000000000000000000e+00" " 1.16641439993984945972e-02" "-1.47218182445725868056e-03" "-1.39809091785196050461e-05" +" 1.48378817222630354777e-01" " 9.95312778091069105812e+00" "-1.28657174098686155617e-01" " 4.53468363826784251480e-03" "-1.28381344742023228989e-01" " 6.26792774881252540142e-02" " 1.00000000000000000000e+00" "-3.52603350474222018707e-02" "-4.39220367392098142573e-03" " 1.26081089619882235958e-04" " 1.00000000000000000000e+00" "-3.47741637099316103221e-02" "-4.39093941785058308053e-03" " 1.21953805848630490185e-04" +" 1.59362549800796809985e-01" " 8.55784130732615899717e+00" "-1.33844600711063715925e-01" " 5.33292687041157041487e-05" "-1.33663914776759262804e-01" " 4.36382095648663662080e-02" " 1.00000000000000000000e+00" "-3.88824668343576895693e-04" "-4.41220253304048116300e-03" " 3.12892710784846967255e-05" " 1.00000000000000000000e+00" "-3.37880487148577699809e-04" "-4.41301707502632280938e-03" " 2.96020300273740864382e-05" +" 1.69305414639138729349e-01" " 7.72671611318080220343e+00" "-1.37727650419245034596e-01" " 2.60798650971258200084e-04" "-1.37373618139221831402e-01" " 5.55161155587077098650e-02" " 1.00000000000000000000e+00" "-1.86854251038056197801e-03" "-5.86270725905294141228e-03" " 7.29635708405869029807e-05" " 1.00000000000000000000e+00" "-1.87530972475005914581e-03" "-5.85927180708666929532e-03" " 7.88497257889329855205e-05" +" 1.90174070534208650152e-01" " 6.51630092767227786510e+00" "-1.45911034364068575853e-01" " 7.90571225048673168617e-04" "-1.45382767198915296980e-01" " 5.66641128724714379650e-02" " 1.00000000000000000000e+00" "-5.35495773579774785034e-03" "-9.32439104131329438152e-03" " 2.12746909887945410012e-04" " 1.00000000000000000000e+00" "-5.37655318776941119202e-03" "-9.32409831140806021066e-03" " 2.12948625813452567784e-04" +" 1.99203187250996005542e-01" " 6.13753025481668856855e+00" "-1.49131868961405067431e-01" " 1.65058661850375635108e-03" "-1.47815017753316735316e-01" " 1.28535154127673356683e-01" " 1.00000000000000000000e+00" "-1.08980946118881587281e-02" "-1.11133682707094550574e-02" " 3.21474598743100542335e-04" " 1.00000000000000000000e+00" "-1.13181296873204745301e-02" "-1.11024773657558764595e-02" " 3.42301136773254873098e-04" +" 2.10987364747485084404e-01" " 5.73350252800452508950e+00" "-1.53065568430811926870e-01" " 2.15800064077639351320e-03" "-1.51919653360272549625e-01" " 8.16977343340505868241e-02" " 1.00000000000000000000e+00" "-1.39444553125431230239e-02" "-1.36550183715511506272e-02" " 4.78575521441998430732e-04" " 1.00000000000000000000e+00" "-1.40911332662767060236e-02" "-1.36584123888307262806e-02" " 4.76804618014205834793e-04" +" 2.31747832682678900351e-01" " 5.19388784651925483615e+00" "-1.59135978230555280577e-01" " 3.06811130636445170486e-03" "-1.57602420495749573348e-01" " 8.06973698040313602853e-02" " 1.00000000000000000000e+00" "-1.90348226768871607584e-02" "-1.88971459991826434832e-02" " 8.27806058865627808138e-04" " 1.00000000000000000000e+00" "-1.82796527877949512020e-02" "-1.88925848973945272047e-02" " 8.09156562467113903321e-04" +" 2.39043824701195228855e-01" " 5.04212085239482288301e+00" "-1.61075751943018624646e-01" " 3.33852247504621982635e-03" "-1.59899516809843544873e-01" " 6.36210278020273023447e-02" " 1.00000000000000000000e+00" "-2.05001051116445211220e-02" "-2.10059979620136998146e-02" " 1.00060670554020418946e-03" " 1.00000000000000000000e+00" "-2.06787280619519786562e-02" "-2.10007629189131461711e-02" " 1.01586804724142871700e-03" +" 2.52457967740567557069e-01" " 4.80079667121568132160e+00" "-1.64642757473896034215e-01" " 4.29357480036610898028e-03" "-1.62917064453407200997e-01" " 7.00857040211950166331e-02" " 1.00000000000000000000e+00" "-2.57559738484756453603e-02" "-2.50641041382052946751e-02" " 1.40319564031129171214e-03" " 1.00000000000000000000e+00" "-2.62020305863229670262e-02" "-2.50739632583968537205e-02" " 1.42159699025101249684e-03" +" 2.73120223661343919375e-01" " 4.50200488487466277121e+00" "-1.69472443507709513710e-01" " 5.47497520675910807897e-03" "-1.68220362729774586263e-01" " 3.65897868819460014844e-02" " 1.00000000000000000000e+00" "-3.20674553606682816165e-02" "-3.20071237328752450368e-02" " 2.15997728322461128928e-03" " 1.00000000000000000000e+00" "-3.19671287676690230040e-02" "-3.20164030035751251413e-02" " 2.17968431680836197128e-03" +" 2.78884462151394396656e-01" " 4.43086495270551861125e+00" "-1.70806796366847257751e-01" " 5.59666345049659921113e-03" "-1.69914926154738937791e-01" " 4.21597500236427849551e-02" " 1.00000000000000000000e+00" "-3.24339875006712935468e-02" "-3.39021356846693489029e-02" " 2.30140827260776103039e-03" " 1.00000000000000000000e+00" "-3.35927608599050284144e-02" "-3.38898751400877190632e-02" " 2.25645806208972900600e-03" +" 2.93737016782436521911e-01" " 4.26705033571512437618e+00" "-1.74540433284059354202e-01" " 7.15856694797280170700e-03" "-1.70815869119164215340e-01" " 9.48016091157732609940e-02" " 1.00000000000000000000e+00" "-4.01433541380627340045e-02" "-3.97650199996184422480e-02" " 3.18841331534859290936e-03" " 1.00000000000000000000e+00" "-4.03222503268358192785e-02" "-3.97832688680845453222e-02" " 3.19599274177417846943e-03" +" 3.14310728217555401809e-01" " 4.07739709783176262903e+00" "-1.77750410221578808434e-01" " 8.85170046922112256638e-03" "-1.73397697965937569453e-01" " 8.73712905189069910517e-02" " 1.00000000000000000000e+00" "-4.87011167604964392841e-02" "-4.87682216620088510028e-02" " 4.58980205475399520576e-03" " 1.00000000000000000000e+00" "-4.89655392380142009956e-02" "-4.87501664788640085013e-02" " 4.58909625156156408821e-03" +" 3.18725099601593619969e-01" " 4.04143974127084870673e+00" "-1.79202792426852580698e-01" " 9.03935611230683409845e-03" "-1.89791095698868567121e-01" "-2.09796102600531081395e-01" " 1.00000000000000000000e+00" "-5.33578926652382434792e-02" "-5.04694946224858442818e-02" " 5.18358914837439670176e-03" " 1.00000000000000000000e+00" "-5.33578926652382434792e-02" "-5.04694946224858442818e-02" " 5.18358914837439670176e-03" +" 3.34843705962408810795e-01" " 3.92106677607849229972e+00" "-1.82128837574646096353e-01" " 1.08161764219483896854e-02" "-1.77070646654798574682e-01" " 8.65811055156153752677e-02" " 1.00000000000000000000e+00" "-5.80246231233518122705e-02" "-5.81158723270368479663e-02" " 6.26418127774077283104e-03" " 1.00000000000000000000e+00" "-5.85719614682388353688e-02" "-5.81984320965620166577e-02" " 6.27871955138864946272e-03" +" 3.55338266932213375782e-01" " 3.79013179962546153945e+00" "-1.85548921355858348337e-01" " 1.28387684623298831132e-02" "-1.81574846279538848481e-01" " 5.90402346593460886082e-02" " 1.00000000000000000000e+00" "-6.80334887915021307991e-02" "-6.85168130256849777782e-02" " 8.32799605139068407911e-03" " 1.00000000000000000000e+00" "-6.77224245178752876084e-02" "-6.83905601445249367032e-02" " 8.26922827275102315103e-03" +" 3.58565737051792843282e-01" " 3.77141879461423945585e+00" "-1.86131899324250282834e-01" " 1.32737463672106953405e-02" "-1.81759946491808044300e-01" " 6.23634933649728148697e-02" " 1.00000000000000000000e+00" "-7.00290137955353469978e-02" "-7.01043606851216583031e-02" " 8.74352184969745711840e-03" " 1.00000000000000000000e+00" "-7.00290137955353469978e-02" "-7.01043606851216583031e-02" " 8.74352184969745711840e-03" +" 3.75796698935874085024e-01" " 3.67906055120224850796e+00" "-1.89091039839623664687e-01" " 1.53482095266882605233e-02" "-1.82968445859766015715e-01" " 7.82382114196241151838e-02" " 1.00000000000000000000e+00" "-7.92761839374200721897e-02" "-7.93349460260129729638e-02" " 1.08705719667640636483e-02" " 1.00000000000000000000e+00" "-7.91541874167956682751e-02" "-7.93278039666137357866e-02" " 1.08684452354380189226e-02" +" 3.96221262591437028977e-01" " 3.58393936514548228089e+00" "-1.92164218413639648064e-01" " 1.83388486899423129584e-02" "-1.80692793256640449329e-01" " 1.26882077490609673776e-01" " 1.00000000000000000000e+00" "-9.16314768391108813717e-02" "-9.10983761546352854843e-02" " 1.40857618697970716354e-02" " 1.00000000000000000000e+00" "-9.12276689249569561202e-02" "-9.11640010153186436392e-02" " 1.41270552975373397259e-02" +" 3.98406374501992011083e-01" " 3.57456509447851944472e+00" "-1.91882348842615069184e-01" " 1.85626098089176870543e-02" "-1.80176359957253784394e-01" " 1.24834583706150789584e-01" " 1.00000000000000000000e+00" "-9.28682676162310011270e-02" "-9.29360367065771991735e-02" " 1.46050270952565695859e-02" " 1.00000000000000000000e+00" "-9.32713947124423625734e-02" "-9.28603505484924401925e-02" " 1.46444835126742535503e-02" +" 4.16614193187194392642e-01" " 3.50200070023237053363e+00" "-1.95031676781608098725e-01" " 2.08379695887990004644e-02" "-1.82160504135799428127e-01" " 1.25154589255368542400e-01" " 1.00000000000000000000e+00" "-1.02420200432222538445e-01" "-1.03521097700816633314e-01" " 1.74839450951090255582e-02" " 1.00000000000000000000e+00" "-1.02136269177708446931e-01" "-1.03599211668777294038e-01" " 1.74703561099068503670e-02" +" 4.36977702492617525731e-01" " 3.43099132023955410986e+00" "-1.97692593724390214271e-01" " 2.40393184868868056703e-02" "-1.80116598814152484298e-01" " 1.50250792376090763769e-01" " 1.00000000000000000000e+00" "-1.15308148823247344494e-01" "-1.16611604113746644695e-01" " 2.17704814209854595475e-02" " 1.00000000000000000000e+00" "-1.15368915815952835513e-01" "-1.16737715277546602599e-01" " 2.17494306935341920328e-02" +" 4.38247011952191289907e-01" " 3.42687322480458833596e+00" "-1.97828652519914660601e-01" " 2.45089848935479900915e-02" "-1.79170530397434385472e-01" " 1.58833929437448007072e-01" " 1.00000000000000000000e+00" "-1.17169431208039687142e-01" "-1.17469373128039580867e-01" " 2.21342868623190698607e-02" " 1.00000000000000000000e+00" "-1.17169431208039687142e-01" "-1.17469373128039580867e-01" " 2.21342868623190698607e-02" +" 4.57313980523084140373e-01" " 3.36938907454051594925e+00" "-2.00578451430824616919e-01" " 2.73834678554505418779e-02" "-1.84087912441050688406e-01" " 1.26904611342608136804e-01" " 1.00000000000000000000e+00" "-1.30374090611210052826e-01" "-1.30671099407456747787e-01" " 2.67433383194588016052e-02" " 1.00000000000000000000e+00" "-1.31042895309225027045e-01" "-1.30879686356339675068e-01" " 2.67624174972678312290e-02" +" 4.77625197262214196137e-01" " 3.31567933859289887266e+00" "-2.02800501264754517994e-01" " 3.10793473866574493369e-02" "-1.79272109989126904317e-01" " 1.62685107240615189905e-01" " 1.00000000000000000000e+00" "-1.44116318389582637183e-01" "-1.44625354309958764620e-01" " 3.22298149721669188739e-02" " 1.00000000000000000000e+00" "-1.44116318389582637183e-01" "-1.44625354309958764620e-01" " 3.22298149721669188739e-02" +" 4.78087649402390457709e-01" " 3.31453358934866981755e+00" "-2.02622557363030558752e-01" " 3.11743403960442026779e-02" "-1.78614128791249993089e-01" " 1.66268459793766421040e-01" " 1.00000000000000000000e+00" "-1.44480472355782429972e-01" "-1.45029452350307036523e-01" " 3.24504044036048738819e-02" " 1.00000000000000000000e+00" "-1.45000743264491804840e-01" "-1.45022699208480349009e-01" " 3.25225406858452650849e-02" +" 4.97913504345446511490e-01" " 3.26912300990281767810e+00" "-2.05579182933867177230e-01" " 3.48444155780651201870e-02" "-1.87258667740246936839e-01" " 1.15812342840006188283e-01" " 1.00000000000000000000e+00" "-1.62012361454210634948e-01" "-1.59074847134087787870e-01" " 3.91566487598225265732e-02" " 1.00000000000000000000e+00" "-1.61351817817710518899e-01" "-1.59034198081660832491e-01" " 3.91172201372568667521e-02" +" 5.17928286852589625511e-01" " 3.22930129936843313132e+00" "-2.07932754724310164818e-01" " 3.60002910866294850711e-02" "-2.12792936288191347760e-01" "-2.82257780248279729896e-02" " 1.00000000000000000000e+00" "-1.75520634592398472318e-01" "-1.74818887677198303576e-01" " 4.58541269357335898316e-02" " 1.00000000000000000000e+00" "-1.75398731835058691031e-01" "-1.74838699580467216155e-01" " 4.58386773244408851635e-02" +" 5.18181036708362463550e-01" " 3.22882683449386753693e+00" "-2.07920181878404247700e-01" " 3.58821616710637281145e-02" "-2.14453024403463532455e-01" "-3.64376057356763094486e-02" " 1.00000000000000000000e+00" "-1.75464966739858813094e-01" "-1.74795887162382063140e-01" " 4.57853821103319860719e-02" " 1.00000000000000000000e+00" "-1.75215779311229641335e-01" "-1.74702471257652591774e-01" " 4.57068023427290512362e-02" +" 5.38429914203115922433e-01" " 3.19347217079256839867e+00" "-2.09448657046294312023e-01" " 4.32897240753948864267e-02" "-1.78385174797893952814e-01" " 1.62581779072858256807e-01" " 1.00000000000000000000e+00" "-1.93283846834516354063e-01" "-1.91331820783098099925e-01" " 5.42457582032888421808e-02" " 1.00000000000000000000e+00" "-1.93663775577953112261e-01" "-1.91303062403318568929e-01" " 5.42233731054780690450e-02" +" 5.57768924302788793312e-01" " 3.16437651096472771783e+00" "-2.10898503554692418049e-01" " 4.88831127542599108704e-02" "-1.72806253173128504530e-01" " 1.83773942099300896524e-01" " 1.00000000000000000000e+00" "-2.14660481085829552006e-01" "-2.07339896809926260701e-01" " 6.43273788002433621891e-02" " 1.00000000000000000000e+00" "-2.14618541985938715566e-01" "-2.07338513452241163249e-01" " 6.42546614900631057887e-02" +" 5.58662243186231033398e-01" " 3.16304139041604504001e+00" "-2.12119782062782646914e-01" " 4.87806363556782737745e-02" "-1.65848147815821939099e-01" " 2.23513020531822453885e-01" " 1.00000000000000000000e+00" "-2.09611933454499910212e-01" "-2.07723260052477654014e-01" " 6.27838962211459267193e-02" " 1.00000000000000000000e+00" "-2.10291607495345367340e-01" "-2.07800205508500673846e-01" " 6.29721214772908655100e-02" +" 5.78880118080907335454e-01" " 3.13788148133303756993e+00" "-2.14366513127275754025e-01" " 4.86391098356579801298e-02" "-2.10824363210331766627e-01" " 1.57680604235498622590e-02" " 1.00000000000000000000e+00" "-2.25302281512226254545e-01" "-2.24640813251434229292e-01" " 7.22916944372888753412e-02" " 1.00000000000000000000e+00" "-2.25302281512226254545e-01" "-2.24640813251434229292e-01" " 7.22916944372888753412e-02" +" 5.97609561752988072136e-01" " 3.11760031187475172842e+00" "-2.16246695205899064351e-01" " 5.24157333074751069502e-02" "-2.13147679812416945833e-01" " 1.25662056230807263335e-02" " 1.00000000000000000000e+00" "-2.40339932208848555684e-01" "-2.40925464592205929026e-01" " 8.19929284933313684558e-02" " 1.00000000000000000000e+00" "-2.40550783786313393531e-01" "-2.40898159346104506762e-01" " 8.19716304483326801966e-02" +" 5.99085622916895488288e-01" " 3.11547583881226852753e+00" "-2.14964685626256563067e-01" " 5.74127829664398126042e-02" "-1.59280369248318121045e-01" " 2.29145755405935847016e-01" " 1.00000000000000000000e+00" "-2.41586087049452946651e-01" "-2.42672492282905077898e-01" " 8.25437461597121474588e-02" " 1.00000000000000000000e+00" "-2.41624269553866066751e-01" "-2.42648362517844384811e-01" " 8.25595754323640990124e-02" +" 6.19280832850907736464e-01" " 3.09804153295974149529e+00" "-2.18179884806930957097e-01" " 5.82177769034544490001e-02" "-2.03739284689455874000e-01" " 5.52367110355371226937e-02" " 1.00000000000000000000e+00" "-2.59959983031152697119e-01" "-2.60297284583753785192e-01" " 9.44422939935796457167e-02" " 1.00000000000000000000e+00" "-2.59878298921881412120e-01" "-2.60449567781213808804e-01" " 9.44833509290815970472e-02" +" 6.37450199203187239938e-01" " 3.08455231633535698066e+00" "-2.19369154274005079275e-01" " 6.39472887429953368299e-02" "-1.88749724727198309182e-01" " 1.09397013202204101967e-01" " 1.00000000000000000000e+00" "-2.76887893144032004589e-01" "-2.77166415135609189857e-01" " 1.06082183452999648243e-01" " 1.00000000000000000000e+00" "-2.76511563853853614692e-01" "-2.76977151754122907779e-01" " 1.05828257440237161191e-01" +" 6.39467815670481498636e-01" " 3.08323051496657507542e+00" "-2.19368175333760961898e-01" " 6.44181978548334088774e-02" "-1.89353347741865157827e-01" " 1.08002221863593816931e-01" " 1.00000000000000000000e+00" "-2.79181074094308978584e-01" "-2.78665505098940780027e-01" " 1.07166343073297629096e-01" " 1.00000000000000000000e+00" "-2.79559625908507858316e-01" "-2.78802181494801848416e-01" " 1.07442614922929932653e-01" +" 6.59648633284134366939e-01" " 3.07163202066994278638e+00" "-2.21036986033307292221e-01" " 6.87799559981708830136e-02" "-1.90466443549005715052e-01" " 1.02817368861690031090e-01" " 1.00000000000000000000e+00" "-2.96292239937137269479e-01" "-2.97328581958025806031e-01" " 1.20079194234038580391e-01" " 1.00000000000000000000e+00" "-2.96292239937137269479e-01" "-2.97328581958025806031e-01" " 1.20079194234038580391e-01" +" 6.77290836653386407740e-01" " 3.06380343191765991406e+00" "-2.22660755136336652171e-01" " 7.40875891893990889958e-02" "-1.85235558098800934257e-01" " 1.18301618926956508826e-01" " 1.00000000000000000000e+00" "-3.14358715035631119949e-01" "-3.14525700849362543909e-01" " 1.33452490031886444877e-01" " 1.00000000000000000000e+00" "-3.14730219037991254538e-01" "-3.14329328923593886991e-01" " 1.33656237391439836060e-01" +" 6.79825343200614606864e-01" " 3.06284804099463325855e+00" "-2.22841691068587671731e-01" " 7.49009884887825994060e-02" "-1.84821776512202079479e-01" " 1.20813523906540723485e-01" " 1.00000000000000000000e+00" "-3.17255489261072276541e-01" "-3.16696457559001498527e-01" " 1.35268008505702252986e-01" " 1.00000000000000000000e+00" "-3.17212309459462327155e-01" "-3.16748002494694480546e-01" " 1.35216615691944236355e-01" +" 6.99999999999999955591e-01" " 3.05689585205667579970e+00" "-2.25000676921918191242e-01" " 7.83715348365297964639e-02" "-1.99588198717724513154e-01" " 7.56613409706146100575e-02" " 1.00000000000000000000e+00" "-3.35536775455784863631e-01" "-3.35871369423169363611e-01" " 1.50702512980632308270e-01" " 1.00000000000000000000e+00" "-3.35536775455784863631e-01" "-3.35871369423169363611e-01" " 1.50702512980632308270e-01" +" 7.17131474103585686564e-01" " 3.05372841679611850552e+00" "-2.26421343636508648478e-01" " 8.23650456400066705021e-02" "-2.04009216446839281023e-01" " 6.35025777665428614593e-02" " 1.00000000000000000000e+00" "-3.52374078092240139437e-01" "-3.52932557668194091249e-01" " 1.64993082812326552489e-01" " 1.00000000000000000000e+00" "-3.52374078092240139437e-01" "-3.52932557668194091249e-01" " 1.64993082812326552489e-01" +" 7.20174656799385304318e-01" " 3.05308068927802489512e+00" "-2.25664328928666835239e-01" " 8.66344260703387353262e-02" "-1.69958512618842871866e-01" " 1.56312739053062810246e-01" " 1.00000000000000000000e+00" "-3.55551761750701078579e-01" "-3.56374129500179548380e-01" " 1.67647100568588780511e-01" " 1.00000000000000000000e+00" "-3.55551761750701078579e-01" "-3.56374129500179548380e-01" " 1.67647100568588780511e-01" +" 7.40351366715865544244e-01" " 3.05205302461301553052e+00" "-2.27878207350402040010e-01" " 9.09303855531002069856e-02" "-1.84258911244755907433e-01" " 1.14656256795656080749e-01" " 1.00000000000000000000e+00" "-3.76744660620121629702e-01" "-3.76337002082394178615e-01" " 1.85991084114679183781e-01" " 1.00000000000000000000e+00" "-3.76688048935811148343e-01" "-3.76225243419644361786e-01" " 1.85729303047371036017e-01" +" 7.56972111553784854365e-01" " 3.05278632456453768995e+00" "-2.29501824739037102452e-01" " 9.33676225350269367587e-02" "-2.01035299056347427360e-01" " 7.20684554957042727841e-02" " 1.00000000000000000000e+00" "-3.93035970173952420303e-01" "-3.93079742187513903051e-01" " 2.01363822113478946330e-01" " 1.00000000000000000000e+00" "-3.92678199326325250151e-01" "-3.92964675810177743731e-01" " 2.01072954058747227490e-01" +" 7.60532184329518412547e-01" " 3.05311324840066511399e+00" "-2.29805205541022405935e-01" " 9.48008495250769883667e-02" "-2.02418180942837894198e-01" " 6.97386001081668344126e-02" " 1.00000000000000000000e+00" "-3.97221614346181972621e-01" "-3.96578723052535331295e-01" " 2.05209123369820667371e-01" " 1.00000000000000000000e+00" "-3.96862943090598219165e-01" "-3.96653954377934214737e-01" " 2.05090986001399216976e-01" +" 7.80719167149092174718e-01" " 3.05617306851500503129e+00" "-2.31173873309412053478e-01" " 1.00472332076473477858e-01" "-2.01161038963184490846e-01" " 7.20472003356219664605e-02" " 1.00000000000000000000e+00" "-4.18194617393473411227e-01" "-4.17307806168768946620e-01" " 2.25586929669613828198e-01" " 1.00000000000000000000e+00" "-4.18318995517461877931e-01" "-4.17204038122098885832e-01" " 2.25276498213504816626e-01" +" 7.96812749003984022167e-01" " 3.06001859016351263065e+00" "-2.32343754087399295694e-01" " 1.05697185688805331272e-01" "-1.96296509230573401616e-01" " 8.30140958298338643706e-02" " 1.00000000000000000000e+00" "-4.35813408041924976732e-01" "-4.34230409865779876100e-01" " 2.42712214267771397846e-01" " 1.00000000000000000000e+00" "-4.35813408041924976732e-01" "-4.34230409865779876100e-01" " 2.42712214267771397846e-01" +" 8.00914377083104422894e-01" " 3.06119343734002802293e+00" "-2.32450588656713974522e-01" " 1.06222622605717811894e-01" "-1.99229540284476758227e-01" " 7.63696540141749896646e-02" " 1.00000000000000000000e+00" "-4.38443694119180438218e-01" "-4.38819165015641443617e-01" " 2.46239206559286105680e-01" " 1.00000000000000000000e+00" "-4.39476397591856526859e-01" "-4.38848333000254886560e-01" " 2.46846108240976080950e-01" +" 8.21119881919092575728e-01" " 3.06806489134768778371e+00" "-2.33728480929873722038e-01" " 1.12357473555193071446e-01" "-1.94728921669852117482e-01" " 8.47627818970848184721e-02" " 1.00000000000000000000e+00" "-4.59848896416890862149e-01" "-4.60102398566544557035e-01" " 2.69122760182142373164e-01" " 1.00000000000000000000e+00" "-4.59848896416890862149e-01" "-4.60102398566544557035e-01" " 2.69122760182142373164e-01" +" 8.36653386454183189969e-01" " 3.07453839987046606552e+00" "-2.34676322206190002273e-01" " 1.16911387286438642197e-01" "-1.91376269752546568359e-01" " 9.15583870475455141591e-02" " 1.00000000000000000000e+00" "-4.75363836583278076553e-01" "-4.76723513214178717945e-01" " 2.86607611619469571096e-01" " 1.00000000000000000000e+00" "-4.76621117239373559560e-01" "-4.76808048991642197123e-01" " 2.87123737453226557381e-01" +" 8.41337756813768877784e-01" " 3.07640674288097715205e+00" "-2.33422051409989450566e-01" " 1.23360524012424532803e-01" "-1.55745268456589147643e-01" " 1.61205463929628312059e-01" " 1.00000000000000000000e+00" "-4.86228164400260398637e-01" "-4.82388715247700106126e-01" " 2.95662948209816978107e-01" " 1.00000000000000000000e+00" "-4.86454999043860192298e-01" "-4.82331015323810119444e-01" " 2.95781716655813375905e-01" +" 8.61570085796883988749e-01" " 3.08697878638552625219e+00" "-2.36270653410783071369e-01" " 1.24590882326730947871e-01" "-1.92217119692742299808e-01" " 8.75541888659795708438e-02" " 1.00000000000000000000e+00" "-5.03438846641443005225e-01" "-5.03415307309868387264e-01" " 3.17948082094100081818e-01" " 1.00000000000000000000e+00" "-5.03477317108998123629e-01" "-5.03505993156079356687e-01" " 3.17840140381527080926e-01" +" 8.76494023904382579815e-01" " 3.09557413227078948026e+00" "-2.37085942897499846183e-01" " 1.29397760627560559632e-01" "-1.87624022722640837468e-01" " 9.47294094151172050289e-02" " 1.00000000000000000000e+00" "-5.18444770254010478538e-01" "-5.19520976514705301597e-01" " 3.35983387207839545585e-01" " 1.00000000000000000000e+00" "-5.18051919567177332482e-01" "-5.19342537201006981817e-01" " 3.35790901803837305017e-01" +" 8.81818963291637447632e-01" " 3.09884756531470362262e+00" "-2.38062068060706399919e-01" " 1.31354376388766624917e-01" "-1.90269074977513663605e-01" " 9.10341985885239762810e-02" " 1.00000000000000000000e+00" "-5.25225814764230913845e-01" "-5.25570955806175965641e-01" " 3.44056684889103292502e-01" " 1.00000000000000000000e+00" "-5.25440286920333621268e-01" "-5.25785437993769977361e-01" " 3.44092096324449980838e-01" +" 9.02086495654553344181e-01" " 3.11222219033292057944e+00" "-2.38756962098255337557e-01" " 1.37466978277495377458e-01" "-1.88523227594608017155e-01" " 9.17059366610650933405e-02" " 1.00000000000000000000e+00" "-5.48243166790345681783e-01" "-5.47769711892323818425e-01" " 3.71954185404142878557e-01" " 1.00000000000000000000e+00" "-5.48243166790345681783e-01" "-5.47769711892323818425e-01" " 3.71954185404142878557e-01" +" 9.16334661354581747617e-01" " 3.12247604360994346351e+00" "-2.39547052448222524967e-01" " 1.42453104542904496199e-01" "-1.82224371016356162523e-01" " 1.01937367069979079037e-01" " 1.00000000000000000000e+00" "-5.64273907552163778156e-01" "-5.63477337520420618056e-01" " 3.92186592133367817326e-01" " 1.00000000000000000000e+00" "-5.64838462227009174832e-01" "-5.63683232893264385410e-01" " 3.92712206831609955682e-01" +" 9.22374802737785715046e-01" " 3.12701954727139774803e+00" "-2.39338177469925444951e-01" " 1.43672588809336643223e-01" "-1.85301603616147225750e-01" " 9.47580944156049542748e-02" " 1.00000000000000000000e+00" "-5.71542828776284483894e-01" "-5.69990258813657058035e-01" " 4.00691495996387869738e-01" " 1.00000000000000000000e+00" "-5.72194901947260747832e-01" "-5.70145790504081872996e-01" " 4.01138860954862674912e-01" +" 9.42686019476915770809e-01" " 3.14310173097586131874e+00" "-2.39692756598200523710e-01" " 1.53839921114545252756e-01" "-1.60299230330541830902e-01" " 1.33823764867889299923e-01" " 1.00000000000000000000e+00" "-5.97695285166981227221e-01" "-5.93269262346907577665e-01" " 4.33628713012008282224e-01" " 1.00000000000000000000e+00" "-5.97695285166981227221e-01" "-5.93269262346907577665e-01" " 4.33628713012008282224e-01" +" 9.56175298804780915418e-01" " 3.15401868301327459321e+00" "-2.39251263921521906131e-01" " 1.62635331155914497625e-01" "-1.18922836912608298476e-01" " 1.97557590190566761956e-01" " 1.00000000000000000000e+00" "-6.12343326832209933208e-01" "-6.09080252967467150604e-01" " 4.54620475365628939901e-01" " 1.00000000000000000000e+00" "-6.12343326832209933208e-01" "-6.09080252967467150604e-01" " 4.54620475365628939901e-01" +" 9.63022297507382329940e-01" " 3.16066610835798922352e+00" "-2.42703461963474975693e-01" " 1.57603770040384699724e-01" "-1.82095881828993388929e-01" " 9.85336204337025206579e-02" " 1.00000000000000000000e+00" "-6.16304283635289107401e-01" "-6.15315717633257208696e-01" " 4.61278615293926497198e-01" " 1.00000000000000000000e+00" "-6.16695801510115604316e-01" "-6.15250990669607089600e-01" " 4.61605039762708502238e-01" +" 9.83385806812805518540e-01" " 3.17938138333914066536e+00" "-2.43261240636295617001e-01" " 1.63765457542110554057e-01" "-1.80068831298927700679e-01" " 9.90727211012068509355e-02" " 1.00000000000000000000e+00" "-6.38131853104239366026e-01" "-6.37838636457903063182e-01" " 4.93150889527914748633e-01" " 1.00000000000000000000e+00" "-6.38131853104239366026e-01" "-6.37838636457903063182e-01" " 4.93150889527914748633e-01" +" 9.96015936254980083220e-01" " 3.19096617558551409743e+00" "-2.40011496171860572169e-01" " 1.74764768479424348335e-01" "-1.11996458281653832323e-01" " 1.95861379266997176485e-01" " 1.00000000000000000000e+00" "-6.55687323593064697036e-01" "-6.53600206274955963792e-01" " 5.17356259187227385254e-01" " 1.00000000000000000000e+00" "-6.55687323593064697036e-01" "-6.53600206274955963792e-01" " 5.17356259187227385254e-01" +" 1.00377873740856293772e+00" " 3.19928299780279923326e+00" "-2.44392022805399761198e-01" " 1.70363090113942655668e-01" "-1.79012157400245425221e-01" " 9.90006611162091709755e-02" " 1.00000000000000000000e+00" "-6.60465544578915597640e-01" "-6.61321048783703013818e-01" " 5.26542333974111764761e-01" " 1.00000000000000000000e+00" "-6.60658926825233194791e-01" "-6.61666097369563166453e-01" " 5.26890148960270976453e-01" +" 1.02420330106412582616e+00" " 3.22032080935360998097e+00" "-2.45380010961734507102e-01" " 1.77706311322545801312e-01" "-1.74056011193458148867e-01" " 1.04181661803819131107e-01" " 1.00000000000000000000e+00" "-6.85017564935764267098e-01" "-6.84525287806397875201e-01" " 5.62362628476293591184e-01" " 1.00000000000000000000e+00" "-6.85117453471192905390e-01" "-6.84591068216510056921e-01" " 5.62557049726987834504e-01" [TRUNCATED] To get the complete diff run: svnlook diff /svnroot/robast -r 627 From noreply at r-forge.r-project.org Tue Mar 12 23:27:29 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 12 Mar 2013 23:27:29 +0100 (CET) Subject: [Robast-commits] r628 - in branches/robast-0.9/pkg: ROptEst/R RobAStRDA/R RobAStRDA/inst/AddMaterial/interpolation RobExtremes/R RobExtremes/inst/AddMaterial/interpolation RobExtremesBuffer Message-ID: <20130312222729.BC435184BA3@r-forge.r-project.org> Author: ruckdeschel Date: 2013-03-12 23:27:29 +0100 (Tue, 12 Mar 2013) New Revision: 628 Added: branches/robast-0.9/pkg/RobExtremesBuffer/interpolMBREGEVFamily.csv branches/robast-0.9/pkg/RobExtremesBuffer/interpolMBREGEVFamily.txt Modified: branches/robast-0.9/pkg/ROptEst/R/interpolLM.R branches/robast-0.9/pkg/RobAStRDA/R/interpolAux.R branches/robast-0.9/pkg/RobAStRDA/R/sysdata.rda branches/robast-0.9/pkg/RobAStRDA/inst/AddMaterial/interpolation/WriteUp-Interpolators.txt branches/robast-0.9/pkg/RobAStRDA/inst/AddMaterial/interpolation/interpolationscripts.R branches/robast-0.9/pkg/RobExtremes/R/SnQn.R branches/robast-0.9/pkg/RobExtremes/R/getStartIC.R branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/WriteUp-Interpolators.txt Log: fixed a bug in readGridFromCSV (did not read the right file) and the name of the interpolators' items is fun not fct ... Modified: branches/robast-0.9/pkg/ROptEst/R/interpolLM.R =================================================================== --- branches/robast-0.9/pkg/ROptEst/R/interpolLM.R 2013-03-12 21:21:35 UTC (rev 627) +++ branches/robast-0.9/pkg/ROptEst/R/interpolLM.R 2013-03-12 22:27:29 UTC (rev 628) @@ -80,7 +80,7 @@ } .readGridFromCSV <- function(fromFileCSV){ - rg <- read.table(CSVFiles[1], colClasses=rep("character",2), sep=" ", header=FALSE) + rg <- read.table(fromFileCSV, colClasses=rep("character",2), sep=" ", header=FALSE) nrg <- nrow(rg) Grid <- matrix(as.numeric(as.matrix(rg)),nrow=nrg) Modified: branches/robast-0.9/pkg/RobAStRDA/R/interpolAux.R =================================================================== --- branches/robast-0.9/pkg/RobAStRDA/R/interpolAux.R 2013-03-12 21:21:35 UTC (rev 627) +++ branches/robast-0.9/pkg/RobAStRDA/R/interpolAux.R 2013-03-12 22:27:29 UTC (rev 628) @@ -21,7 +21,7 @@ } .readGridFromCSV <- function(fromFileCSV){ - rg <- read.table(CSVFiles[1], colClasses=rep("character",2), sep=" ", header=FALSE) + rg <- read.table(fromFileCSV, colClasses=rep("character",2), sep=" ", header=FALSE) nrg <- nrow(rg) Grid <- matrix(as.numeric(as.matrix(rg)),nrow=nrg) @@ -106,7 +106,6 @@ nameInSysdata <- CSVlist[[i]]$namInSysdata namPFam <- CSVlist[[i]]$namPFam Grid <- CSVlist[[i]]$Grid - ### check whether object nameInSysdata already exists (ie. some ## grids for this family already exist) or not if(!exists(nameInSysdata,envir=newEnv,inherits=FALSE)){ Modified: branches/robast-0.9/pkg/RobAStRDA/R/sysdata.rda =================================================================== (Binary files differ) Modified: branches/robast-0.9/pkg/RobAStRDA/inst/AddMaterial/interpolation/WriteUp-Interpolators.txt =================================================================== --- branches/robast-0.9/pkg/RobAStRDA/inst/AddMaterial/interpolation/WriteUp-Interpolators.txt 2013-03-12 21:21:35 UTC (rev 627) +++ branches/robast-0.9/pkg/RobAStRDA/inst/AddMaterial/interpolation/WriteUp-Interpolators.txt 2013-03-12 22:27:29 UTC (rev 628) @@ -64,7 +64,7 @@ Each layer in the hierarchie gives one ">" and an item is inserted below the item next left to it with number of ">" by 1 smaller than its own. I-fct denotes the interpolating function to the grid left -to it. {} denote optional entries and capture that one may want +to it (named "fun"). {} denote optional entries and capture that one may want to smooth out the original interpolation grids in entries 'grid', giving smoothed grids written into entries 'gridS'. OptCrit for the time being is either in ".OMSE", ".MBRE", ".RMXE" or ".Sn". @@ -73,6 +73,11 @@ [OptCrit], >[model1], >>[grid], {>>[gridS],} >>[I-fct.O], >>[I-Fct.N], >[model2], >>[grid], {>>[gridS],} >>[I-fct.O], >>[I-Fct.N], ... +For instance, to get the clipping height "b" in OMSE for "GEV" at +theta = (xi=0.3) for >R-2.16, we may write + .OMSE[["GEVFamily"]][["fun.N"]][[1]](0.3) + + 6. Namespace issue It is absolutely necessary that functions I-fct (or I-fct.O, I-fct.N) Modified: branches/robast-0.9/pkg/RobAStRDA/inst/AddMaterial/interpolation/interpolationscripts.R =================================================================== --- branches/robast-0.9/pkg/RobAStRDA/inst/AddMaterial/interpolation/interpolationscripts.R 2013-03-12 21:21:35 UTC (rev 627) +++ branches/robast-0.9/pkg/RobAStRDA/inst/AddMaterial/interpolation/interpolationscripts.R 2013-03-12 22:27:29 UTC (rev 628) @@ -15,10 +15,10 @@ oldwd <- getwd() .basepath <- "C:/rtest/RobASt/branches/robast-0.9/pkg" .myFolderFrom <- file.path(.basepath,"RobExtremesBuffer") -#myRDA0 <- file.path(.basepath,"RobAStRDA/R/sysdata0.rda") -#myRDA <- file.path(.basepath,"RobAStRDA/R/sysdata.rda") myRDA0 <- file.path(.basepath,"RobExtremesBuffer/sysdata0.rda") myRDA <- file.path(.basepath,"RobExtremesBuffer/sysdata.rda") +#myRDA0 <- file.path(.basepath,"RobAStRDA/R/sysdata0.rda") +myRDA <- file.path(.basepath,"RobAStRDA/R/sysdata.rda") CSVFiles <- grep("\\.csv$", dir(.myFolderFrom), value=TRUE) CSVFiles <- paste(.myFolderFrom, CSVFiles, sep="/") Modified: branches/robast-0.9/pkg/RobExtremes/R/SnQn.R =================================================================== --- branches/robast-0.9/pkg/RobExtremes/R/SnQn.R 2013-03-12 21:21:35 UTC (rev 627) +++ branches/robast-0.9/pkg/RobExtremes/R/SnQn.R 2013-03-12 22:27:29 UTC (rev 628) @@ -109,7 +109,7 @@ sng <- try(getFromNamespace(".Sn", ns = "RobAStRDA"), silent =TRUE) if(is(sng,"try-error")) return(Sn(as(x,"AbscontDistribution"))) if(!nam %in% names(sng)) return(Sn(as(x,"AbscontDistribution"))) - snf <- sng[[nam]][[.versionSuff("fct")]] + snf <- sng[[nam]][[.versionSuff("fun")]] ret <- snf(shape(x)) }else ret <- scale(x)*Sn(x=x/scale(x)) return(ret) @@ -122,7 +122,7 @@ function(x, ...).Sn.intp(x,"GEVFamily") ) setMethod("Sn", signature(x = "Gammad"), - function(x, ...).Sn.intp(x,"GammaFamily") ) + function(x, ...).Sn.intp(x,"Gammafamily") ) setMethod("Sn", signature(x = "Weibull"), function(x, ...).Sn.intp(x,"WeibullFamily") ) Modified: branches/robast-0.9/pkg/RobExtremes/R/getStartIC.R =================================================================== --- branches/robast-0.9/pkg/RobExtremes/R/getStartIC.R 2013-03-12 21:21:35 UTC (rev 627) +++ branches/robast-0.9/pkg/RobExtremes/R/getStartIC.R 2013-03-12 22:27:29 UTC (rev 628) @@ -11,7 +11,7 @@ if(!is(sng,"try-error")) nsng <- names(sng) if(length(nsng)){ if(nam %in% nsng){ - fctN <- .versionSuff("fct") + fctN <- .versionSuff("fun") interpolfct <- sng[[nam]][[fctN]] .modifyIC <- function(L2Fam, IC){ para <- param(L2Fam) Modified: branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/WriteUp-Interpolators.txt =================================================================== --- branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/WriteUp-Interpolators.txt 2013-03-12 21:21:35 UTC (rev 627) +++ branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/WriteUp-Interpolators.txt 2013-03-12 22:27:29 UTC (rev 628) @@ -64,7 +64,7 @@ Each layer in the hierarchie gives one ">" and an item is inserted below the item next left to it with number of ">" by 1 smaller than its own. I-fct denotes the interpolating function to the grid left -to it. {} denote optional entries and capture that one may want +to it (named "fun"). {} denote optional entries and capture that one may want to smooth out the original interpolation grids in entries 'grid', giving smoothed grids written into entries 'gridS'. OptCrit for the time being is either in ".OMSE", ".MBRE", ".RMXE" or ".Sn". @@ -73,6 +73,10 @@ [OptCrit], >[model1], >>[grid], {>>[gridS],} >>[I-fct.O], >>[I-Fct.N], >[model2], >>[grid], {>>[gridS],} >>[I-fct.O], >>[I-Fct.N], ... +For instance, to get the clipping height "b" in OMSE for "GEV" at +theta = (xi=0.3) for >R-2.16, we may write + .OMSE[["GEVFamily"]][["fun.N"]][[1]](0.3) + 6. Namespace issue It is absolutely necessary that functions I-fct (or I-fct.O, I-fct.N) Added: branches/robast-0.9/pkg/RobExtremesBuffer/interpolMBREGEVFamily.csv =================================================================== --- branches/robast-0.9/pkg/RobExtremesBuffer/interpolMBREGEVFamily.csv (rev 0) +++ branches/robast-0.9/pkg/RobExtremesBuffer/interpolMBREGEVFamily.csv 2013-03-12 22:27:29 UTC (rev 628) @@ -0,0 +1,492 @@ +" 5.00000000000000010408e-03" " 1.81357633287360164864e+00" "-2.24449754695824399420e-01" "-1.47885705270914519227e-01" "-4.58921540973249220130e-01" "-1.81549049260172734588e-01" " 5.18224508955159923751e-01" "-7.33531573128324149158e-02" "-7.36695431812270096206e-02" " 1.00000000000000000000e+00" " 5.18224508955159923751e-01" "-7.33531573128324149158e-02" "-7.36695431812270096206e-02" " 1.00000000000000000000e+00" +" 2.14517304631997030029e-02" " 1.82170362017730180781e+00" "-2.21448911244242041541e-01" "-1.50355403686426691845e-01" "-4.55269605129110077613e-01" "-1.76720769852665327004e-01" " 5.08063065632790911152e-01" "-5.82186275198257746633e-02" "-5.77077143417919283253e-02" " 1.00000000000000000000e+00" " 5.08143619270839841384e-01" "-5.80051768448633583986e-02" "-5.81911274646265477828e-02" " 1.00000000000000000000e+00" +" 3.98406374501992024961e-02" " 1.83083370984061777342e+00" "-2.17035963582212471090e-01" "-1.51512983390812039364e-01" "-4.54345392222172295149e-01" "-1.72894960142815801163e-01" " 4.96136067101396682766e-01" "-4.74932769628111234317e-02" "-4.86195811306312300482e-02" " 1.00000000000000000000e+00" " 4.95936248408226754147e-01" "-4.77016787664086075460e-02" "-4.85995950036596374710e-02" " 1.00000000000000000000e+00" +" 4.27829746040001568375e-02" " 1.83229759826328653105e+00" "-2.16118212042312296539e-01" "-1.52374008396431198653e-01" "-4.52639888751594832161e-01" "-1.72932720214651891588e-01" " 4.94720174340536444912e-01" "-4.54195759788707867366e-02" "-4.51729009100261397203e-02" " 1.00000000000000000000e+00" " 4.94720174340536444912e-01" "-4.54195759788707867366e-02" "-4.51729009100261397203e-02" " 1.00000000000000000000e+00" +" 6.40397156295258174197e-02" " 1.84287543551152532828e+00" "-2.09674326233737051695e-01" "-1.54762162850679618753e-01" "-4.48045578614404638174e-01" "-1.66938935089539775003e-01" " 4.81144590091446000546e-01" "-2.80584353688964997786e-02" "-3.19411963298408749234e-02" " 1.00000000000000000000e+00" " 4.80470980864551755474e-01" "-2.87525051330816128203e-02" "-3.19533813366238497733e-02" " 1.00000000000000000000e+00" +" 7.96812749003984049923e-02" " 1.85070371763565866274e+00" "-2.08536238317104577478e-01" "-1.56919373979981485734e-01" "-4.45272376876807263191e-01" "-1.65208357534006367029e-01" " 4.76384421706800675889e-01" "-1.95038700097885028817e-02" "-2.00647499048494833140e-02" " 1.00000000000000000000e+00" " 4.75947149369317923373e-01" "-1.97086007479972957768e-02" "-2.02230671057971982119e-02" " 1.00000000000000000000e+00" +" 8.52248570399394278496e-02" " 1.85347985392406511274e+00" "-2.07900841379440981527e-01" "-1.57705602351155882435e-01" "-4.45456845353655817021e-01" "-1.64450967560591382322e-01" " 4.73547754619834226908e-01" "-1.47010272358679451588e-02" "-1.46008738936339865777e-02" " 1.00000000000000000000e+00" " 4.73190003587921015349e-01" "-1.54744589399295820464e-02" "-1.47551495011547725844e-02" " 1.00000000000000000000e+00" +" 1.06341241002067987687e-01" " 1.86407717660864613585e+00" "-2.04038293795141795206e-01" "-1.60749650474153876756e-01" "-4.40849240782102969050e-01" "-1.60979520513820612004e-01" " 4.62876655217478893967e-01" " 9.72114778390573863092e-05" "-8.42891877730452790569e-04" " 1.00000000000000000000e+00" " 4.62173942462537512554e-01" "-7.70146016848490032672e-05" "-1.28603273751948785943e-03" " 1.00000000000000000000e+00" +" 1.19521912350597614427e-01" " 1.87071107891449406324e+00" "-2.01555709907786650970e-01" "-1.61798168032950273609e-01" "-4.39355126712112520337e-01" "-1.58267308423409414075e-01" " 4.56173937376610993955e-01" " 7.99529334775864186646e-03" " 7.98285749610598907577e-03" " 1.00000000000000000000e+00" " 4.56243546526286347653e-01" " 8.08383164904142269280e-03" " 7.97491549049226915169e-03" " 1.00000000000000000000e+00" +" 1.27391651478953704668e-01" " 1.87467845381020259410e+00" "-1.99887198519305114841e-01" "-1.62214108649143956553e-01" "-4.35652477622920419886e-01" "-1.56162774606530135868e-01" " 4.53276494006642161061e-01" " 1.32964504467802183130e-02" " 1.30645222855357446418e-02" " 1.00000000000000000000e+00" " 4.53783095362249866422e-01" " 1.29589301251803803994e-02" " 1.19070988677393678479e-02" " 1.00000000000000000000e+00" +" 1.48378817222630354777e-01" " 1.88528306742171802846e+00" "-1.96857494101617430671e-01" "-1.64894436497434737632e-01" "-4.33483972627471070282e-01" "-1.53146635514376988629e-01" " 4.44055568874093808951e-01" " 2.76925977606299264511e-02" " 2.76782765166379354782e-02" " 1.00000000000000000000e+00" " 4.43582440347021933480e-01" " 2.65155609011622182825e-02" " 2.73437746621024158067e-02" " 1.00000000000000000000e+00" +" 1.59362549800796809985e-01" " 1.89084580370348631639e+00" "-1.94459975649268451692e-01" "-1.65167490222664581356e-01" "-4.31789965496753858076e-01" "-1.50578102907902772190e-01" " 4.38181637859916706113e-01" " 3.32399220716845036905e-02" " 3.37822257687323684872e-02" " 1.00000000000000000000e+00" " 4.38045516927180411670e-01" " 3.33810518567187394789e-02" " 3.35127512956347253792e-02" " 1.00000000000000000000e+00" +" 1.69305414639138729349e-01" " 1.89588500206250176738e+00" "-1.92237411020182491495e-01" "-1.66712756361419578433e-01" "-4.28597609342009910893e-01" "-1.48468578659457506319e-01" " 4.33485765860617155987e-01" " 4.21763540139890938385e-02" " 4.31078513011782862852e-02" " 1.00000000000000000000e+00" " 4.34135195703849285920e-01" " 4.24271326560168374198e-02" " 4.29721595962449867678e-02" " 1.00000000000000000000e+00" +" 1.90174070534208650152e-01" " 1.90650237952790413409e+00" "-1.90446388794238752329e-01" "-1.68062321880127041318e-01" "-4.28633064041238465158e-01" "-1.45075414580951467247e-01" " 4.26066359533377736479e-01" " 5.36284044036416385204e-02" " 5.39047890722203978942e-02" " 1.00000000000000000000e+00" " 4.26066359533377736479e-01" " 5.36284044036416385204e-02" " 5.39047890722203978942e-02" " 1.00000000000000000000e+00" +" 1.99203187250996005542e-01" " 1.91110176606159587465e+00" "-1.88579437506588371010e-01" "-1.70162076561279212994e-01" "-4.25592052015728139480e-01" "-1.45216175407850839330e-01" " 4.23417579929574350306e-01" " 5.86145841664037423047e-02" " 5.76814585654925882086e-02" " 1.00000000000000000000e+00" " 4.23417579929574350306e-01" " 5.86145841664037423047e-02" " 5.76814585654925882086e-02" " 1.00000000000000000000e+00" +" 2.10987364747485084404e-01" " 1.91711834734776820355e+00" "-1.86679259952975490355e-01" "-1.70757163695493652256e-01" "-4.24386593128949107800e-01" "-1.42636944401326126730e-01" " 4.17790926687134411832e-01" " 6.62608568447949491942e-02" " 6.57220468047886308138e-02" " 1.00000000000000000000e+00" " 4.17790926687134411832e-01" " 6.62608568447949491942e-02" " 6.57220468047886308138e-02" " 1.00000000000000000000e+00" +" 2.31747832682678900351e-01" " 1.92773776737950242044e+00" "-1.83940932931882183965e-01" "-1.72109598457032775265e-01" "-4.22266145537809611810e-01" "-1.38694450737669700002e-01" " 4.09502187334504830218e-01" " 7.91329072256186927259e-02" " 7.94698175609502288630e-02" " 1.00000000000000000000e+00" " 4.09502187334504830218e-01" " 7.91329072256186927259e-02" " 7.94698175609502288630e-02" " 1.00000000000000000000e+00" +" 2.39043824701195228855e-01" " 1.93147517605161533893e+00" "-1.81763340762608666124e-01" "-1.72681402409168516243e-01" "-4.21329960451714891079e-01" "-1.37452475630147369356e-01" " 4.05966050944434997394e-01" " 8.29164515404993973657e-02" " 8.11334542709693240514e-02" " 1.00000000000000000000e+00" " 4.05831068620737756003e-01" " 8.28745767717891240745e-02" " 8.05291380045802113186e-02" " 1.00000000000000000000e+00" +" 2.52457967740567557069e-01" " 1.93836271992803976794e+00" "-1.81193463000845739197e-01" "-1.73696000746715789598e-01" "-4.21566265058053224468e-01" "-1.35232767124049885199e-01" " 4.01626384085670862234e-01" " 9.07734428262826908984e-02" " 9.09128963056798911069e-02" " 1.00000000000000000000e+00" " 4.01202888644781818783e-01" " 9.05245364891092141324e-02" " 9.08481781051470455024e-02" " 1.00000000000000000000e+00" +" 2.73120223661343919375e-01" " 1.94897581408296471928e+00" "-1.80642441275651322030e-01" "-1.74982015704197968464e-01" "-4.18442575258591964449e-01" "-1.31988728559020607189e-01" " 3.98561451113740139451e-01" " 1.02662100775652923024e-01" " 1.06098594111868102519e-01" " 1.00000000000000000000e+00" " 3.98533328094621885906e-01" " 1.03058527463250615419e-01" " 1.06139878813551385983e-01" " 1.00000000000000000000e+00" +" 2.78884462151394396656e-01" " 1.95194394392986336761e+00" "-1.78187632330723821905e-01" "-1.76234227016729749771e-01" "-4.15002474446507063632e-01" "-1.30785600600483303824e-01" " 3.94567167725847323112e-01" " 1.08643377250491196540e-01" " 1.09935595401980640284e-01" " 1.00000000000000000000e+00" " 3.94371237747624170389e-01" " 1.08692728041646993753e-01" " 1.09787604138102262707e-01" " 1.00000000000000000000e+00" +" 2.93737016782436521911e-01" " 1.95962867002094442981e+00" "-1.76006233890053570557e-01" "-1.76017903375845441438e-01" "-4.16800091535223737882e-01" "-1.28693807115416308795e-01" " 3.87804254369114642653e-01" " 1.13410200785950654456e-01" " 1.13426633450955605120e-01" " 1.00000000000000000000e+00" " 3.87939814110230318800e-01" " 1.14074870338533571057e-01" " 1.13688684562727390648e-01" " 1.00000000000000000000e+00" +" 3.14310728217555401809e-01" " 1.97026989402602570323e+00" "-1.73962045758433991871e-01" "-1.77481607760214848968e-01" "-4.14027685138004641896e-01" "-1.25963102842284985217e-01" " 3.82104927124610749267e-01" " 1.24625951561890491170e-01" " 1.25527481256040573943e-01" " 1.00000000000000000000e+00" " 3.81778214194348819444e-01" " 1.25144095510945130290e-01" " 1.25607978091816896438e-01" " 1.00000000000000000000e+00" +" 3.18725099601593619969e-01" " 1.97255818998371390549e+00" "-1.72930735663139184544e-01" "-1.77396585573541570868e-01" "-4.14617703253063241142e-01" "-1.25023321084555105731e-01" " 3.79822070451222959520e-01" " 1.26714900424334059315e-01" " 1.26567392892025870621e-01" " 1.00000000000000000000e+00" " 3.79874906239952569997e-01" " 1.26520740164107220460e-01" " 1.26105531774140161572e-01" " 1.00000000000000000000e+00" +" 3.34843705962408810795e-01" " 1.98092047684842320621e+00" "-1.70274678679581847884e-01" "-1.78653429787690998243e-01" "-4.11405942071117913805e-01" "-1.22559331200983445687e-01" " 3.74273701693347726760e-01" " 1.35105329417008812598e-01" " 1.34639811515937790620e-01" " 1.00000000000000000000e+00" " 3.75023191821807655444e-01" " 1.34899359350960618142e-01" " 1.34486391473781496941e-01" " 1.00000000000000000000e+00" +" 3.55338266932213375782e-01" " 1.99157793193281995592e+00" "-1.68861891788168239081e-01" "-1.79639101585473831557e-01" "-4.11150470518950039711e-01" "-1.19540594776575456737e-01" " 3.68169473181114925708e-01" " 1.45289041499842536131e-01" " 1.45421399548979396465e-01" " 1.00000000000000000000e+00" " 3.68064423103658278080e-01" " 1.45792833916735392608e-01" " 1.45316827492299294189e-01" " 1.00000000000000000000e+00" +" 3.58565737051792843282e-01" " 1.99325928201677005092e+00" "-1.68088152730626105846e-01" "-1.79452621871856787816e-01" "-4.09589497898819043797e-01" "-1.19673053303831891658e-01" " 3.67480477614653910923e-01" " 1.47206845764279753430e-01" " 1.46780561910211160281e-01" " 1.00000000000000000000e+00" " 3.67474659119407243146e-01" " 1.47459142783165964019e-01" " 1.47962385967833898182e-01" " 1.00000000000000000000e+00" +" 3.75796698935874085024e-01" " 2.00224356895539079559e+00" "-1.66005387539434834387e-01" "-1.81003722800379907021e-01" "-4.06967311905129858207e-01" "-1.17838238962381824937e-01" " 3.62328485487730389547e-01" " 1.56820365956303525712e-01" " 1.56022823204245209006e-01" " 1.00000000000000000000e+00" " 3.61635512408597481482e-01" " 1.56070359999738145218e-01" " 1.55466379955065903129e-01" " 1.00000000000000000000e+00" +" 3.96221262591437028977e-01" " 2.01292114203179650644e+00" "-1.64134541183186599689e-01" "-1.81573549339193895946e-01" "-4.06599260011305418949e-01" "-1.14112339796905826184e-01" " 3.57268523744273480691e-01" " 1.65915721392144999147e-01" " 1.65358311266045665544e-01" " 1.00000000000000000000e+00" " 3.57268523744273480691e-01" " 1.65915721392144999147e-01" " 1.65358311266045665544e-01" " 1.00000000000000000000e+00" +" 3.98406374501992011083e-01" " 2.01406465801608414168e+00" "-1.63359347492141315783e-01" "-1.81938559261247578824e-01" "-4.05678540777555496355e-01" "-1.14427869102482024366e-01" " 3.56033522051043826995e-01" " 1.66452880346637521747e-01" " 1.65506458432017722338e-01" " 1.00000000000000000000e+00" " 3.56557012749407875596e-01" " 1.66351599423153695412e-01" " 1.65339643993273971434e-01" " 1.00000000000000000000e+00" +" 4.16614193187194392642e-01" " 2.02360826783990788158e+00" "-1.61392940998634243366e-01" "-1.82197107971740934751e-01" "-4.05639702646240607464e-01" "-1.11070945291743189420e-01" " 3.50654327495739881471e-01" " 1.75118142318103936494e-01" " 1.74769579041459566238e-01" " 1.00000000000000000000e+00" " 3.50599447604181935212e-01" " 1.75348510505069499210e-01" " 1.74970046192169104149e-01" " 1.00000000000000000000e+00" +" 4.36977702492617525731e-01" " 2.03428881590178090022e+00" "-1.59825364420835946966e-01" "-1.83414104447304965317e-01" "-4.04327742817793267527e-01" "-1.09131151937912437844e-01" " 3.45995951816330360451e-01" " 1.84186595150317961034e-01" " 1.83698505075733431458e-01" " 1.00000000000000000000e+00" " 3.45735671727974147593e-01" " 1.84351934846023718384e-01" " 1.84531191536261823805e-01" " 1.00000000000000000000e+00" +" 4.38247011952191289907e-01" " 2.03493201787984778761e+00" "-1.61778956011384394964e-01" "-1.84741390458027010535e-01" "-4.05503606289195905887e-01" "-1.08596093193116055575e-01" " 3.47437982832751679485e-01" " 1.87795107561500446147e-01" " 1.90948175287012411605e-01" " 1.00000000000000000000e+00" " 3.47611900608600532525e-01" " 1.87625603312824018598e-01" " 1.91117931239299876367e-01" " 1.00000000000000000000e+00" +" 4.57313980523084140373e-01" " 2.04499990318908952958e+00" "-1.57632954978096817555e-01" "-1.83818106139373937946e-01" "-4.03785849182797584866e-01" "-1.05458860259442885332e-01" " 3.40610817976483515324e-01" " 1.93784740638320546191e-01" " 1.93531549138136999000e-01" " 1.00000000000000000000e+00" " 3.40956238550359558293e-01" " 1.93176064914911044257e-01" " 1.93865537514476327097e-01" " 1.00000000000000000000e+00" +" 4.77625197262214196137e-01" " 2.05576215076779522661e+00" "-1.55471040919639896805e-01" "-1.84436652285859509215e-01" "-4.00166527997676102490e-01" "-1.03568764489028797282e-01" " 3.36072910549359005206e-01" " 2.01980837800672108351e-01" " 2.01543799544738971852e-01" " 1.00000000000000000000e+00" " 3.36376975414062917569e-01" " 2.02163343849419724352e-01" " 2.01950788170536438271e-01" " 1.00000000000000000000e+00" +" 4.78087649402390457709e-01" " 2.05600560617205774250e+00" "-1.56107974585544484469e-01" "-1.83829363744616058884e-01" "-4.01820120271884184682e-01" "-1.02412901287741969769e-01" " 3.36824825766857349763e-01" " 2.02619177958996060651e-01" " 2.02757487818918391564e-01" " 1.00000000000000000000e+00" " 3.36824825766857349763e-01" " 2.02619177958996060651e-01" " 2.02757487818918391564e-01" " 1.00000000000000000000e+00" +" 4.97913504345446511490e-01" " 2.06649991357224971367e+00" "-1.53375495014640150782e-01" "-1.84672353507325415212e-01" "-3.98578030814480621657e-01" "-1.00919636345967039803e-01" " 3.31055955619719899374e-01" " 2.10177295430298449741e-01" " 2.09665955518348795517e-01" " 1.00000000000000000000e+00" " 3.31250290827163951235e-01" " 2.10233737334792170071e-01" " 2.10218765523974088216e-01" " 1.00000000000000000000e+00" +" 5.17928286852589625511e-01" " 2.07712002659803962601e+00" "-1.52188717197021733396e-01" "-1.85410022930300483202e-01" "-4.00011876814143574332e-01" "-9.75715648594477069633e-02" " 3.26699782728258558695e-01" " 2.18769030765916139281e-01" " 2.18133228310998295019e-01" " 1.00000000000000000000e+00" " 3.27020815986229951289e-01" " 2.18809493222891421338e-01" " 2.18093207167096181376e-01" " 1.00000000000000000000e+00" +" 5.18181036708362463550e-01" " 2.07725414951462417079e+00" "-1.51725629172057868699e-01" "-1.85653754335790788232e-01" "-3.98443657668464401578e-01" "-9.85084915665803972917e-02" " 3.26759814463525921635e-01" " 2.18714142117734267057e-01" " 2.18562411988511895444e-01" " 1.00000000000000000000e+00" " 3.26759814463525921635e-01" " 2.18714142117734267057e-01" " 2.18562411988511895444e-01" " 1.00000000000000000000e+00" +" 5.38429914203115922433e-01" " 2.08802504087222873252e+00" "-1.50315020115600356254e-01" "-1.85892372542195621898e-01" "-3.99524971498401881842e-01" "-9.54384768632954155754e-02" " 3.22770748594162937284e-01" " 2.26842039711022375181e-01" " 2.26475744217558727645e-01" " 1.00000000000000000000e+00" " 3.22386583949304361685e-01" " 2.26623553343529543502e-01" " 2.26010129676513321639e-01" " 1.00000000000000000000e+00" +" 5.57768924302788793312e-01" " 2.09833608902422996678e+00" "-1.48986610696685062294e-01" "-1.86461890233307503451e-01" "-4.00347210070397696580e-01" "-9.21448773459214581782e-02" " 3.18829855791091021366e-01" " 2.35291368840107317784e-01" " 2.34779255156126548387e-01" " 1.00000000000000000000e+00" " 3.19134398178654188349e-01" " 2.35191832026296343550e-01" " 2.35175297787566239816e-01" " 1.00000000000000000000e+00" +" 5.58662243186231033398e-01" " 2.09881292961108156803e+00" "-1.48732967824660333722e-01" "-1.86388357872649818026e-01" "-3.98054311726238174707e-01" "-9.23470698149933821863e-02" " 3.18130774344331790360e-01" " 2.35617029537986827359e-01" " 2.35564278656810205392e-01" " 1.00000000000000000000e+00" " 3.18232667448426875811e-01" " 2.35697724563712213142e-01" " 2.35960829634340951699e-01" " 1.00000000000000000000e+00" +" 5.78880118080907335454e-01" " 2.10958827069622945061e+00" "-1.45517075703337384063e-01" "-1.87619332923932347068e-01" "-3.93759901818246327299e-01" "-9.25428835502136171165e-02" " 3.13810940695913420662e-01" " 2.41900056778995536932e-01" " 2.42445752728476793258e-01" " 1.00000000000000000000e+00" " 3.14443162564996325781e-01" " 2.41261417956367518745e-01" " 2.43102923882014654300e-01" " 1.00000000000000000000e+00" +" 5.97609561752988072136e-01" " 2.11963448996904224586e+00" "-1.45031114595783383603e-01" "-1.87205794188415763912e-01" "-3.94881995005456065684e-01" "-8.86263596631296779460e-02" " 3.10774119082820043936e-01" " 2.49034608074087504548e-01" " 2.49866199366384905689e-01" " 1.00000000000000000000e+00" " 3.11060216594360450237e-01" " 2.49062419964777598258e-01" " 2.49646736663867746531e-01" " 1.00000000000000000000e+00" +" 5.99085622916895488288e-01" " 2.12042335300555562227e+00" "-1.46234370009478864549e-01" "-1.87433673503737574517e-01" "-3.98897483543813990980e-01" "-8.78030266493344119239e-02" " 3.11926093355595845935e-01" " 2.50466702249947603676e-01" " 2.49703243194474455713e-01" " 1.00000000000000000000e+00" " 3.11679096477434691703e-01" " 2.50718526077582770650e-01" " 2.49627695026237328424e-01" " 1.00000000000000000000e+00" +" 6.19280832850907736464e-01" " 2.13128017203372088773e+00" "-1.43479487002560690545e-01" "-1.87093698547644349262e-01" "-3.94519776879344918896e-01" "-8.53431610232009141281e-02" " 3.07345695680125985394e-01" " 2.58029092220712907846e-01" " 2.57726857394332764528e-01" " 1.00000000000000000000e+00" " 3.07352157299550066138e-01" " 2.57865253749803069461e-01" " 2.58647121121913348141e-01" " 1.00000000000000000000e+00" +" 6.37450199203187239938e-01" " 2.14107236318766336325e+00" "-1.42284579615875261815e-01" "-1.88552201130566088327e-01" "-3.96472719776797488667e-01" "-8.40119348903621276925e-02" " 3.03822808634674423889e-01" " 2.63949199153532987339e-01" " 2.64101889023115043997e-01" " 1.00000000000000000000e+00" " 3.03950755933268257358e-01" " 2.63879217052623626927e-01" " 2.64621757216518316280e-01" " 1.00000000000000000000e+00" +" 6.39467815670481498636e-01" " 2.14216236411993898869e+00" "-1.42078608483172719179e-01" "-1.88161068194381053686e-01" "-3.95942426437073557999e-01" "-8.29085376020118891560e-02" " 3.03247481826876497113e-01" " 2.64426362878928955524e-01" " 2.63971212284766443279e-01" " 1.00000000000000000000e+00" " 3.03872911464449446672e-01" " 2.64129171956780761654e-01" " 2.64462958249511936870e-01" " 1.00000000000000000000e+00" +" 6.59648633284134366939e-01" " 2.15306911929802691219e+00" "-1.40817815964762116376e-01" "-1.87994674374339532097e-01" "-3.97440525350125917203e-01" "-8.00049170657205627188e-02" " 2.99875446983518978428e-01" " 2.71497139105559615047e-01" " 2.71514348289811247028e-01" " 1.00000000000000000000e+00" " 2.99305537599990512110e-01" " 2.71917720866866385876e-01" " 2.71826816678953808726e-01" " 1.00000000000000000000e+00" +" 6.77290836653386407740e-01" " 2.16262758933532683869e+00" "-1.39944188220387233379e-01" "-1.87705038133060192473e-01" "-3.98745397420011638001e-01" "-7.79918396707458688732e-02" " 2.97499038930981674067e-01" " 2.76194314907891147470e-01" " 2.76244997319441798478e-01" " 1.00000000000000000000e+00" " 2.97363042218355133617e-01" " 2.75675960158224986341e-01" " 2.75690815206009076643e-01" " 1.00000000000000000000e+00" +" 6.79825343200614606864e-01" " 2.16398723606551524057e+00" "-1.39004047425796500859e-01" "-1.87504644012200571979e-01" "-3.91366966762861756557e-01" "-7.85486564170837786580e-02" " 2.98331680074675420489e-01" " 2.79115226766198099018e-01" " 2.80736280587756292793e-01" " 1.00000000000000000000e+00" " 2.98214442391661727072e-01" " 2.79170180724318151011e-01" " 2.80699804226712590349e-01" " 1.00000000000000000000e+00" +" 6.99999999999999955591e-01" " 2.17492582805589984574e+00" "-1.36588405418039071648e-01" "-1.87831693297507290596e-01" "-3.93443823370816958551e-01" "-7.59743719371416825759e-02" " 2.92706490685071152313e-01" " 2.84206871258673887670e-01" " 2.83329876780357869936e-01" " 1.00000000000000000000e+00" " 2.92548580766212540372e-01" " 2.83727427603582216253e-01" " 2.82332644857856362997e-01" " 1.00000000000000000000e+00" +" 7.17131474103585686564e-01" " 2.18421983239494243989e+00" "-1.36956831114032950847e-01" "-1.92167796883910391159e-01" "-3.93766068731723262175e-01" "-7.93627751999058661525e-02" " 2.90896799466161370962e-01" " 2.86609162506012482563e-01" " 2.83784961406913893711e-01" " 1.00000000000000000000e+00" " 2.91111938998073804807e-01" " 2.86437163168717978667e-01" " 2.84173975316562410498e-01" " 1.00000000000000000000e+00" +" 7.20174656799385304318e-01" " 2.18594568310359971264e+00" "-1.35534717691423944874e-01" "-1.86919872920234125813e-01" "-3.94224675182199557621e-01" "-7.32759882868472267603e-02" " 2.90457500990027650545e-01" " 2.88296455862945222304e-01" " 2.87130396337602011858e-01" " 1.00000000000000000000e+00" " 2.90447360366767715067e-01" " 2.88228028857387352790e-01" " 2.87145096339809891006e-01" " 1.00000000000000000000e+00" +" 7.40351366715865544244e-01" " 2.19698681420482699878e+00" "-1.34443674218011816057e-01" "-1.89169236473724244885e-01" "-3.93173013855508957093e-01" "-7.26251167799430441541e-02" " 2.87265517909787049255e-01" " 2.95897838488713538219e-01" " 2.95181163032294802129e-01" " 1.00000000000000000000e+00" " 2.87633174215253861750e-01" " 2.95375966485877217149e-01" " 2.95531903234045323359e-01" " 1.00000000000000000000e+00" +" 7.56972111553784854365e-01" " 2.20612580888753218034e+00" "-1.33605219725195373259e-01" "-1.88390908776961130133e-01" "-3.95828887908877269375e-01" "-6.95111713481792736768e-02" " 2.85115029882219928048e-01" " 3.01109605508568745069e-01" " 3.00291061930157754389e-01" " 1.00000000000000000000e+00" " 2.85046272297347524916e-01" " 3.00781225538233276673e-01" " 2.99602218509216144948e-01" " 1.00000000000000000000e+00" +" 7.60532184329518412547e-01" " 2.20805878538101341135e+00" "-1.34054533824664146024e-01" "-1.88894991786114879728e-01" "-3.97612855971857692694e-01" "-6.88792882941900164173e-02" " 2.84917901078804436388e-01" " 3.01840601201333769144e-01" " 3.01505923965321109836e-01" " 1.00000000000000000000e+00" " 2.84917901078804436388e-01" " 3.01840601201333769144e-01" " 3.01505923965321109836e-01" " 1.00000000000000000000e+00" +" 7.80719167149092174718e-01" " 2.21919001376595659281e+00" "-1.32293935532865392091e-01" "-1.88942521166470728256e-01" "-3.99904986068700285529e-01" "-6.58816047066926313569e-02" " 2.80673617977418354830e-01" " 3.08061771476256629487e-01" " 3.06773690570651347276e-01" " 1.00000000000000000000e+00" " 2.80795372781097951620e-01" " 3.08030448257264000134e-01" " 3.06631535222501028226e-01" " 1.00000000000000000000e+00" +" 7.96812749003984022167e-01" " 2.22807390005073324701e+00" "-1.30957039955297754874e-01" "-1.88772417984381324363e-01" "-3.96926918010010176818e-01" "-6.50209880749370999764e-02" " 2.78882402083083402733e-01" " 3.11773841214576685754e-01" " 3.11608731412693462648e-01" " 1.00000000000000000000e+00" " 2.78882402083083402733e-01" " 3.11773841214576685754e-01" " 3.11608731412693462648e-01" " 1.00000000000000000000e+00" +" 8.00914377083104422894e-01" " 2.23034902334584606010e+00" "-1.30993989172689173639e-01" "-1.88955425984223879254e-01" "-3.99259513784885500254e-01" "-6.38864237957462721695e-02" " 2.78482771238290849336e-01" " 3.12924306563041931817e-01" " 3.12620292795022292065e-01" " 1.00000000000000000000e+00" " 2.78605925218550043443e-01" " 3.12784523296142202842e-01" " 3.12029397713817491233e-01" " 1.00000000000000000000e+00" [TRUNCATED] To get the complete diff run: svnlook diff /svnroot/robast -r 628 From noreply at r-forge.r-project.org Wed Mar 13 10:52:00 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 13 Mar 2013 10:52:00 +0100 (CET) Subject: [Robast-commits] r629 - in branches/robast-0.9/pkg: RobAStRDA/R RobExtremes/inst/AddMaterial/interpolation RobExtremesBuffer Message-ID: <20130313095200.67FFB1844E1@r-forge.r-project.org> Author: ruckdeschel Date: 2013-03-13 10:52:00 +0100 (Wed, 13 Mar 2013) New Revision: 629 Added: branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/SnTest.Rdata branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/Snplot.pdf branches/robast-0.9/pkg/RobExtremesBuffer/interpolOMSEGEVFamily.csv branches/robast-0.9/pkg/RobExtremesBuffer/interpolOMSEGEVFamily.txt branches/robast-0.9/pkg/RobExtremesBuffer/interpolRMXEGeneralizedParetoFamily.csv branches/robast-0.9/pkg/RobExtremesBuffer/interpolRMXEGeneralizedParetoFamily.txt Modified: branches/robast-0.9/pkg/RobAStRDA/R/sysdata.rda branches/robast-0.9/pkg/RobExtremesBuffer/interpolMBREGEVFamily.txt Log: + included further grids (3 x RMXE still missing) + added some diagnostics to Sn diagnostics Modified: branches/robast-0.9/pkg/RobAStRDA/R/sysdata.rda =================================================================== (Binary files differ) Added: branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/SnTest.Rdata =================================================================== (Binary files differ) Property changes on: branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/SnTest.Rdata ___________________________________________________________________ Added: svn:mime-type + application/octet-stream Added: branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/Snplot.pdf =================================================================== (Binary files differ) Property changes on: branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/Snplot.pdf ___________________________________________________________________ Added: svn:mime-type + application/octet-stream Modified: branches/robast-0.9/pkg/RobExtremesBuffer/interpolMBREGEVFamily.txt =================================================================== --- branches/robast-0.9/pkg/RobExtremesBuffer/interpolMBREGEVFamily.txt 2013-03-12 22:27:29 UTC (rev 628) +++ branches/robast-0.9/pkg/RobExtremesBuffer/interpolMBREGEVFamily.txt 2013-03-13 09:52:00 UTC (rev 629) @@ -1,2 +1,2 @@ GEVFamily - GEV Family \ No newline at end of file +.MBRE \ No newline at end of file Added: branches/robast-0.9/pkg/RobExtremesBuffer/interpolOMSEGEVFamily.csv =================================================================== --- branches/robast-0.9/pkg/RobExtremesBuffer/interpolOMSEGEVFamily.csv (rev 0) +++ branches/robast-0.9/pkg/RobExtremesBuffer/interpolOMSEGEVFamily.csv 2013-03-13 09:52:00 UTC (rev 629) @@ -0,0 +1,492 @@ +" 5.00000000000000010408e-03" " 2.40128509377427423743e+00" "-2.53911341736012208248e-01" "-1.62230761225884839716e-01" "-2.16485685573087172084e-01" "-1.02263001731746891454e-01" " 1.31830195177181286326e+00" "-3.07854632154704543900e-01" "-3.07854632154704543900e-01" " 2.23811872545793066891e+00" " 1.31830217893950529806e+00" "-3.07855168847395110898e-01" "-3.07855168847395166409e-01" " 2.23811849832543474648e+00" +" 2.14517304631997030029e-02" " 2.41454211259750506358e+00" "-2.55826314499998985763e-01" "-1.63935884854221336493e-01" "-2.15449839621443428594e-01" "-9.93903380920380524755e-02" " 1.31920444856450824744e+00" "-2.85702339544026018281e-01" "-2.85702339544026018281e-01" " 2.26873431195797792270e+00" " 1.31920466770896616104e+00" "-2.85702855633397700963e-01" "-2.85702855633397700963e-01" " 2.26873409208144583005e+00" +" 3.98406374501992024961e-02" " 2.43598387492551271549e+00" "-2.58619884807976929686e-01" "-1.66600345669747740285e-01" "-2.15030651288029422963e-01" "-9.62991736933167946644e-02" " 1.31955384114276630392e+00" "-2.60901724426701675519e-01" "-2.60901724426701675519e-01" " 2.31260651779553505492e+00" " 1.31955402859707771057e+00" "-2.60902158488014346283e-01" "-2.60902158488014346283e-01" " 2.31260629178650711779e+00" +" 4.27829746040001568375e-02" " 2.43130109981367947825e+00" "-2.58241084786000663076e-01" "-1.66142510497722606377e-01" "-2.14224455169829436363e-01" "-9.57563602504175465091e-02" " 1.32010247587462536956e+00" "-2.56454328889691329785e-01" "-2.56454328889691329785e-01" " 2.30878855377306191343e+00" " 1.32010264930651621818e+00" "-2.56454742635747745538e-01" "-2.56454742635747801049e-01" " 2.30878837566377947965e+00" +" 6.40397156295258174197e-02" " 2.44881483947866396278e+00" "-2.61113555075227377067e-01" "-1.68175520562592800689e-01" "-2.13159376867755490093e-01" "-9.22309393243615355251e-02" " 1.32332382739466480892e+00" "-2.27313258584390304184e-01" "-2.27313258584390304184e-01" " 2.34877136063415559164e+00" " 1.32332396131431906383e+00" "-2.27313580134762854845e-01" "-2.27313580134762910356e-01" " 2.34877122425858786414e+00" +" 7.96812749003984049923e-02" " 2.45963590707874635299e+00" "-2.62237090392982596931e-01" "-1.70251876406366436933e-01" "-2.12363633674727186884e-01" "-8.97429139739115422358e-02" " 1.32091191115219341867e+00" "-2.03654455287680752340e-01" "-2.03654455287680752340e-01" " 2.37902408144113231003e+00" " 1.32091210494554833765e+00" "-2.03654909356296293099e-01" "-2.03654909356296293099e-01" " 2.37902388535473541253e+00" +" 8.52248570399394278496e-02" " 2.46377127851079436027e+00" "-2.62793743514861677379e-01" "-1.70785213964076199034e-01" "-2.12105257800917268440e-01" "-8.88502698939516721843e-02" " 1.32101132313565994281e+00" "-1.95831602295594792151e-01" "-1.95831602295594792151e-01" " 2.38966110063432912725e+00" " 1.32101147035655608342e+00" "-1.95831949566785457062e-01" "-1.95831949566785457062e-01" " 2.38966095385576826615e+00" +" 1.06341241002067987687e-01" " 2.47923349421402727799e+00" "-2.64952716167795920832e-01" "-1.73141247827974353868e-01" "-2.11223100579433220592e-01" "-8.55586399247798001788e-02" " 1.32109619709317516190e+00" "-1.64721013624931883479e-01" "-1.64721013624931883479e-01" " 2.43031027452900838526e+00" " 1.32109633844193830043e+00" "-1.64721350951807732343e-01" "-1.64721350951807704588e-01" " 2.43031013369560566773e+00" +" 1.19521912350597614427e-01" " 2.48883553912998811697e+00" "-2.66241713230101761933e-01" "-1.74665662118193898422e-01" "-2.10711339707657985265e-01" "-8.35519490583851442977e-02" " 1.32099184897572907715e+00" "-1.44894737729455019837e-01" "-1.44894737729455019837e-01" " 2.45591578902361140635e+00" " 1.32099196677986152615e+00" "-1.44895021565861648050e-01" "-1.44895021565861648050e-01" " 2.45591567000590282888e+00" +" 1.27391651478953704668e-01" " 2.49448725818374139607e+00" "-2.67002615952775024244e-01" "-1.75524726282162840674e-01" "-2.10430312500238636542e-01" "-8.23637668640585934865e-02" " 1.32095683362846827436e+00" "-1.33149851836712296294e-01" "-1.33149851836712296294e-01" " 2.47127302539507409662e+00" " 1.32095704630153321091e+00" "-1.33150362350174772397e-01" "-1.33150362350174772397e-01" " 2.47127281075529037224e+00" +" 1.48378817222630354777e-01" " 2.51140566925319852487e+00" "-2.69136523249994208395e-01" "-1.77619449907202325845e-01" "-2.09734514420387041511e-01" "-7.92363213832187884833e-02" " 1.32102132332784782953e+00" "-1.01686543049204686229e-01" "-1.01686543049204700107e-01" " 2.51205445380270386835e+00" " 1.32486757541445454578e+00" "-1.01824088333939716255e-01" "-1.01824088333939716255e-01" " 2.51249137789061860460e+00" +" 1.59362549800796809985e-01" " 2.51671295282294904538e+00" "-2.69949593228745343687e-01" "-1.79169598994458223462e-01" "-2.09405476091980735642e-01" "-7.76380095667947300875e-02" " 1.32026245322601010201e+00" "-8.39870184439016481681e-02" "-8.39870184439016481681e-02" " 2.53428537097590922400e+00" " 1.32026256028668842468e+00" "-8.39872817823325429343e-02" "-8.39872817823325429343e-02" " 2.53428526206365978268e+00" +" 1.69305414639138729349e-01" " 2.52343324650908407136e+00" "-2.70836774472871077979e-01" "-1.80475708970242343376e-01" "-2.09130281289551023249e-01" "-7.62600184658757257461e-02" " 1.31999773975928236247e+00" "-6.83738762105675079717e-02" "-6.83738762105675079717e-02" " 2.55408313856492519278e+00" " 1.31997623710557587806e+00" "-6.83741694168372715623e-02" "-6.83741694168372715623e-02" " 2.55408136584190970098e+00" +" 1.90174070534208650152e-01" " 2.53740668611857733694e+00" "-2.72606928647956214817e-01" "-1.82989091761165650896e-01" "-2.08609579750202417392e-01" "-7.33316511649017427343e-02" " 1.31919593236674859149e+00" "-3.53189115985098056605e-02" "-3.53189115985098056605e-02" " 2.59583752467239436967e+00" " 1.31919577445688984696e+00" "-3.53185409769854880002e-02" "-3.53185409769854880002e-02" " 2.59583767795114850330e+00" +" 1.99203187250996005542e-01" " 2.54332764348886319894e+00" "-2.73339913756775076958e-01" "-1.84106918596571245139e-01" "-2.08407411163282652034e-01" "-7.20915011420672074971e-02" " 1.31877227832969579069e+00" "-2.08345401405609365053e-02" "-2.08345401405609295664e-02" " 2.61402407792323332458e+00" " 1.31877238850797740000e+00" "-2.08348117590692362422e-02" "-2.08348117590692362422e-02" " 2.61402396687721294555e+00" +" 2.10987364747485084404e-01" " 2.55096733253335239411e+00" "-2.74284332927467455754e-01" "-1.85626565257313275170e-01" "-2.08167081499255474109e-01" "-7.04977810484318789808e-02" " 1.31816586902611310173e+00" "-1.62303166235691436435e-03" "-1.62303166235691436435e-03" " 2.63787771853512920117e+00" " 1.31816572180973490269e+00" "-1.62265253319862330986e-03" "-1.62265253319862374354e-03" " 2.63787786371904653393e+00" +" 2.31747832682678900351e-01" " 2.56405947159887137587e+00" "-2.75850205555101868349e-01" "-1.88192957988748993392e-01" "-2.07799893739589486286e-01" "-6.77173633059731938655e-02" " 1.31696574436023872146e+00" " 3.22641830576453486623e-02" " 3.22641830576453556012e-02" " 2.68008955579965002514e+00" " 1.31696553669985783053e+00" " 3.22646986688329487358e-02" " 3.22646986688329487358e-02" " 2.68008976258644660007e+00" +" 2.39043824701195228855e-01" " 2.56890529947778212261e+00" "-2.76545580476031060968e-01" "-1.89226435270196058358e-01" "-2.07699859479315518396e-01" "-6.67692708543880936167e-02" " 1.31710283017231732927e+00" " 4.46836790013979134883e-02" " 4.46836790013979134883e-02" " 2.69503806375663002015e+00" " 1.31710270923853300928e+00" " 4.46840068766362202846e-02" " 4.46840068766362202846e-02" " 2.69503819387258847229e+00" +" 2.52457967740567557069e-01" " 2.57676234258241798614e+00" "-2.77403544930406587010e-01" "-1.91026452824926945562e-01" "-2.07533953740809351540e-01" "-6.50471085988357788921e-02" " 1.31563338193158996248e+00" " 6.71041284691786532601e-02" " 6.71041284691786393823e-02" " 2.72264513941854868762e+00" " 1.31563318584914190623e+00" " 6.71046173755961289364e-02" " 6.71046173755961289364e-02" " 2.72264533250027707112e+00" +" 2.73120223661343919375e-01" " 2.58935135695428542135e+00" "-2.78793917762606313637e-01" "-1.93664651306639040707e-01" "-2.07288516570900832603e-01" "-6.23990932675132503604e-02" " 1.31430003227043723513e+00" " 1.01838028209691497383e-01" " 1.01838028209691511261e-01" " 2.76534295725073553385e+00" " 1.31429988407161779662e+00" " 1.01838403478763550591e-01" " 1.01838403478763564469e-01" " 2.76534310450834119877e+00" +" 2.78884462151394396656e-01" " 2.59274970999641318770e+00" "-2.79152066755583350144e-01" "-1.94381880012044705452e-01" "-2.07227093272299794924e-01" "-6.16724898997675838319e-02" " 1.31390764480861688135e+00" " 1.11472498104753778292e-01" " 1.11472498104753792170e-01" " 2.77728191130875945447e+00" " 1.31390743924451625091e+00" " 1.11473011068875776930e-01" " 1.11473011068875776930e-01" " 2.77728211527243562529e+00" +" 2.93737016782436521911e-01" " 2.60140341901371119349e+00" "-2.80101376426367565386e-01" "-1.96310179780772031677e-01" "-2.07121669772359795481e-01" "-5.98182719534766371705e-02" " 1.31285610481426573415e+00" " 1.36754518739120950466e-01" " 1.36754518739120950466e-01" " 2.80826274898633521104e+00" " 1.31285600679695479975e+00" " 1.36754788235052354706e-01" " 1.36754788235052354706e-01" " 2.80826285490420302082e+00" +" 3.14310728217555401809e-01" " 2.61304877086832654243e+00" "-2.81259182596917178820e-01" "-1.99519608484740151866e-01" "-2.07005110271058861970e-01" "-5.73687433578903768772e-02" " 1.31063032766004128327e+00" " 1.73474204881855414984e-01" " 1.73474204881855414984e-01" " 2.85189508125587298792e+00" " 1.31063021292345749380e+00" " 1.73474498369988433533e-01" " 1.73474498369988461288e-01" " 2.85189519641254962679e+00" +" 3.18725099601593619969e-01" " 2.61547401291061598627e+00" "-2.81523397370504524506e-01" "-2.00146491507074614224e-01" "-2.07006008478955727536e-01" "-5.68438277444334519317e-02" " 1.31022900560164634598e+00" " 1.81164977884682276699e-01" " 1.81164977884682304454e-01" " 2.86124872745464209345e+00" " 1.31022888977120866016e+00" " 1.81165277424853554677e-01" " 1.81165277424853554677e-01" " 2.86124884656682176853e+00" +" 3.34843705962408810795e-01" " 2.62452487924088107007e+00" "-2.82563207429490093059e-01" "-2.02341368969242541009e-01" "-2.06995322963489519763e-01" "-5.49160665355470575810e-02" " 1.30952902021256112342e+00" " 2.09352450945821083605e-01" " 2.09352450945821083605e-01" " 2.89544554475726645393e+00" " 1.30952888441106241046e+00" " 2.09352796098235593991e-01" " 2.09352796098235593991e-01" " 2.89544567967660082530e+00" +" 3.55338266932213375782e-01" " 2.63518357133982661367e+00" "-2.83407519759656167935e-01" "-2.05482428538255657013e-01" "-2.06990384509276065250e-01" "-5.26335376796644854869e-02" " 1.30679035328581871767e+00" " 2.45365791659459708818e-01" " 2.45365791659459764329e-01" " 2.93907982323017114012e+00" " 1.30679020380931465439e+00" " 2.45366176915318340290e-01" " 2.45366176915318340290e-01" " 2.93907997176295365804e+00" +" 3.58565737051792843282e-01" " 2.63689278858312148301e+00" "-2.83556543347487977069e-01" "-2.05937460173548386733e-01" "-2.06996807608413185831e-01" "-5.22620657587625492280e-02" " 1.30646520346438621551e+00" " 2.51088521157770860892e-01" " 2.51088521157770860892e-01" " 2.94598066415266268692e+00" " 1.30646505668803647460e+00" " 2.51088893983506311613e-01" " 2.51088893983506311613e-01" " 2.94598080684764696002e+00" +" 3.75796698935874085024e-01" " 2.64561905074194703147e+00" "-2.84270730433423435279e-01" "-2.07637868890354737594e-01" "-2.07075425880771324394e-01" "-5.01299599806238269095e-02" " 1.30484546667806045050e+00" " 2.80656158062331018144e-01" " 2.80656158062331073655e-01" " 2.98266756608919170191e+00" " 1.30484527347428747035e+00" " 2.80656666051136816087e-01" " 2.80656666051136816087e-01" " 2.98266776039752778971e+00" +" 3.96221262591437028977e-01" " 2.65572614582662591687e+00" "-2.85107555656794464660e-01" "-2.10425357863668560654e-01" "-2.07216546010285412871e-01" "-4.78014594702972986373e-02" " 1.30270366023532857547e+00" " 3.17266321484519719931e-01" " 3.17266321484519719931e-01" " 3.02674018187466975505e+00" " 1.30270355294292428106e+00" " 3.17266600267238518818e-01" " 3.17266600267238518818e-01" " 3.02674028919167437124e+00" +" 3.98406374501992011083e-01" " 2.65676994412421318970e+00" "-2.85181070166323491488e-01" "-2.10736529407159228766e-01" "-2.07231809842963882184e-01" "-4.75591662667315881463e-02" " 1.30243198442438812279e+00" " 3.21194089811284611002e-01" " 3.21194089811284611002e-01" " 3.03148651146901304543e+00" " 1.30243187463162435336e+00" " 3.21194378278043923824e-01" " 3.21194378278043979336e-01" " 3.03148662237912658313e+00" +" 4.16614193187194392642e-01" " 2.66540838417555692175e+00" "-2.85870255732163902618e-01" "-2.13443902219047021429e-01" "-2.07403616276109009631e-01" "-4.55839317966246146407e-02" " 1.30049987497180663532e+00" " 3.54113152212626736137e-01" " 3.54113152212626791648e-01" " 3.07124944540831590345e+00" " 1.30049977152962470406e+00" " 3.54113428694247556194e-01" " 3.54113428694247611705e-01" " 3.07124955198241966770e+00" +" 4.36977702492617525731e-01" " 2.67484066940262454892e+00" "-2.86531291814079325242e-01" "-2.16101660720678823147e-01" "-2.07648816891719767419e-01" "-4.32854726213241017274e-02" " 1.29834626918724649336e+00" " 3.91152196877715407908e-01" " 3.91152196877715407908e-01" " 3.11604472844921565056e+00" " 1.29834605409736458803e+00" " 3.91152573712019002716e-01" " 3.91152573712019058227e-01" " 3.11604487843613542353e+00" +" 4.38247011952191289907e-01" " 2.67540765256069246192e+00" "-2.86560036897251124710e-01" "-2.16279407383296151668e-01" "-2.07663620459663272877e-01" "-4.31483671847090605178e-02" " 1.29817083846970215966e+00" " 3.93460231674401861302e-01" " 3.93460231674401916813e-01" " 3.11882319115088391115e+00" " 1.29817068359937426436e+00" " 3.93460614011107545629e-01" " 3.93460614011107545629e-01" " 3.11882333388566657106e+00" +" 4.57313980523084140373e-01" " 2.68428183683234600210e+00" "-2.87161982455994280183e-01" "-2.19436388850463015565e-01" "-2.07922906835995402464e-01" "-4.12166205181808686930e-02" " 1.29610104255817693009e+00" " 4.28780232849801989925e-01" " 4.28780232849801989925e-01" " 3.16093986787208347522e+00" " 1.29610089126697891615e+00" " 4.28780631999317873859e-01" " 4.28780631999317818348e-01" " 3.16094001486715470151e+00" +" 4.77625197262214196137e-01" " 2.69309824145089926617e+00" "-2.87597245591142747223e-01" "-2.22349329525074690395e-01" "-2.08246596265075301080e-01" "-3.90832508831320604714e-02" " 1.29357263779853859376e+00" " 4.66059788740497804582e-01" " 4.66059788740497860093e-01" " 3.20582536238366877512e+00" " 1.29357247325616930844e+00" " 4.66060223213618673999e-01" " 4.66060223213618729510e-01" " 3.20582552296130840475e+00" +" 4.78087649402390457709e-01" " 2.69329560054693262217e+00" "-2.87607261120364388063e-01" "-2.22416168464206143174e-01" "-2.08254705092320718807e-01" "-3.90350770896193688397e-02" " 1.29351851456596644852e+00" " 4.66911564329327177791e-01" " 4.66911564329327177791e-01" " 3.20685294794615538549e+00" " 1.29351834735600657034e+00" " 4.66912005248312778072e-01" " 4.66912005248312778072e-01" " 3.20685311112380766474e+00" +" 4.97913504345446511490e-01" " 2.70153334512799281342e+00" "-2.88015884016103673737e-01" "-2.25289752645707219703e-01" "-2.08636444395623538162e-01" "-3.69847578614037053590e-02" " 1.29121406464051746710e+00" " 5.03492725207872249271e-01" " 5.03492725207872249271e-01" " 3.25114862341816701630e+00" " 1.29121388861899588640e+00" " 5.03493205442890889856e-01" " 5.03493205442890889856e-01" " 3.25114879931582967387e+00" +" 5.17928286852589625511e-01" " 2.70954372172880386671e+00" "-2.88350441187494699324e-01" "-2.28216546928263430694e-01" "-2.09063572059958208138e-01" "-3.49482160820961534897e-02" " 1.28887021914820087964e+00" " 5.40646198970022417996e-01" " 5.40646198970022417996e-01" " 3.29593911253186577781e+00" " 1.28887011790544070422e+00" " 5.40646472971455072098e-01" " 5.40646472971455072098e-01" " 3.29593921354543351043e+00" +" 5.18181036708362463550e-01" " 2.70964035535366365437e+00" "-2.88353042014883209632e-01" "-2.28253704812705349170e-01" "-2.09069198018009327900e-01" "-3.49228208740001919153e-02" " 1.28883537384370616685e+00" " 5.41114788535929647217e-01" " 5.41114788535929647217e-01" " 3.29650753391429107708e+00" " 1.28883527126237917848e+00" " 5.41115067437769714509e-01" " 5.41115067437769714509e-01" " 3.29650763665900115029e+00" +" 5.38429914203115922433e-01" " 2.71716079873078397711e+00" "-2.88608564139999856923e-01" "-2.31170657911361931980e-01" "-2.09557560991311231380e-01" "-3.28884627485778804901e-02" " 1.28641538568397972853e+00" " 5.78667540622584186671e-01" " 5.78667540622584075649e-01" " 3.34167100747276890615e+00" " 1.28642246451210739977e+00" " 5.78651848783998667969e-01" " 5.78651848783998667969e-01" " 3.34166394345097028662e+00" +" 5.57768924302788793312e-01" " 2.72468803608874532429e+00" "-2.88784028997269959227e-01" "-2.34105985808888666933e-01" "-2.10050822045016710726e-01" "-3.09879699323215782036e-02" " 1.28410338824975389649e+00" " 6.14981840754705300078e-01" " 6.14981840754705300078e-01" " 3.38611023437945091175e+00" " 1.28410319419461926849e+00" " 6.14982373791432279653e-01" " 6.14982373791432279653e-01" " 3.38611043034725289758e+00" +" 5.58662243186231033398e-01" " 2.72487934379618756964e+00" "-2.88792381965105038333e-01" "-2.34210345196515290489e-01" "-2.10078169809884945929e-01" "-3.08977709987771492761e-02" " 1.28400371068723595513e+00" " 6.16588826509352316840e-01" " 6.16588826509352205818e-01" " 3.38790059479888316929e+00" " 1.28400358837552697189e+00" " 6.16589154539422867884e-01" " 6.16589154539422867884e-01" " 3.38790071628743172383e+00" +" 5.78880118080907335454e-01" " 2.73241560612044320777e+00" "-2.88923848706356956040e-01" "-2.37319659076864641900e-01" "-2.10638160592496487267e-01" "-2.89393555096678113669e-02" " 1.28169204557965543678e+00" " 6.54837770987638512210e-01" " 6.54837770987638401188e-01" " 3.43428231910781844860e+00" " 1.28169193227343813923e+00" " 6.54838087083668640709e-01" " 6.54838087083668640709e-01" " 3.43428243181414627472e+00" +" 5.97609561752988072136e-01" " 2.73885574246650254082e+00" "-2.88954158588160092691e-01" "-2.40010190994984912161e-01" "-2.11215905246000895668e-01" "-2.71275488533867722984e-02" " 1.27946422868606157763e+00" " 6.89739845140088014830e-01" " 6.89739845140088014830e-01" " 3.47713896461206672939e+00" " 1.27946410287144196616e+00" " 6.89740202568695059959e-01" " 6.89740202568695059959e-01" " 3.47713909321581704504e+00" +" 5.99085622916895488288e-01" " 2.73935731251943881404e+00" "-2.88955885383668231725e-01" "-2.40231087022352296501e-01" "-2.11262598764434844645e-01" "-2.69865968000432346341e-02" " 1.27929481006719369951e+00" " 6.92518845664465754197e-01" " 6.92518845664465865219e-01" " 3.48053706948833241341e+00" " 1.27929468016691272325e+00" " 6.92519212610348655623e-01" " 6.92519212610348544601e-01" " 3.48053720119772735941e+00" +" 6.19280832850907736464e-01" " 2.74616796715694766462e+00" "-2.89643353915046253277e-01" "-2.43657770273752627421e-01" "-2.12475760186618178871e-01" "-2.50732684392327917489e-02" " 1.27697583597124442178e+00" " 7.30536169510832333884e-01" " 7.30536169510832333884e-01" " 3.52712864048767738012e+00" " 1.27697569712246661311e+00" " 7.30536559878191216200e-01" " 7.30536559878191327222e-01" " 3.52712877637000676856e+00" +" 6.37450199203187239938e-01" " 2.75249934473272039881e+00" "-2.89172272352654968763e-01" "-2.46179245650317235494e-01" "-2.12597221632136623715e-01" "-2.33734969904520646644e-02" " 1.27602580646586627466e+00" " 7.65513140027524352504e-01" " 7.65513140027524463527e-01" " 3.56957163485095829714e+00" " 1.27602567977570524604e+00" " 7.65513498225085076143e-01" " 7.65513498225085076143e-01" " 3.56957176106893392387e+00" +" 6.39467815670481498636e-01" " 2.75310414759283306196e+00" "-2.89159022162135959100e-01" "-2.46462837859406674879e-01" "-2.12672092543342211579e-01" "-2.31834725648866549208e-02" " 1.27578978750098293027e+00" " 7.69260292554645008778e-01" " 7.69260292554645119800e-01" " 3.57421628153794390670e+00" " 1.27578964649283865818e+00" " 7.69260691132373053414e-01" " 7.69260691132373053414e-01" " 3.57421642201230582714e+00" +" 6.59648633284134366939e-01" " 2.75854219996596627951e+00" "-2.88748911865082835693e-01" "-2.49225198198505693004e-01" "-2.13420868174480776736e-01" "-2.13006522070140688618e-02" " 1.27247323344485274710e+00" " 8.06386276375267829764e-01" " 8.06386276375267829764e-01" " 3.62081220551769389360e+00" " 1.27247306642675805932e+00" " 8.06386746842419066539e-01" " 8.06386746842419177561e-01" " 3.62081237200234351548e+00" +" 6.77290836653386407740e-01" " 2.76465023189461689412e+00" "-2.88640879791311200098e-01" "-2.52518280866597888412e-01" "-2.14066559350685220453e-01" "-1.97492548466727986523e-02" " 1.27072584875228877799e+00" " 8.41599139006317220613e-01" " 8.41599139006317220613e-01" " 3.66394343347443873782e+00" " 1.27072571269352452283e+00" " 8.41599540050996353102e-01" " 8.41599540050996353102e-01" " 3.66394357825410388330e+00" +" 6.79825343200614606864e-01" " 2.76543649659916024319e+00" "-2.88591742976441745228e-01" "-2.52872771151572028892e-01" "-2.14162579686252518840e-01" "-1.95161457325526976891e-02" " 1.27041116780731710989e+00" " 8.46334999486084038622e-01" " 8.46334999486084038622e-01" " 3.66976057823013235293e+00" " 1.27041103767093965793e+00" " 8.46335377097435670457e-01" " 8.46335377097435559435e-01" " 3.66976071097437950286e+00" +" 6.99999999999999955591e-01" " 2.77100298880315376593e+00" "-2.88362576701770623178e-01" "-2.55782391312749046719e-01" "-2.15049233904829523167e-01" "-1.76705931634227528249e-02" " 1.26827693592509138654e+00" " 8.83987513389265733288e-01" " 8.83987513389265622266e-01" " 3.71700293882487509123e+00" " 1.26827681949825343821e+00" " 8.83987866529965526929e-01" " 8.83987866529965637952e-01" " 3.71700305495561922342e+00" +" 7.17131474103585686564e-01" " 2.77565958632115306060e+00" "-2.88185602554425601696e-01" "-2.58313160862938429041e-01" "-2.15822816545191836779e-01" "-1.61208689984772418624e-02" " 1.26685047563529185055e+00" " 9.16225453238396325695e-01" " 9.16225453238396436717e-01" " 3.75729821866851043666e+00" " 1.26685033030207350180e+00" " 9.16225868948557620186e-01" " 9.16225868948557509164e-01" " 3.75729836218774515544e+00" +" 7.20174656799385304318e-01" " 2.77646418492098057129e+00" "-2.88130807379536779678e-01" "-2.58744803377482734952e-01" "-2.15962948600649518038e-01" "-1.58458276896500487030e-02" " 1.26652583318100941945e+00" " 9.21891631908910547111e-01" " 9.21891631908910547111e-01" " 3.76442984466549557254e+00" " 1.26652564917158350077e+00" " 9.21892157345478802100e-01" " 9.21892157345478691077e-01" " 3.76443002498464007743e+00" +" 7.40351366715865544244e-01" " 2.78131235060696280215e+00" "-2.87706007931017249124e-01" "-2.61559593966847525603e-01" "-2.16942448176420332739e-01" "-1.40289809032306360403e-02" " 1.26416095497967329031e+00" " 9.59144560794664480241e-01" " 9.59144560794664480241e-01" " 3.81214710826484504125e+00" " 1.26416080588892487668e+00" " 9.59144992980606625466e-01" " 9.59144992980606514443e-01" " 3.81214725297409140481e+00" +" 7.56972111553784854365e-01" " 2.78522744129586685702e+00" "-2.87369763835595093404e-01" "-2.63849641403410994922e-01" "-2.17795387545653751360e-01" "-1.25295287080472075164e-02" " 1.26250111708432810609e+00" " 9.89888057158012424352e-01" " 9.89888057158012424352e-01" " 3.85143812635251414633e+00" " 1.26250096534837052964e+00" " 9.89888488959894119468e-01" " 9.89888488959893897423e-01" " 3.85143827007209704760e+00" +" 7.60532184329518412547e-01" " 2.78622385617694279247e+00" "-2.87322610870123673621e-01" "-2.64437759187369281211e-01" "-2.17979956382770873047e-01" "-1.22269710266746708255e-02" " 1.26221294951061091538e+00" " 9.96605965528085890881e-01" " 9.96605965528085779859e-01" " 3.86013433439077324749e+00" " 1.26221279887032489242e+00" " 9.96606403905933468934e-01" " 9.96606403905933246890e-01" " 3.86013448302028594483e+00" +" 7.80719167149092174718e-01" " 2.79071697233042215203e+00" "-2.86940391792213866928e-01" "-2.67268493062130962912e-01" "-2.19118340894694729748e-01" "-1.04281866612960655294e-02" " 1.26032361778944745900e+00" " 1.03377092869702247313e+00" " 1.03377092869702247313e+00" " 3.90772099426779062625e+00" " 1.26032346325817390387e+00" " 1.03377138619256925267e+00" " 1.03377138619256925267e+00" " 3.90772114935811787362e+00" +" 7.96812749003984022167e-01" " 2.79428378281925304805e+00" "-2.86571762983314437534e-01" "-2.69515822758666034886e-01" "-2.20021238483749492776e-01" "-9.00150559040518126463e-03" " 1.25896289599862942765e+00" " 1.06350760323744908398e+00" " 1.06350760323744908398e+00" " 3.94619551428354853329e+00" " 1.25896271965850448105e+00" " 1.06350812061076149817e+00" " 1.06350812061076149817e+00" " 3.94619568231217110466e+00" +" 8.00914377083104422894e-01" " 2.79519822577551790843e+00" "-2.86492087524900240769e-01" "-2.70130360801969893192e-01" "-2.20265374796772911425e-01" "-8.64839453547658863763e-03" " 1.25861418851259565521e+00" " 1.07105942677345766789e+00" " 1.07105942677345766789e+00" " 3.95601597293648010734e+00" " 1.25861402031397529022e+00" " 1.07105992017986939580e+00" " 1.07105992017986961784e+00" " 3.95601613246161099013e+00" +" 8.21119881919092575728e-01" " 2.80269294572915628194e+00" "-2.86042779404959923717e-01" "-2.73599761880149061621e-01" "-2.21426144597225038613e-01" "-6.92709036146181653809e-03" " 1.25708974228498049364e+00" " 1.11016741840597421564e+00" " 1.11016741840597421564e+00" " 4.01031149699128786068e+00" " 1.25708959266935371701e+00" " 1.11016785935540696073e+00" " 1.11016785935540696073e+00" " 4.01031163085172348559e+00" +" 8.36653386454183189969e-01" " 2.80556413257363690406e+00" "-2.85713879206789811427e-01" "-2.75621596713970073989e-01" "-2.22471992856803607586e-01" "-5.53477264426412932791e-03" " 1.25595161237361430118e+00" " 1.13822321024383943389e+00" " 1.13822321024383965593e+00" " 4.04694786796268601847e+00" " 1.25595145904891825062e+00" " 1.13822367030240023666e+00" " 1.13822367030240045871e+00" " 4.04694800454236425225e+00" +" 8.41337756813768877784e-01" " 2.80647812983986444380e+00" "-2.85668451893742125769e-01" "-2.76333891248517315997e-01" "-2.22827208653015168549e-01" "-5.12496892730093453472e-03" " 1.25564184682084922784e+00" " 1.14679134235248425533e+00" " 1.14679134235248447737e+00" " 4.05811403831838823919e+00" " 1.25564169038601414208e+00" " 1.14679182111826660773e+00" " 1.14679182111826638568e+00" " 4.05811418474282703528e+00" +" 8.61570085796883988749e-01" " 2.81035841236893624284e+00" "-2.85309742973438640323e-01" "-2.79210461666530351810e-01" "-2.24291527472091439810e-01" "-3.34301684547926676247e-03" " 1.25440633931222089714e+00" " 1.18366030779667075201e+00" " 1.18366030779667052997e+00" " 4.10630553456487135122e+00" " 1.25436703981998776136e+00" " 1.18358461381047841421e+00" " 1.18358461381047863625e+00" " 4.10618396664651275074e+00" +" 8.76494023904382579815e-01" " 2.81366671070904716956e+00" "-2.85235150718145702431e-01" "-2.81409899424217513353e-01" "-2.25560406977844990495e-01" "-2.00022720732080227374e-03" " 1.25382427753370429002e+00" " 1.21087840795367962521e+00" " 1.21087840795367984725e+00" " 4.14141548092555122906e+00" " 1.25382416669416807409e+00" " 1.21087874637095893604e+00" " 1.21087874637095893604e+00" " 4.14141553545485407994e+00" +" 8.81818963291637447632e-01" " 2.81491962034387288583e+00" "-2.85304399607385517079e-01" "-2.82347000177211926442e-01" "-2.26095665747641644261e-01" "-1.53760809210002420862e-03" " 1.25357407665295772503e+00" " 1.22054592773377912351e+00" " 1.22054592773377934556e+00" " 4.15381363055272867513e+00" " 1.25357392120837585203e+00" " 1.22054622804516355039e+00" " 1.22054622804516355039e+00" " 4.15381363992571372989e+00" +" 9.02086495654553344181e-01" " 2.82182080541361202108e+00" "-2.85825004542802019181e-01" "-2.86658278572574587439e-01" "-2.28198310961407913044e-01" " 1.57687096993358870541e-04" " 1.25339890817622667818e+00" " 1.25908401041804829390e+00" " 1.25908401041804851594e+00" " 4.20152034557890452504e+00" " 1.25339874894622771428e+00" " 1.25908419570234264562e+00" " 1.25908419570234242357e+00" " 4.20152015056531791259e+00" +" 9.16334661354581747617e-01" " 2.82513155422082240520e+00" "-2.86241131117919767046e-01" "-2.89615641641557897135e-01" "-2.29801062135420730570e-01" " 1.33801905498166697622e-03" " 1.25308554822870110712e+00" " 1.28492561833686891326e+00" " 1.28492561833686891326e+00" " 4.23128711227048448507e+00" " 1.25308547882090670633e+00" " 1.28492590751650825887e+00" " 1.28492590751650803682e+00" " 4.23128717193832937227e+00" +" 9.22374802737785715046e-01" " 2.82915190666654625673e+00" "-2.86262924731191470418e-01" "-2.91303968633767174090e-01" "-2.30355273242289521063e-01" " 1.77508939722248026277e-03" " 1.25269894098024892060e+00" " 1.29733072675643623661e+00" " 1.29733072675643623661e+00" " 4.24931512396450727920e+00" " 1.25269886417471498774e+00" " 1.29733101964093489045e+00" " 1.29733101964093511249e+00" " 4.24931518206029412710e+00" +" 9.42686019476915770809e-01" " 2.83554495091714731103e+00" "-2.86817371262359788187e-01" "-2.96109428504264582394e-01" "-2.32638647288946343039e-01" " 3.36203053653081349386e-03" " 1.25217939147158374702e+00" " 1.33489061014333465494e+00" " 1.33489061014333487698e+00" " 4.29431414377743791988e+00" " 1.25217931077553301655e+00" " 1.33489093478126297221e+00" " 1.33489093478126297221e+00" " 4.29431420944704456133e+00" +" 9.56175298804780915418e-01" " 2.84158241319695514804e+00" "-2.87188140045397222178e-01" "-2.99826526913039959066e-01" "-2.34098456825798606484e-01" " 4.35160845668798243469e-03" " 1.25208682832369011528e+00" " 1.36121475957846493898e+00" " 1.36121475957846493898e+00" " 4.32750349400366296493e+00" " 1.25208663854457147302e+00" " 1.36121524645012170751e+00" " 1.36121524645012192956e+00" " 4.32750367767279886522e+00" +" 9.63022297507382329940e-01" " 2.84411144017217187852e+00" "-2.87325732484101037389e-01" "-3.01483763568815343881e-01" "-2.34870724013353932014e-01" " 4.87338273773883171730e-03" " 1.25183965837428168300e+00" " 1.37373731418724243092e+00" " 1.37373731418724220887e+00" " 4.34334921347773761369e+00" " 1.25183957452615302053e+00" " 1.37373766230183425030e+00" " 1.37373766230183447234e+00" " 4.34334928356870975108e+00" +" 9.83385806812805518540e-01" " 2.85302789876178541917e+00" "-2.87834119330508009238e-01" "-3.07059258860374439948e-01" "-2.37158145623229676957e-01" " 6.35678451822245266928e-03" " 1.25153975466647704451e+00" " 1.41249639997649145684e+00" " 1.41249639997649123480e+00" " 4.39308207027179076221e+00" " 1.25153958976241597156e+00" " 1.41249672302208639785e+00" " 1.41249672302208617580e+00" " 4.39308211172095131047e+00" [TRUNCATED] To get the complete diff run: svnlook diff /svnroot/robast -r 629 From noreply at r-forge.r-project.org Wed Mar 13 14:33:37 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 13 Mar 2013 14:33:37 +0100 (CET) Subject: [Robast-commits] r630 - in branches/robast-0.9/pkg: RobAStRDA/R RobAStRDA/man RobExtremes/R RobExtremes/inst/AddMaterial/interpolation RobExtremes/man Message-ID: <20130313133338.12AED184306@r-forge.r-project.org> Author: ruckdeschel Date: 2013-03-13 14:33:37 +0100 (Wed, 13 Mar 2013) New Revision: 630 Modified: branches/robast-0.9/pkg/RobAStRDA/R/interpolAux.R branches/robast-0.9/pkg/RobAStRDA/man/internal-interpolate.Rd branches/robast-0.9/pkg/RobExtremes/R/SnQn.R branches/robast-0.9/pkg/RobExtremes/R/getStartIC.R branches/robast-0.9/pkg/RobExtremes/R/internal-getpsi.R branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/SnTest.Rdata branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/Snplot.pdf branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/checkSn.R branches/robast-0.9/pkg/RobExtremes/man/internal-interpolate.Rd Log: + RobExtremes: revised Sn diagnostics + RobAStRDA: interpolators (.generateInterpolators, .computeInterpolators) gain possibility to restrict domain of extrapolation by argument extrapol (if beyond, the interpolating functions return NA); + RobExtremes: Sn and getStartIC learn to deal with return NAs from interpolation (to this end a new function .is.na.Psi) Modified: branches/robast-0.9/pkg/RobAStRDA/R/interpolAux.R =================================================================== --- branches/robast-0.9/pkg/RobAStRDA/R/interpolAux.R 2013-03-13 09:52:00 UTC (rev 629) +++ branches/robast-0.9/pkg/RobAStRDA/R/interpolAux.R 2013-03-13 13:33:37 UTC (rev 630) @@ -35,12 +35,15 @@ # .generateInterpolators generates the interpolators to a given grid # and returns a list of the given grid and the function list ############################################################################ -.generateInterpolators <- function(Grid, approxOrspline = "spline"){ +.generateInterpolators <- function(Grid, approxOrspline = "spline", + extrapol = c(NA,NA)){ thGrid <- Grid[,1] LMGrid <- Grid[,-1,drop=FALSE] fctL <- vector("list",ncol(LMGrid)) xm <- thGrid[1] xM <- (rev(thGrid))[1] + xm0 <- if(is.na(extrapol[1])) -Inf else extrapol[1] + xM0 <- if(is.na(extrapol[2])) Inf else extrapol[2] for(i in 1:ncol(LMGrid)){ LMG <- LMGrid[,i] fct <- if(approxOrspline=="spline") @@ -52,8 +55,10 @@ fctX <- function(x){ y0 <- fct(x) y1 <- y0 - y1[xxM] <- yM+dyM*(x[x>xM]-xM) + y1[x < xm & x >= xm0] <- ym+dym*(x[x < xm & x >= xm0]-xm) + y1[x > xM & x <= xM0] <- yM+dyM*(x[x > xM & x <= xM0]-xM) + y1[x < xm0] <- NA + y1[x > xM0] <- NA if(any(is.na(y0))) warning(paste("There have been xi-values out of range ", "of the interpolation grid.", sep = "")) @@ -191,7 +196,8 @@ includeGrids = NULL, includeNams = NULL, excludeGrids = NULL, excludeNams = NULL, withPrint = TRUE, withSmoothFct = FALSE, - approxOrspline = "spline"){ + approxOrspline = "spline", + extrapol = c(NA,NA)){ wprint <- function(...){ if (withPrint) print(...)} Modified: branches/robast-0.9/pkg/RobAStRDA/man/internal-interpolate.Rd =================================================================== --- branches/robast-0.9/pkg/RobAStRDA/man/internal-interpolate.Rd 2013-03-13 09:52:00 UTC (rev 629) +++ branches/robast-0.9/pkg/RobAStRDA/man/internal-interpolate.Rd 2013-03-13 13:33:37 UTC (rev 630) @@ -27,7 +27,7 @@ .readGridFromCSV(fromFileCSV) -.generateInterpolators(Grid, approxOrspline = "spline") +.generateInterpolators(Grid, approxOrspline = "spline", extrapol = c(NA,NA)) .saveGridToRda(fromFileCSV, toFileRDA = "sysdata.rda", withMerge = FALSE, withPrint = TRUE, withSmooth = TRUE, df = NULL) @@ -37,7 +37,8 @@ .computeInterpolators(sysdataFiles, toFileRDA = "sysdata.rda", includeGrids = NULL, includeNams = NULL, excludeGrids = NULL, excludeNams = NULL, - withPrint = TRUE, withSmoothFct = FALSE, approxOrspline = "spline") + withPrint = TRUE, withSmoothFct = FALSE, + approxOrspline = "spline", extrapol = c(NA,NA)) .mergeF(file,envir, includeGrids = NULL, includeNams = NULL, excludeGrids = NULL, excludeNams = NULL) @@ -65,6 +66,10 @@ \item{approxOrspline}{character; if \code{approxOrspline=="spline"} (default), \code{\link{splinefun}} is used for generating the interpolators, otherwise we use \code{\link{approxfun}}. } + \item{extrapol}{numeric of length 2; lower and upper bound, upto which + extrapolation is done; beyond, the interpolator returns \code{NA}; + if one (or both) entries of \code{extrapol} are \code{NA}, we extrapolate + beyond limit. } \item{toFileRDA}{character; the \file{.rda}-file to which the interpolators are saved. } \item{withMerge}{logical of length 1: in case a respective grid already Modified: branches/robast-0.9/pkg/RobExtremes/R/SnQn.R =================================================================== --- branches/robast-0.9/pkg/RobExtremes/R/SnQn.R 2013-03-13 09:52:00 UTC (rev 629) +++ branches/robast-0.9/pkg/RobExtremes/R/SnQn.R 2013-03-13 13:33:37 UTC (rev 630) @@ -111,6 +111,7 @@ if(!nam %in% names(sng)) return(Sn(as(x,"AbscontDistribution"))) snf <- sng[[nam]][[.versionSuff("fun")]] ret <- snf(shape(x)) + if(is.na(ret)) return(Sn(as(x,"AbscontDistribution"))) }else ret <- scale(x)*Sn(x=x/scale(x)) return(ret) } Modified: branches/robast-0.9/pkg/RobExtremes/R/getStartIC.R =================================================================== --- branches/robast-0.9/pkg/RobExtremes/R/getStartIC.R 2013-03-13 09:52:00 UTC (rev 629) +++ branches/robast-0.9/pkg/RobExtremes/R/getStartIC.R 2013-03-13 13:33:37 UTC (rev 630) @@ -2,10 +2,16 @@ function(model, risk, ...){ mc <- match.call(expand.dots=TRUE) + mc$risk <- if(type(risk)==".MBRE") asMSE() else asBias() + mc$neighbor <- ContNeighborhood(radius=0.5) gridn <- type(risk) nam <- gsub(" ","",name(model)) param1 <- param(model) + + scshnm <- scaleshapename(model) + shnam <- scshnm["shape"] + nsng <- character(0) sng <- try(getFromNamespace(gridn, ns = "RobAStRDA"), silent=TRUE) if(!is(sng,"try-error")) nsng <- names(sng) @@ -14,15 +20,20 @@ fctN <- .versionSuff("fun") interpolfct <- sng[[nam]][[fctN]] .modifyIC <- function(L2Fam, IC){ - para <- param(L2Fam) - .getPsi(para, interpolfct, L2Fam, type(risk))} - IC0 <- .getPsi(param1, interpolfct, model, type(risk)) - IC0 at modifyIC <- .modifyIC - return(IC0) + para <- param(L2Fam) + if(!.is.na.Psi(para, interpolfct, shnam)) + return(.getPsi(para, interpolfct, L2Fam, type(risk))) + else + return(do.call(getStartIC, as.list(mc[-1]), + envir=parent.frame(2))) + } + if(!.is.na.Psi(param1, interpolfct, shnam)){ + IC0 <- .getPsi(param1, interpolfct, model, type(risk)) + IC0 at modifyIC <- .modifyIC + return(IC0) + } } } - mc$risk <- if(type(risk)==".MBRE") asMSE() else asBias() - mc$neighbor <- ContNeighborhood(radius=0.5) return(do.call(getStartIC, as.list(mc[-1]), envir=parent.frame(2))) }) Modified: branches/robast-0.9/pkg/RobExtremes/R/internal-getpsi.R =================================================================== --- branches/robast-0.9/pkg/RobExtremes/R/internal-getpsi.R 2013-03-13 09:52:00 UTC (rev 629) +++ branches/robast-0.9/pkg/RobExtremes/R/internal-getpsi.R 2013-03-13 13:33:37 UTC (rev 630) @@ -1,3 +1,7 @@ +.is.na.Psi <- function(param, fct, nam){ + xi <- main(param)[nam] + return(is.na(fct[[1]](xi))) +} .getPsi <- function(param, fct, L2Fam , type){ scshnm <- scaleshapename(L2Fam) Modified: branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/SnTest.Rdata =================================================================== (Binary files differ) Modified: branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/Snplot.pdf =================================================================== (Binary files differ) Modified: branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/checkSn.R =================================================================== --- branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/checkSn.R 2013-03-13 09:52:00 UTC (rev 629) +++ branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/checkSn.R 2013-03-13 13:33:37 UTC (rev 630) @@ -29,10 +29,24 @@ S3g <- sapply(xig, gSn, Gammad) S4g <- sapply(xig, gSn, Weibull) }) +## +# user system elapsed +# 2.31 0.00 2.32 +# system.time({S1ga <- sapply(xig, gSna, GPareto) S2ga <- sapply(xig, gSna, GEV) S3ga <- sapply(xig, gSna, Gammad) S4ga <- sapply(xig, gSna, Weibull)}) +## +# user system elapsed +# 966.03 0.83 979.77 +# +setwd("C:/rtest/RobASt/branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation") +# +save(S1g, S1ga, S2g, S2ga, S3g, S3ga, S4g, S4ga, file="SnTest.Rdata") +# +# +pdf("Snplot.pdf") par(mfrow=c(2,2)) plot(xig, S1g, type="l") lines(xig, S1ga, col="red") @@ -43,3 +57,4 @@ plot(xig, S4g, type="l") lines(xig, S4ga, col="red") par(mfrow=c(1,1)) +dev.off() Modified: branches/robast-0.9/pkg/RobExtremes/man/internal-interpolate.Rd =================================================================== --- branches/robast-0.9/pkg/RobExtremes/man/internal-interpolate.Rd 2013-03-13 09:52:00 UTC (rev 629) +++ branches/robast-0.9/pkg/RobExtremes/man/internal-interpolate.Rd 2013-03-13 13:33:37 UTC (rev 630) @@ -6,6 +6,7 @@ \alias{.MBRE.xi} \alias{.getLMGrid} \alias{.getPsi} +\alias{.is.na.Psi} \alias{.svInt} \alias{.generateInterpGridSn} @@ -20,6 +21,8 @@ \usage{ .getPsi(param, fct, L2Fam , type) +.is.na.Psi(param, fct, nam = "shape") + .modify.xi.PFam.call(xi, PFam) .RMXE.xi(xi, PFam) @@ -43,6 +46,7 @@ at which to evaluate the Lagrange multipliers or LDEstimators; in our use case, it is a shape-scale model, hence the respective (main) parameter must contain \code{"scale"} and \code{"shape"}. } + \item{nam}{character; name of the shape parameter. } \item{type}{type of the optimality: one of ".OMSE" for maxMSE, ".RMXE" for rmx, and ".MBRE" for MBRE. } \item{xi}{numeric of length 1; shape value. } @@ -62,6 +66,11 @@ from an object from \file{sysdata.rda} and generates a respective \code{HampelIC} object by a call to \code{generateIC}. + \code{.is.na.Psi} checks whether the shape parameter already lies + beyond the range for which inter-/extrapolation is admitted + (and, correspondingly, returns \code{TRUE} if one has to compute the + IC completely anew.). + \code{.MBRE.xi} computes the Lagrange multipliers for the MBRE estimator, \code{.OMSE.xi} for the OMSE estimator at radius \code{r=0.5}, and \code{.RMXE.xi} the RMXE estimator. @@ -83,7 +92,8 @@ version. } \value{ - \item{.getpsi}{an IC.} + \item{.getpsi}{an IC. } + \item{.is.na.Psi}{logical of length 1. } \item{.modify.xi.PFam.call}{A call to evaluate the parametric family at the new parameter value. } \item{.MBRE.xi}{A list with items \code{b} (a number; clipping height), @@ -101,12 +111,5 @@ \item{.svInt}{ \code{invisible(NULL)}} } \seealso{\code{\link{interpolateSn}}} -\examples{ -\dontrun{ -### code to produce grid for GPareto: - .saveInterpGrid(sysRdaFolder = "C:/rtest/RobASt/branches/RobASt-0.9/pkg/RobExtremes/R", - accuracy = 800) -} -} \keyword{internal} \concept{utilities} From noreply at r-forge.r-project.org Wed Mar 13 17:31:08 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 13 Mar 2013 17:31:08 +0100 (CET) Subject: [Robast-commits] r631 - in branches/robast-0.9/pkg: RobAStRDA/R RobExtremes/R RobExtremes/man RobExtremesBuffer Message-ID: <20130313163108.DDC2D18443A@r-forge.r-project.org> Author: ruckdeschel Date: 2013-03-13 17:31:08 +0100 (Wed, 13 Mar 2013) New Revision: 631 Added: branches/robast-0.9/pkg/RobExtremesBuffer/interpolRMXEGammafamily.csv branches/robast-0.9/pkg/RobExtremesBuffer/interpolRMXEGammafamily.txt branches/robast-0.9/pkg/RobExtremesBuffer/interpolRMXEWeibullFamily.csv branches/robast-0.9/pkg/RobExtremesBuffer/interpolRMXEWeibullFamily.txt Modified: branches/robast-0.9/pkg/RobAStRDA/R/sysdata.rda branches/robast-0.9/pkg/RobExtremes/R/internal-getpsi.R branches/robast-0.9/pkg/RobExtremes/R/interpolLM.R branches/robast-0.9/pkg/RobExtremes/man/internal-interpolate.Rd Log: included further grids; fixed some small inconsistencies between code and documentation Modified: branches/robast-0.9/pkg/RobAStRDA/R/sysdata.rda =================================================================== (Binary files differ) Modified: branches/robast-0.9/pkg/RobExtremes/R/internal-getpsi.R =================================================================== --- branches/robast-0.9/pkg/RobExtremes/R/internal-getpsi.R 2013-03-13 13:33:37 UTC (rev 630) +++ branches/robast-0.9/pkg/RobExtremes/R/internal-getpsi.R 2013-03-13 16:31:08 UTC (rev 631) @@ -1,4 +1,4 @@ -.is.na.Psi <- function(param, fct, nam){ +.is.na.Psi <- function(param, fct, nam = "shape"){ xi <- main(param)[nam] return(is.na(fct[[1]](xi))) } Modified: branches/robast-0.9/pkg/RobExtremes/R/interpolLM.R =================================================================== --- branches/robast-0.9/pkg/RobExtremes/R/interpolLM.R 2013-03-13 13:33:37 UTC (rev 630) +++ branches/robast-0.9/pkg/RobExtremes/R/interpolLM.R 2013-03-13 16:31:08 UTC (rev 631) @@ -11,12 +11,16 @@ return(nModel) } -.RMXE.xi <- function(xi, PFam) ROptEst:::.RMXE.th(xi, PFam, .modify.xi.PFam.call) -.MBRE.xi <- function(xi, PFam) ROptEst:::.MBRE.th(xi, PFam, .modify.xi.PFam.call) -.OMSE.xi <- function(xi, PFam) ROptEst:::.OMSE.th(xi, PFam, .modify.xi.PFam.call) +.RMXE.th <- ROptEst:::.RMXE.th +.MBRE.th <- ROptEst:::.MBRE.th +.OMSE.th <- ROptEst:::.OMSE.th +.RMXE.xi <- function(xi, PFam) .RMXE.th(xi, PFam, .modify.xi.PFam.call) +.MBRE.xi <- function(xi, PFam) .MBRE.th(xi, PFam, .modify.xi.PFam.call) +.OMSE.xi <- function(xi, PFam) .OMSE.th(xi, PFam, .modify.xi.PFam.call) + .getLMGrid <- function(xiGrid = getShapeGrid(), PFam = GParetoFamily(scale=1,shape=2), optFct = .RMXE.xi, GridFileName="LMGrid.Rdata", Modified: branches/robast-0.9/pkg/RobExtremes/man/internal-interpolate.Rd =================================================================== --- branches/robast-0.9/pkg/RobExtremes/man/internal-interpolate.Rd 2013-03-13 13:33:37 UTC (rev 630) +++ branches/robast-0.9/pkg/RobExtremes/man/internal-interpolate.Rd 2013-03-13 16:31:08 UTC (rev 631) @@ -32,7 +32,7 @@ .getLMGrid(xiGrid = getShapeGrid(), PFam = GParetoFamily(scale=1,shape=2), optFct = .RMXE.xi, GridFileName="LMGrid.Rdata", withPrint = FALSE) -.svInt(optF = .RMXE.xi, xiGrid = getShapeGrid(500, cutoff.at.0=0.005), +.svInt(optF = .RMXE.th, xiGrid = getShapeGrid(500, cutoff.at.0=0.005), PFam = GParetoFamily(shape=1,scale=2)) .generateInterpGridSn(xiGrid = getShapeGrid(500, cutoff.at.0=0.005), Added: branches/robast-0.9/pkg/RobExtremesBuffer/interpolRMXEGammafamily.csv =================================================================== --- branches/robast-0.9/pkg/RobExtremesBuffer/interpolRMXEGammafamily.csv (rev 0) +++ branches/robast-0.9/pkg/RobExtremesBuffer/interpolRMXEGammafamily.csv 2013-03-13 16:31:08 UTC (rev 631) @@ -0,0 +1,496 @@ +" 3.98406374501992024961e-02" " 4.90621395856920025835e+03" "-3.98398313356505967553e-02" "-3.48882163125406033130e-03" "-3.98398876049943853617e-02" " 3.06352929382583509532e-02" " 1.00000000000000000000e+00" " 8.75711967348501152397e-02" "-2.90319538573563761074e-08" "-4.46233044040541911273e-11" " 1.00000000000000000000e+00" " 8.75740784383949311120e-02" "-3.30122362061888898291e-08" " 2.56855752674618789588e-09" +" 4.27829746040001568375e-02" " 2.77339001383300546877e+03" "-4.27827479086906187211e-02" " 2.02671172511600765354e-03" "-4.27825299988003338036e-02" " 9.43577965186521705476e-02" " 1.00000000000000000000e+00" "-4.73721731215045460672e-02" "-9.48617519369253703530e-09" " 2.85879222752357087970e-10" " 1.00000000000000000000e+00" "-4.73735907828344363080e-02" "-1.75385915318706266801e-08" "-5.05135549671046610339e-10" +" 6.40397156295258174197e-02" " 2.05682263133413130163e+02" "-3.88965423504291902645e+03" " 2.45112489149905882213e-01" "-6.30025217881828442090e-02" "-3.86339718020805422682e+00" " 6.19984987381872997503e+04" "-4.24691839211229815731e+00" "-4.24691839211228838735e+00" " 5.81200387395273791735e-03" " 6.19984987383544939803e+04" "-4.24691839288920025552e+00" "-4.24691839288920469642e+00" " 5.81200387509930686825e-03" +" 7.96812749003984049923e-02" " 6.72268075728239722366e+01" "-1.80121947851000709306e+03" " 2.11987986634972452871e-01" "-7.81818155221196964266e-02" "-3.48514534925823182832e+00" " 2.31812410633738727483e+04" "-3.19413762146860769064e+00" "-3.19413762146861301972e+00" " 1.08275230538157664351e-02" " 2.31812410629163568956e+04" "-3.19413762323368244367e+00" "-3.19413762323368510820e+00" " 1.08275230610317321073e-02" +" 8.52248570399394278496e-02" " 5.07169591178862830816e+01" "-1.43653923414538985526e+03" " 2.13063931309316889617e-01" "-8.35118175197413076249e-02" "-3.28032044669606026588e+00" " 1.73225222154081166082e+04" "-3.07777251008097074703e+00" "-3.07777251008095653617e+00" " 1.34030944847253127850e-02" " 1.73225222151754278457e+04" "-3.07777251219303682461e+00" "-3.07777251219303327190e+00" " 1.34030944946877117463e-02" +" 1.27391651478953704668e-01" " 2.96753487178572719074e+01" "-2.10079424287011784500e+00" " 1.44060333422147551774e-02" "-5.09710771095033821076e-02" "-2.78969413009521161051e-01" " 4.33632757335164527035e+01" "-3.92439540519312901612e-01" "-3.92439540519312624056e-01" " 2.00632487908332796112e-02" " 4.33632757336551790672e+01" "-3.92439540525005514660e-01" "-3.92439540525005625682e-01" " 2.00632487911301012062e-02" +" 1.48378817222630354777e-01" " 1.72291415671812906396e+01" "-1.25887828261861001167e+00" " 1.27017451719757361317e-02" "-4.83611511473088090396e-02" "-2.09242595387069713064e-01" " 2.76808224718652127194e+01" "-3.81366694010405293813e-01" "-3.81366694010405127280e-01" " 2.74398581867459183392e-02" " 2.76808224733631504932e+01" "-3.81366694324291599649e-01" "-3.81366694324291544138e-01" " 2.74398582111639657843e-02" +" 1.59362549800796809985e-01" " 1.38245575997927403478e+01" "-1.16842998408291376400e+00" " 1.34289692301170996563e-02" "-5.07738199520109678708e-02" "-2.08200748875255525761e-01" " 2.46350291449022655854e+01" "-3.95697665793361019748e-01" "-3.95697665793361574860e-01" " 3.19985053639839853168e-02" " 2.46350291449924618803e+01" "-3.95697666261176417279e-01" "-3.95697666261176139724e-01" " 3.19985054078759725837e-02" +" 1.69305414639138729349e-01" " 1.18891334158162926826e+01" "-1.11358229430997623943e+00" " 1.42908371665171653186e-02" "-5.32368895354910498519e-02" "-2.07682756497228865333e-01" " 2.25206748037440895871e+01" "-4.10955558867496906217e-01" "-4.10955558867497017239e-01" " 3.65324414315767731498e-02" " 2.25206748055165775213e+01" "-4.10955564334707479368e-01" "-4.10955564334707423857e-01" " 3.65324420022630838578e-02" +" 1.90174070534208650152e-01" " 9.35435291050879769159e+00" "-1.08044960647291032885e+00" " 1.71671384806164131764e-02" "-5.98100809859383186762e-02" "-2.09544832717630524765e-01" " 1.96535987973863406353e+01" "-4.53524565534020818180e-01" "-4.53524565534020818180e-01" " 4.75230152694982657668e-02" " 1.96535987982444630973e+01" "-4.53524568120423576811e-01" "-4.53524568120423965389e-01" " 4.75230155933428211057e-02" +" 1.99203187250996005542e-01" " 8.63177367625432268028e+00" "-1.08054671796164725173e+00" " 1.87927545013368245408e-02" "-6.28646795703065031091e-02" "-2.09284898719088674479e-01" " 1.87704999505429412920e+01" "-4.75212246377592795188e-01" "-4.75212246377592462121e-01" " 5.29484455827157751706e-02" " 1.87704999496209978815e+01" "-4.75212257046725816689e-01" "-4.75212257046725705667e-01" " 5.29484470417686328703e-02" +" 2.10987364747485084404e-01" " 7.89495280190292003653e+00" "-1.08272478205156308384e+00" " 2.11836801057954590699e-02" "-6.67670223980379312634e-02" "-2.07074582118045746881e-01" " 1.77840079083737592214e+01" "-5.05424037060227759888e-01" "-5.05424037060227759888e-01" " 6.06640117311829374369e-02" " 1.77840079030211697386e+01" "-5.05424065584550885610e-01" "-5.05424065584550996633e-01" " 6.06640160118639762410e-02" +" 2.31747832682678900351e-01" " 6.96549222277173729623e+00" "-1.08591756380680770633e+00" " 2.60834796181453471009e-02" "-7.32297186570396441141e-02" "-1.99064211340391761240e-01" " 1.63595138795921002384e+01" "-5.63059676686684662528e-01" "-5.63059676686684218438e-01" " 7.61021514315752406477e-02" " 1.63595138741083871992e+01" "-5.63059739784063206791e-01" "-5.63059739784063206791e-01" " 7.61021622846069084600e-02" +" 2.39043824701195228855e-01" " 6.71506661529819393053e+00" "-1.08576715067830820161e+00" " 2.79969044308939693511e-02" "-7.53403435448455616186e-02" "-1.95257779063286618371e-01" " 1.59261001702726918694e+01" "-5.84410515463077873122e-01" "-5.84410515463077762099e-01" " 8.21108066738150538244e-02" " 1.59261001692334467350e+01" "-5.84410605503606017663e-01" "-5.84410605503606128686e-01" " 8.21108228805550455220e-02" +" 2.52457967740567557069e-01" " 6.32642657113665052293e+00" "-1.08397842573306935066e+00" " 3.17732846859549028506e-02" "-7.90144085020081793358e-02" "-1.87370026516965326735e-01" " 1.52008296302938550326e+01" "-6.24999307202349418944e-01" "-6.24999307202349640988e-01" " 9.39886973689473964599e-02" " 1.52008296276431966731e+01" "-6.24999316681954852903e-01" "-6.24999316681954852903e-01" " 9.39886991771231306014e-02" +" 2.73120223661343919375e-01" " 5.86054565723505760388e+00" "-1.07675174270105000751e+00" " 3.81790850778755547212e-02" "-8.41212093369636537687e-02" "-1.73792093971795569285e-01" " 1.42262411311552376958e+01" "-6.90347049616827357355e-01" "-6.90347049616827579399e-01" " 1.14468590467747780015e-01" " 1.42262411234869823318e+01" "-6.90347105233546254333e-01" "-6.90347105233546587399e-01" " 1.14468602710095707087e-01" +" 2.78884462151394396656e-01" " 5.75201442976995913625e+00" "-1.07384329157713631631e+00" " 4.00865280093648940207e-02" "-8.54246826170494133468e-02" "-1.69804332612700781269e-01" " 1.39802344732038328345e+01" "-7.09132626306257951576e-01" "-7.09132626306257951576e-01" " 1.20673544336714164138e-01" " 1.39802344542978502773e+01" "-7.09132704430280425001e-01" "-7.09132704430280758068e-01" " 1.20673562145531557133e-01" +" 2.93737016782436521911e-01" " 5.50534112444137679887e+00" "-1.06572504878006601992e+00" " 4.52612103966269635480e-02" "-8.86030467341802491221e-02" "-1.59477892528903819613e-01" " 1.33936479646754271755e+01" "-7.58681651055657990668e-01" "-7.58681651055658212712e-01" " 1.37701047548081295657e-01" " 1.33936479277400888321e+01" "-7.58681807696590437828e-01" "-7.58681807696590104761e-01" " 1.37701086086997576130e-01" +" 3.14310728217555401809e-01" " 5.22477380526114121295e+00" "-1.05298017077551087084e+00" " 5.30158869259773554705e-02" "-9.25685204623956092718e-02" "-1.45223938573746907954e-01" " 1.26769234468276064121e+01" "-8.29779620191396283246e-01" "-8.29779620191396172224e-01" " 1.63854310710746464697e-01" " 1.26769234210548660258e+01" "-8.29779729552313161101e-01" "-8.29779729552313383145e-01" " 1.63854340444833990187e-01" +" 3.18725099601593619969e-01" " 5.17218637572680872694e+00" "-1.05019061246653921948e+00" " 5.47708386044076511734e-02" "-9.33585144321179977167e-02" "-1.42217717247687863713e-01" " 1.25369223268961960116e+01" "-8.45448920311356100221e-01" "-8.45448920311356322266e-01" " 1.69873322441044971587e-01" " 1.25369222925830108295e+01" "-8.45449054320367321402e-01" "-8.45449054320367432425e-01" " 1.69873359709633325876e-01" +" 3.34843705962408810795e-01" " 4.99714603743972851646e+00" "-1.03942183676188659724e+00" " 6.14194816189008729879e-02" "-9.60728160553424026524e-02" "-1.31417153903528205472e-01" " 1.20548996619445567546e+01" "-9.03430741680765647672e-01" "-9.03430741680765647672e-01" " 1.93092141431868896673e-01" " 1.20548995832204681733e+01" "-9.03430956940520446530e-01" "-9.03430956940520002441e-01" " 1.93092206312747122210e-01" +" 3.55338266932213375782e-01" " 4.80848835212702141462e+00" "-1.02605290996380937862e+00" " 7.04801133608707330858e-02" "-9.91827372154317349340e-02" "-1.18260756727604263161e-01" " 1.15130985252428459376e+01" "-9.79595474229698837121e-01" "-9.79595474229698282009e-01" " 2.25593223237249007607e-01" " 1.15130984763053323405e+01" "-9.79595608028816067225e-01" "-9.79595608028815734158e-01" " 2.25593267274345143925e-01" +" 3.58565737051792843282e-01" " 4.78112549325510460818e+00" "-1.02389870315559328162e+00" " 7.19371880834948490557e-02" "-9.96629971743636933201e-02" "-1.16317689032301482821e-01" " 1.14306271121750082642e+01" "-9.91352564531411184490e-01" "-9.91352564531411406534e-01" " 2.30953255630966414191e-01" " 1.14306271204852514245e+01" "-9.91352766172546640000e-01" "-9.91352766172546417955e-01" " 2.30953320590581961946e-01" +" 3.75796698935874085024e-01" " 4.64956383679932816477e+00" "-1.01321446630502731701e+00" " 8.01777225846822122479e-02" "-1.01940327943174410819e-01" "-1.05872647176156062243e-01" " 1.10382258775968953302e+01" "-1.05811901404796704362e+00" "-1.05811901404796748771e+00" " 2.61514395993658776973e-01" " 1.10382258049259363020e+01" "-1.05811933747618946988e+00" "-1.05811933747618946988e+00" " 2.61514511079505851399e-01" +" 3.96221262591437028977e-01" " 4.51425437257312456296e+00" "-1.00145376905422378577e+00" " 9.05591220616228792517e-02" "-1.04389412157229563571e-01" "-9.41929758580785925215e-02" " 1.06213535915269705612e+01" "-1.13918324300928874848e+00" "-1.13918324300928874848e+00" " 3.01078568713512462196e-01" " 1.06213534354423462247e+01" "-1.13918359103034960711e+00" "-1.13918359103034960711e+00" " 3.01078704650452000369e-01" +" 3.98406374501992011083e-01" " 4.50098104934506348940e+00" "-1.00018392527484145660e+00" " 9.16962930064360443039e-02" "-1.04632791046878781405e-01" "-9.30129894443291194150e-02" " 1.05794649164347038806e+01" "-1.14795774722938115353e+00" "-1.14795774722938070944e+00" " 3.05523618145975284222e-01" " 1.05794647693845824676e+01" "-1.14795812071552494338e+00" "-1.14795812071552472133e+00" " 3.05523764749996928902e-01" +" 4.16614193187194392642e-01" " 4.39783090409609300764e+00" "-9.90665637499441920077e-01" " 1.01572907905533194040e-01" "-1.06555722365235860938e-01" "-8.33127678235265622941e-02" " 1.02530096537468153883e+01" "-1.22251632888563843693e+00" "-1.22251632888563843693e+00" " 3.44403602347700621422e-01" " 1.02530096826727810111e+01" "-1.22251624519936030744e+00" "-1.22251624519936030744e+00" " 3.44403567548464961678e-01" +" 4.36977702492617525731e-01" " 4.29889641802759303602e+00" "-9.84362305953593308416e-01" " 1.13637919295537570541e-01" "-1.08601616499385503212e-01" "-7.31989109012433913914e-02" " 9.94738184333072972265e+00" "-1.31066734592466915821e+00" "-1.31066734592466893616e+00" " 3.92118160244477598209e-01" " 9.94738209339225143424e+00" "-1.31066767570110087604e+00" "-1.31066767570110109808e+00" " 3.92118293926930150395e-01" +" 4.38247011952191289907e-01" " 4.29117899858109819178e+00" "-9.80291198571826338792e-01" " 1.13983864326219166974e-01" "-1.08566149169378761696e-01" "-7.24952238994421016560e-02" " 9.90653311208549602895e+00" "-1.31350626303490458646e+00" "-1.31350626303490480851e+00" " 3.94762532360405482557e-01" " 9.90653297934499832422e+00" "-1.31350656100605278631e+00" "-1.31350656100605278631e+00" " 3.94762668257430671126e-01" +" 4.57313980523084140373e-01" " 4.20941204973802562961e+00" "-9.71635550909273115749e-01" " 1.25475480593730481793e-01" "-1.10081959979550711437e-01" "-6.35686515214207992219e-02" " 9.63242247373047533188e+00" "-1.39566429311591000406e+00" "-1.39566429311591022611e+00" " 4.43015928477170528588e-01" " 9.63242229837331898068e+00" "-1.39566469099541068388e+00" "-1.39566469099541068388e+00" " 4.43016121025793574439e-01" +" 4.77625197262214196137e-01" " 4.13308304283456973138e+00" "-9.63966462730627138278e-01" " 1.38423974783638353836e-01" "-1.11524807841622303206e-01" "-5.46555956039045318096e-02" " 9.37155933257174034168e+00" "-1.48557275137942323973e+00" "-1.48557275137942346177e+00" " 4.98652543080654320207e-01" " 9.37155893408415607837e+00" "-1.48557318588149311900e+00" "-1.48557318588149311900e+00" " 4.98652782752878609429e-01" +" 4.78087649402390457709e-01" " 4.13142928417032528898e+00" "-9.63709019306507985725e-01" " 1.38709319123140550900e-01" "-1.11550685759254197826e-01" "-5.44662666078049514939e-02" " 9.36553403005023099581e+00" "-1.48757559499542879600e+00" "-1.48757559499542857395e+00" " 4.99954503750551726426e-01" " 9.36553373443547698685e+00" "-1.48757613038184843823e+00" "-1.48757613038184821619e+00" " 4.99954786351073932060e-01" +" 4.97913504345446511490e-01" " 4.06669048160863777497e+00" "-9.56684807907798195892e-01" " 1.51886948883400707544e-01" "-1.12730903983279631686e-01" "-4.63512909098483388837e-02" " 9.13485543914094755280e+00" "-1.57699345576712768313e+00" "-1.57699345576712746109e+00" " 5.58535956621527773791e-01" " 9.13485519689517566633e+00" "-1.57699390033920483489e+00" "-1.57699390033920505694e+00" " 5.58536206556233261189e-01" +" 5.17928286852589625511e-01" " 4.00934449510702073383e+00" "-9.49896971725854744051e-01" " 1.65751745759292551385e-01" "-1.13670509842189890182e-01" "-3.85933062475358884535e-02" " 8.92338864744120385808e+00" "-1.66943863784179336029e+00" "-1.66943863784179291621e+00" " 6.22235778115671434030e-01" " 8.92338843829025663013e+00" "-1.66943893377742891282e+00" "-1.66943893377742846873e+00" " 6.22235958022452684268e-01" +" 5.18181036708362463550e-01" " 4.00860675656782650123e+00" "-9.49964522081156004241e-01" " 1.65955550698083292849e-01" "-1.13690541671239514487e-01" "-3.85025446644413557595e-02" " 8.92151647789144064404e+00" "-1.67073408625889596735e+00" "-1.67073408625889618939e+00" " 6.23102968478536967112e-01" " 8.92151627759882970281e+00" "-1.67073441538683598040e+00" "-1.67073441538683553631e+00" " 6.23103166179669099023e-01" +" 5.38429914203115922433e-01" " 3.95794233169146281170e+00" "-9.44395340576035136060e-01" " 1.80646520109733754733e-01" "-1.14494193201577040830e-01" "-3.11859758963740976712e-02" " 8.72953167588008049904e+00" "-1.76634960893736936427e+00" "-1.76634960893736914223e+00" " 6.92303846898944863497e-01" " 8.72953140386906412118e+00" "-1.76635001843650774056e+00" "-1.76635001843650774056e+00" " 6.92304110750319945389e-01" +" 5.57768924302788793312e-01" " 3.91648983785840965055e+00" "-9.41058966688380960086e-01" " 1.95487197689593023009e-01" "-1.15160341886849287851e-01" "-2.46324648723614397783e-02" " 8.56974451115511293153e+00" "-1.86078576302482412430e+00" "-1.86078576302482368021e+00" " 7.63279889717014548012e-01" " 8.56974427667291926980e+00" "-1.86078606752639852395e+00" "-1.86078606752639830191e+00" " 7.63280100769813452111e-01" +" 5.58662243186231033398e-01" " 3.91408100800339253666e+00" "-9.39040863877215636890e-01" " 1.95833270230526823585e-01" "-1.15075829779874377889e-01" "-2.42844862062294927774e-02" " 8.55344181401025416278e+00" "-1.86347483071449770975e+00" "-1.86347483071449793179e+00" " 7.66231575319177848904e-01" " 8.55344137855323616293e+00" "-1.86347529074023920970e+00" "-1.86347529074023854356e+00" " 7.66231905091654286188e-01" +" 5.78880118080907335454e-01" " 3.87657506987037026036e+00" "-9.33699341433012142133e-01" " 2.11416698300612687644e-01" "-1.15456618955476930655e-01" "-1.78294579539171257898e-02" " 8.38993582949059124587e+00" "-1.96160076242107983546e+00" "-1.96160076242107961342e+00" " 8.44838489596977715301e-01" " 8.38993560328591314601e+00" "-1.96160117033801428832e+00" "-1.96160117033801428832e+00" " 8.44838780451547810557e-01" +" 5.97609561752988072136e-01" " 3.84665546154386950306e+00" "-9.29250167544056648872e-01" " 2.26317111582505059442e-01" "-1.15655748710939101920e-01" "-1.21840472041631481259e-02" " 8.25100127663736060413e+00" "-2.05396115022494463176e+00" "-2.05396115022494418767e+00" " 9.22127340468199108159e-01" " 8.25100104703985159915e+00" "-2.05396142309221430011e+00" "-2.05396142309221385602e+00" " 9.22127554606496424583e-01" +" 5.99085622916895488288e-01" " 3.84406247319487448522e+00" "-9.29829768250297949983e-01" " 2.27734340534437862402e-01" "-1.15719783739764908725e-01" "-1.17447732581017847547e-02" " 8.24448768119800057264e+00" "-2.06224208236337869238e+00" "-2.06224208236337869238e+00" " 9.28737089296587714493e-01" " 8.24448743828682850676e+00" "-2.06224236232662283541e+00" "-2.06224236232662372359e+00" " 9.28737310570141971766e-01" +" 6.19280832850907736464e-01" " 3.81726552156687493067e+00" "-9.24547336500839644913e-01" " 2.44074292962971978183e-01" "-1.15705799343177997973e-01" "-6.02682125942180860201e-03" " 8.10313590439545983202e+00" "-2.16241352525964458664e+00" "-2.16241352525964458664e+00" " 1.01702429690363893577e+00" " 8.10313566541569940682e+00" "-2.16241384131665093093e+00" "-2.16241384131665093093e+00" " 1.01702455637598321303e+00" +" 6.37450199203187239938e-01" " 3.79640985982614020955e+00" "-9.20234614652012838931e-01" " 2.59170465728247756410e-01" "-1.15574919750923016393e-01" "-1.16362474780779901265e-03" " 7.98492335362636485030e+00" "-2.25352922393079291297e+00" "-2.25352922393079291297e+00" " 1.10080806186126212154e+00" " 7.98492295453725819954e+00" "-2.25352947798902381038e+00" "-2.25352947798902381038e+00" " 1.10080830826455766669e+00" +" 6.39467815670481498636e-01" " 3.79554442468505204289e+00" "-9.22115993113791221347e-01" " 2.61772976939132095975e-01" "-1.15606480482893264616e-01" "-4.17699394609866050780e-04" " 7.98453063305361787627e+00" "-2.26836564295094778032e+00" "-2.26836564295094822441e+00" " 1.11255593164693866726e+00" " 7.98453030752884629351e+00" "-2.26836597483595303615e+00" "-2.26836597483595348024e+00" " 1.11255622928670727667e+00" +" 6.59648633284134366939e-01" " 3.77620815298916534530e+00" "-9.16456792450311086284e-01" " 2.78379313872675948627e-01" "-1.15303462358790187459e-01" " 4.42625474298496707909e-03" " 7.85731736800764668516e+00" "-2.36789095812971117638e+00" "-2.36789095812971028820e+00" " 1.20945853977665640500e+00" " 7.85731701600971543797e+00" "-2.36789131602546332189e+00" "-2.36789131602546287780e+00" " 1.20945887840670529556e+00" +" 6.77290836653386407740e-01" " 3.76329681926711856477e+00" "-9.13089693347079789376e-01" " 2.93811590657579169150e-01" "-1.14937176700903656568e-01" " 8.61856310243926636294e-03" " 7.75987709012370707740e+00" "-2.45879999582988162388e+00" "-2.45879999582988206797e+00" " 1.29999612012668097627e+00" " 7.75987692760913905232e+00" "-2.45880015672653051695e+00" "-2.45880015672653096104e+00" " 1.29999627960196995069e+00" +" 6.79825343200614606864e-01" " 3.76167480320319080889e+00" "-9.12623520225617990143e-01" " 2.96050386458269532142e-01" "-1.14876501301879138661e-01" " 9.20135194013220990283e-03" " 7.74639242478624812094e+00" "-2.47192462084049280335e+00" "-2.47192462084049324744e+00" " 1.31333166570341974833e+00" " 7.74639203429445277749e+00" "-2.47192501563611344295e+00" "-2.47192501563611388704e+00" " 1.31333205928397789286e+00" +" 6.99999999999999955591e-01" " 3.75089560471720506740e+00" "-9.08712555708308999947e-01" " 3.13970019589331794663e-01" "-1.14290700263639855017e-01" " 1.37064665842055437989e-02" " 7.64189183689192041982e+00" "-2.57654825419595656655e+00" "-2.57654825419595656655e+00" " 1.42229221647755621483e+00" " 7.64189146051255097092e+00" "-2.57654860912651129112e+00" "-2.57654860912651173521e+00" " 1.42229259281441455798e+00" +" 7.17131474103585686564e-01" " 3.74386453490675386035e+00" "-9.05420947694479338885e-01" " 3.29357921672626730025e-01" "-1.13692134329401117743e-01" " 1.73433363153605961393e-02" " 7.55721619564925362056e+00" "-2.66528274841087808866e+00" "-2.66528274841087808866e+00" " 1.51852558801177361936e+00" " 7.55721592824399834853e+00" "-2.66528302130670402548e+00" "-2.66528302130670402548e+00" " 1.51852588478241878889e+00" +" 7.20174656799385304318e-01" " 3.74335604960708767663e+00" "-9.05334217466885027292e-01" " 3.32295806658657266741e-01" "-1.13604786814814021079e-01" " 1.79304015434713324983e-02" " 7.54577610500580142627e+00" "-2.68247830907940709722e+00" "-2.68247830907940665313e+00" " 1.53669347062261985037e+00" " 7.54577563225161807026e+00" "-2.68247871063794907087e+00" "-2.68247871063794907087e+00" " 1.53669392747428146251e+00" +" 7.40351366715865544244e-01" " 3.73901078892412952470e+00" "-9.01245401872131868259e-01" " 3.50614612608619480305e-01" "-1.12735917194449336565e-01" " 2.19683738326071006930e-02" " 7.45112934589635500515e+00" "-2.78743821232844446456e+00" "-2.78743821232844490865e+00" " 1.65557549210550325469e+00" " 7.45112890643685865655e+00" "-2.78743856274999579625e+00" "-2.78743856274999535216e+00" " 1.65557591623269151349e+00" +" 7.56972111553784854365e-01" " 3.73783991211515598252e+00" "-8.98075223096425512281e-01" " 3.65872856062326945459e-01" "-1.11960796604026441292e-01" " 2.50126113979936455511e-02" " 7.37901340053540177877e+00" "-2.87515020042987012872e+00" "-2.87515020042987012872e+00" " 1.75786159842763423100e+00" " 7.37901376456892066358e+00" "-2.87515012353309717952e+00" "-2.87515012353309717952e+00" " 1.75786143800763716705e+00" +" 7.60532184329518412547e-01" " 3.73774529305881131336e+00" "-8.97358914260230955406e-01" " 3.69135938373024274917e-01" "-1.11782293210477501333e-01" " 2.56537204359283226018e-02" " 7.36363002159114188316e+00" "-2.89374966894266849593e+00" "-2.89374966894266894002e+00" " 1.78009422663424721200e+00" " 7.36362971411521627374e+00" "-2.89374998898586044405e+00" "-2.89374998898586044405e+00" " 1.78009461013869163537e+00" +" 7.80719167149092174718e-01" " 3.73920515568297151532e+00" "-8.93580128437514997763e-01" " 3.87868272405095970701e-01" "-1.10717190480526306295e-01" " 2.91668605181140232208e-02" " 7.28048183102070911588e+00" "-3.00017273584170629519e+00" "-3.00017273584170585110e+00" " 1.90962034182485385081e+00" " 7.28048155645383054946e+00" "-3.00017293702616694162e+00" "-3.00017293702616738571e+00" " 1.90962061517085057716e+00" +" 7.96812749003984022167e-01" " 3.74215994992092948479e+00" "-8.90513859482163772086e-01" " 4.02870293439692939153e-01" "-1.09792529099786095870e-01" " 3.18167535922433616924e-02" " 7.21686839193136009385e+00" "-3.08502864184071068365e+00" "-3.08502864184071023956e+00" " 2.01646256940132717617e+00" " 7.21686787232589033181e+00" "-3.08502898752039911301e+00" "-3.08502898752039955710e+00" " 2.01646306946039377550e+00" +" 8.00914377083104422894e-01" " 3.74318575527860675223e+00" "-8.89731531833003463916e-01" " 4.06700938079185947416e-01" "-1.09547940252035069797e-01" " 3.24677600080431963403e-02" " 7.20109034208252296594e+00" "-3.10667831424185925115e+00" "-3.10667831424185969524e+00" " 2.04420712312008578948e+00" " 7.20108982474549108588e+00" "-3.10667867223124805065e+00" "-3.10667867223124760656e+00" " 2.04420763990599985149e+00" +" 8.21119881919092575728e-01" " 3.74978051074245311014e+00" "-8.84968366970140474237e-01" " 4.25242841966119611286e-01" "-1.08216091396424254900e-01" " 3.56066670528910333982e-02" " 7.12115106733431080244e+00" "-3.21134278068315071053e+00" "-3.21134278068315115462e+00" " 2.18284767042016136784e+00" " 7.12115095705695289041e+00" "-3.21134306334145014361e+00" "-3.21134306334145014361e+00" " 2.18284800723850969106e+00" +" 8.36653386454183189969e-01" " 3.75626552917330336356e+00" "-8.83127895138310470280e-01" " 4.40375999873449497368e-01" "-1.07247653747857038531e-01" " 3.78813431322628096920e-02" " 7.07041937497533634627e+00" "-3.29560624761266085514e+00" "-3.29560624761265996696e+00" " 2.29479754808542235622e+00" " 7.07041908948655972722e+00" "-3.29560640253173131597e+00" "-3.29560640253173176006e+00" " 2.29479780942887678918e+00" +" 8.41337756813768877784e-01" " 3.75835805228160912961e+00" "-8.82338875400771383006e-01" " 4.44781649591912353614e-01" "-1.06958319940427995509e-01" " 3.84631292090882315193e-02" " 7.05515076957627318421e+00" "-3.32088907903343155681e+00" "-3.32088907903343155681e+00" " 2.32911312663623970565e+00" " 7.05515049213803191464e+00" "-3.32088922361999694388e+00" "-3.32088922361999649979e+00" " 2.32911337706562404648e+00" +" 8.61570085796883988749e-01" " 3.76963002136980396273e+00" "-8.77684522307474845881e-01" " 4.63417334526890323243e-01" "-1.05489675930593648778e-01" " 4.11535437930508132820e-02" " 6.98344578904267176966e+00" "-3.42627806786187028010e+00" "-3.42627806786187072419e+00" " 2.47805167887963717632e+00" " 6.98344554517769022794e+00" "-3.42627815048831196876e+00" "-3.42627815048831196876e+00" " 2.47805186849483938261e+00" +" 8.76494023904382579815e-01" " 3.77909135226671200058e+00" "-8.75028927002753809106e-01" " 4.77558969404785593760e-01" "-1.04430224692619672000e-01" " 4.30364794938045275297e-02" " 6.93465864636740292326e+00" "-3.50495520073717070630e+00" "-3.50495520073717026222e+00" " 2.59165694270973823166e+00" " 6.93465820755726358726e+00" "-3.50495548187783523275e+00" "-3.50495548187783523275e+00" " 2.59165743288664707222e+00" +" 8.81818963291637447632e-01" " 3.78257392795194835600e+00" "-8.73980753144620869932e-01" " 4.82562346162182076448e-01" "-1.04032148009350108864e-01" " 4.36953627268860944621e-02" " 6.91722834570849443026e+00" "-3.53279181446264667343e+00" "-3.53279181446264622934e+00" " 2.63273844681167457082e+00" " 6.91722804122732526366e+00" "-3.53279185582193777648e+00" "-3.53279185582193733239e+00" " 2.63273861005458309492e+00" +" 9.02086495654553344181e-01" " 3.79799898657566314952e+00" "-8.69927687117245440618e-01" " 5.01530091677151457219e-01" "-1.02449122719968116479e-01" " 4.60719467460025816630e-02" " 6.85456184719391803384e+00" "-3.63960775902319655373e+00" "-3.63960775902319655373e+00" " 2.79249162505953218982e+00" " 6.85456151369121347017e+00" "-3.63960793064785104178e+00" "-3.63960793064785104178e+00" " 2.79249196572672442329e+00" +" 9.16334661354581747617e-01" " 3.80968166965568411086e+00" "-8.67064678685501744049e-01" " 5.14757753393631944938e-01" "-1.01384326704223551308e-01" " 4.75614650796718704817e-02" " 6.81016287010839249660e+00" "-3.71352892761496988783e+00" "-3.71352892761496899965e+00" " 2.90706299866295569956e+00" " 6.81016254529629794234e+00" "-3.71352908224533662107e+00" "-3.71352908224533662107e+00" " 2.90706332472083062157e+00" +" 9.22374802737785715046e-01" " 3.81422503806725599063e+00" "-8.64725078231934451978e-01" " 5.19599980756672352733e-01" "-1.00877575170079933353e-01" " 4.81259089926378419433e-02" " 6.78701837458412082782e+00" "-3.74158335175526568506e+00" "-3.74158335175526568506e+00" " 2.95388017986651130187e+00" " 6.78701812678214455588e+00" "-3.74158350217303325991e+00" "-3.74158350217303325991e+00" " 2.95388047261970143609e+00" +" 9.42686019476915770809e-01" " 3.83401085914196571025e+00" "-8.62202361854551457832e-01" " 5.39563551936762419992e-01" "-9.92484481055325856724e-02" " 5.02688201255142089185e-02" " 6.73594261049710496536e+00" "-3.85269582579277036771e+00" "-3.85269582579276992362e+00" " 3.12697861895410689215e+00" " 6.73594225874305863044e+00" "-3.85269600465081918372e+00" "-3.85269600465082007190e+00" " 3.12697900656979310696e+00" +" 9.56175298804780915418e-01" " 3.84673544652245347208e+00" "-8.59584028621495077616e-01" " 5.52061450113386920080e-01" "-9.81818838207715177679e-02" " 5.15105313813915069443e-02" " 6.69725713721620508068e+00" "-3.92220112445492929965e+00" "-3.92220112445492929965e+00" " 3.24152009514918582056e+00" " 6.69725675916753715455e+00" "-3.92220138343523805347e+00" "-3.92220138343523805347e+00" " 3.24152061112269107568e+00" +" 9.63022297507382329940e-01" " 3.85430167120043698503e+00" "-8.57564557559832296718e-01" " 5.57947807514158622411e-01" "-9.75844500200148540214e-02" " 5.20945270601871276983e-02" " 6.67593936216114780535e+00" "-3.95620549261538512198e+00" "-3.95620549261538556607e+00" " 3.29945850041028787558e+00" " 6.67593897184716933424e+00" "-3.95620565868541973487e+00" "-3.95620565868541973487e+00" " 3.29945890553491860686e+00" +" 9.83385806812805518540e-01" " 3.87642609629187662179e+00" "-8.57298159903620127231e-01" " 5.79225771636781128215e-01" "-9.69637324515232740252e-02" " 5.39581497913679680734e-02" " 6.63478892091395522357e+00" "-4.06994333216582049317e+00" "-4.06994333216582138135e+00" " 3.48492602143910223944e+00" " 6.63496229494953215777e+00" "-4.07010612591893661261e+00" "-4.07010612591893750078e+00" " 3.48497151319155085147e+00" +" 9.96015936254980083220e-01" " 3.89045427669406107540e+00" "-8.51647550672810060846e-01" " 5.88678339989356036455e-01" "-9.48517702894998149254e-02" " 5.48735271589402689996e-02" " 6.59059003265847387354e+00" "-4.12800847151660654788e+00" "-4.12800847151660654788e+00" " 3.59243311443171098318e+00" " 6.59058967412733043290e+00" "-4.12800859323021374081e+00" "-4.12800859323021374081e+00" " 3.59243346801340113217e+00" +" 1.00377873740856293772e+00" " 3.90012265020643900115e+00" "-8.49293032548330550924e-01" " 5.95163064021745569221e-01" "-9.41592022218847995996e-02" " 5.54073385692636921629e-02" " 6.56814835419972897768e+00" "-4.16626035646235592935e+00" "-4.16626035646235592935e+00" " 3.66145289384344296835e+00" " 6.56814802765863703371e+00" "-4.16626046647486347752e+00" "-4.16626046647486258934e+00" " 3.66145322038407261545e+00" [TRUNCATED] To get the complete diff run: svnlook diff /svnroot/robast -r 631 From noreply at r-forge.r-project.org Wed Mar 13 18:38:24 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 13 Mar 2013 18:38:24 +0100 (CET) Subject: [Robast-commits] r632 - in branches/robast-0.9/pkg: RobExtremes/R RobExtremesBuffer Message-ID: <20130313173824.1D032183F97@r-forge.r-project.org> Author: ruckdeschel Date: 2013-03-13 18:38:23 +0100 (Wed, 13 Mar 2013) New Revision: 632 Added: branches/robast-0.9/pkg/RobExtremesBuffer/interpolRisk-Test.R Modified: branches/robast-0.9/pkg/RobExtremes/R/GEVFamily.R Log: + removed a chatty comment in GEVFamily.R + created a test function for LM interpolation and put it into RobExtremesBuffer/interpolRisk-Test.R => Gerald: could you make a formal unit test out of it ? Modified: branches/robast-0.9/pkg/RobExtremes/R/GEVFamily.R =================================================================== --- branches/robast-0.9/pkg/RobExtremes/R/GEVFamily.R 2013-03-13 16:31:08 UTC (rev 631) +++ branches/robast-0.9/pkg/RobExtremes/R/GEVFamily.R 2013-03-13 17:38:23 UTC (rev 632) @@ -229,7 +229,7 @@ if(!is.null(names(e0))) e0 <- e0[c("scale", "shape")] } - print(e0); print(str(x)); print(head(summary(x))); print(mu) +# print(e0); print(str(x)); print(head(summary(x))); print(mu) if(any(x < mu-e0["scale"]/e0["shape"])) stop("some data smaller than 'loc-scale/shape' ") Added: branches/robast-0.9/pkg/RobExtremesBuffer/interpolRisk-Test.R =================================================================== --- branches/robast-0.9/pkg/RobExtremesBuffer/interpolRisk-Test.R (rev 0) +++ branches/robast-0.9/pkg/RobExtremesBuffer/interpolRisk-Test.R 2013-03-13 17:38:23 UTC (rev 632) @@ -0,0 +1,53 @@ +#################################################### +### Tests fuer InterpolRisiken +#################################################### +PFam <- NULL +mytest <- function(PF = GParetoFamily, xi = 0.5, seed=130313){ + PFam <<- PF(shape=xi,scale=1) + cat("\n\n\n---------------------------------\n") + cat(" ", name(PFam)," ") + cat("\n---------------------------------\n") + set.seed(seed) + dat0 <- r(PFam)(100) + print(head(dat0)) + cat("\n\n\n---------------------------------\n") + cat("RMXE") + cat("\n---------------------------------\n") + try({ + print(system.time({re1<-robest(dat0,PFam,risk=RMXRRisk())})) + print(re1) + print(checkIC(pIC(re1))) + },silent=TRUE) + cat("\n\n\n---------------------------------\n") + cat("OMSE") + cat("\n---------------------------------\n") + try({ + system.time(re2<-robest(dat0,PFam,risk=OMSRRisk())) + print(re2) + print(checkIC(pIC(re2))) + },silent=TRUE) + cat("\n\n\n---------------------------------\n") + cat("MBRE") + cat("\n---------------------------------\n") + try({ + system.time(re3<-robest(dat0,PFam,risk=MBRRisk())) + print(re3) + print(checkIC(pIC(re3))) + },silent=TRUE) +} +mytest(PF=GParetoFamily) +mytest(PF=GEVFamily) +mytest(PF=GammaFamily) +mytest(PF=WeibullFamily) +mytest(PF=GParetoFamily,xi=1) +mytest(PF=GEVFamily,xi=1) +mytest(PF=GammaFamily,xi=1) +mytest(PF=WeibullFamily,xi=1) +mytest(PF=GParetoFamily,xi=0.1) +mytest(PF=GEVFamily,xi=0.1) +mytest(PF=GammaFamily,xi=0.1) +mytest(PF=WeibullFamily,xi=0.1) +mytest(PF=GParetoFamily,xi=10) +mytest(PF=GEVFamily,xi=10) +mytest(PF=GammaFamily,xi=10) +mytest(PF=WeibullFamily,xi=10) From noreply at r-forge.r-project.org Thu Mar 14 13:50:49 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 14 Mar 2013 13:50:49 +0100 (CET) Subject: [Robast-commits] r633 - in branches/robast-0.9/pkg: ROptEst/R ROptEst/man RobAStRDA/man RobExtremes/R RobExtremes/inst/AddMaterial/interpolation RobExtremes/man Message-ID: <20130314125049.D4A16184CE5@r-forge.r-project.org> Author: ruckdeschel Date: 2013-03-14 13:50:49 +0100 (Thu, 14 Mar 2013) New Revision: 633 Modified: branches/robast-0.9/pkg/ROptEst/R/interpolLM.R branches/robast-0.9/pkg/ROptEst/man/internal-interpolate.Rd branches/robast-0.9/pkg/RobAStRDA/man/0RobRDA-package.Rd branches/robast-0.9/pkg/RobExtremes/R/interpolLM.R branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/getLMInterpol.R branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/plotInterpol.R branches/robast-0.9/pkg/RobExtremes/man/internal-interpolate.Rd Log: grid-construction gains more control over the calls to optIC() and radiusMinimaxIC(); enhance documentaion for RobAStRDA (as package) Modified: branches/robast-0.9/pkg/ROptEst/R/interpolLM.R =================================================================== --- branches/robast-0.9/pkg/ROptEst/R/interpolLM.R 2013-03-13 17:38:23 UTC (rev 632) +++ branches/robast-0.9/pkg/ROptEst/R/interpolLM.R 2013-03-14 12:50:49 UTC (rev 633) @@ -1,42 +1,84 @@ -.RMXE.th <- function(th, PFam, modifyfct){ +.RMXE.th <- function(th, PFam, modifyfct, loRad = 0, upRad = Inf, z.start = NULL, + A.start = NULL, upper = NULL, lower = NULL, + OptOrIter = "iterate", maxiter = 50, + tol = .Machine$double.eps^0.4, loRad0 = 1e-3, ...){ PFam <- modifyfct(th,PFam) IC <- radiusMinimaxIC(L2Fam=PFam, neighbor= ContNeighborhood(), - risk = asMSE(), verbose = FALSE) + risk = asMSE(), verbose = FALSE, + loRad = loRad, upRad = upRad, z.start = z.start, + A.start = A.start, upper = upper, lower = lower, + OptOrIter = OptOrIter, maxiter = maxiter, + tol = tol, warn = FALSE, + loRad0 = loRad0) return(c(b=clip(IC), a=cent(IC), a.w = cent(weight(IC)), A=stand(IC), A.w = stand(weight(IC)))) } -.MBRE.th <- function(th, PFam, modifyfct){ +.MBRE.th <- function(th, PFam, modifyfct, + z.start = NULL, A.start = NULL, upper = 1e4, + lower = 1e-4, OptOrIter = "iterate", + maxiter = 50, tol = .Machine$double.eps^0.4, ...){ PFam <- modifyfct(th,PFam) RobM <- InfRobModel(center = PFam, neighbor = ContNeighborhood(radius = 15)) - IC <- optIC(model = RobM, risk = asBias(), verbose = FALSE) + IC <- optIC(model = RobM, risk = asBias(), verbose = FALSE, + z.start = z.start, A.start = A.start, upper = upper, + lower = lower, OptOrIter = OptOrIter, + maxiter = maxiter, tol = tol, warn = TRUE, noLow = FALSE, + .withEvalAsVar = FALSE) mA <- max(stand(IC)) mAw <- max(stand(weight(IC))) return(c(b=clip(IC), a=cent(IC), aw=cent(weight(IC)), A=stand(IC)/mA, Aw=stand(weight(IC))/mAw)) } -.OMSE.th <- function(th, PFam, modifyfct){ +.OMSE.th <- function(th, PFam, modifyfct, radius = 0.5, + z.start = NULL, A.start = NULL, upper = 1e4, + lower = 1e-4, OptOrIter = "iterate", + maxiter = 50, tol = .Machine$double.eps^0.4, ...){ PFam <- modifyfct(th,PFam) - RobM <- InfRobModel(center = PFam, neighbor = ContNeighborhood(radius = .5)) - IC <- optIC(model = RobM, risk = asMSE(), verbose = FALSE) + RobM <- InfRobModel(center = PFam, + neighbor = ContNeighborhood(radius = radius)) + IC <- optIC(model = RobM, risk = asMSE(), verbose = FALSE, + z.start = z.start, A.start = A.start, upper = upper, + lower = lower, OptOrIter = OptOrIter, + maxiter = maxiter, tol = tol, warn = TRUE, noLow = FALSE, + .withEvalAsVar = FALSE) res=c(b=clip(IC), a=cent(IC), a.w = cent(weight(IC)), A=stand(IC), A.w = stand(weight(IC))) return(res) } -.getLMGrid <- function(thGrid, PFam, optFct = .RMXE.th, modifyfct, - GridFileName="LMGrid.Rdata", withPrint = FALSE){ +.getLMGrid <- function(thGrid, PFam, optFct = .RMXE.th, modifyfct, radius = 0.5, + GridFileName="LMGrid.Rdata", withPrint = FALSE, + upper = 1e4, lower = 1e-4, OptOrIter = "iterate", + maxiter = 50, tol = .Machine$double.eps^0.4, + loRad = 0, upRad = Inf, loRad0 = 1e-3, + withStartLM = TRUE + ){ wprint <- function(...){ if (withPrint) print(...)} thGrid <- unique(sort(thGrid)) itLM <- 0 + z.start <- NULL + A.start <- NULL getLM <- function(th){ itLM <<- itLM + 1 if(withPrint) cat("Evaluation Nr.", itLM," at th = ",th,"\n") a <- try( - optFct(th=th,PFam=PFam,modifyfct=modifyfct) , silent=TRUE) - if(is(a,"try-error")) a <- rep(NA,13) + optFct(th = th, PFam = PFam, modifyfct = modifyfct, + z.start = z.start, A.start = A.start, + upper = upper, lower = lower, OptOrIter = OptOrIter, + maxiter = maxiter, tol = tol, + loRad = loRad, upRad = upRad, loRad0 = loRad0), + silent=TRUE) + if(is(a,"try-error")){ a <- rep(NA,13)}else{ + if(withStartLM){ + pdim <- length(a[["a"]]) + kdim <- length(a[["a.w"]]) + z.start <<- a[["a.w"]] + A.start <<- matrix(a[["A"]],pdim,kdim) + } + } return(a) } Modified: branches/robast-0.9/pkg/ROptEst/man/internal-interpolate.Rd =================================================================== --- branches/robast-0.9/pkg/ROptEst/man/internal-interpolate.Rd 2013-03-13 17:38:23 UTC (rev 632) +++ branches/robast-0.9/pkg/ROptEst/man/internal-interpolate.Rd 2013-03-14 12:50:49 UTC (rev 633) @@ -20,12 +20,25 @@ \usage{ -.RMXE.th(th, PFam, modifyfct) -.MBRE.th(th, PFam, modifyfct) -.OMSE.th(th, PFam, modifyfct) +.RMXE.th(th, PFam, modifyfct, loRad = 0, upRad = Inf, z.start = NULL, + A.start = NULL, upper = NULL, lower = NULL, + OptOrIter = "iterate", maxiter = 50, + tol = .Machine$double.eps^0.4, loRad0 = 1e-3, ...) +.MBRE.th(th, PFam, modifyfct, + z.start = NULL, A.start = NULL, upper = 1e4, + lower = 1e-4, OptOrIter = "iterate", + maxiter = 50, tol = .Machine$double.eps^0.4, ...) +.OMSE.th(th, PFam, modifyfct, radius = 0.5, + z.start = NULL, A.start = NULL, upper = 1e4, + lower = 1e-4, OptOrIter = "iterate", + maxiter = 50, tol = .Machine$double.eps^0.4, ...) -.getLMGrid(thGrid, PFam, optFct = .RMXE.th, modifyfct, - GridFileName = "LMGrid.Rdata", withPrint = FALSE) +.getLMGrid(thGrid, PFam, optFct = .RMXE.th, modifyfct, radius = 0.5, + GridFileName = "LMGrid.Rdata", withPrint = FALSE, + upper = 1e4, lower = 1e-4, OptOrIter = "iterate", + maxiter = 50, tol = .Machine$double.eps^0.4, + loRad = 0, upRad = Inf, loRad0 = 1e-3, + withStartLM = TRUE) .saveGridToCSV(Grid, toFileCSV, namPFam, nameInSysdata) @@ -46,8 +59,33 @@ \item{modifyfct}{function with arguments \code{th} and \code{PFam} to move the parametric family to the point of the grid value; returns the moved parametric family.} - \item{withSmooth}{logical of length 1: shall a smoothing spline be used?} - \item{withPrint}{logical of length 1: shall current grid value be printed out?} + \item{radius}{ [for OMSE]: positive numeric of length 1: the radius of the + neighborhood for which the LM's are to be computed; + defaults to 0.5. } + \item{loRad}{ the lower end point of the interval to be searched. } + \item{upRad}{ the upper end point of the interval to be searched. } + \item{z.start}{ initial value for the centering constant. } + \item{A.start}{ initial value for the standardizing matrix. } + \item{upper}{ upper bound for the optimal clipping bound. } + \item{lower}{ lower bound for the optimal clipping bound. } + \item{OptOrIter}{character; which method to be used for determining Lagrange + multipliers \code{A} and \code{a}: if (partially) matched to \code{"optimize"}, + \code{getLagrangeMultByOptim} is used; otherwise: by default, or if matched to + \code{"iterate"} or to \code{"doubleiterate"}, + \code{getLagrangeMultByIter} is used. More specifically, + when using \code{getLagrangeMultByIter}, and if argument \code{risk} is of + class \code{"asGRisk"}, by default and if matched to \code{"iterate"} + we use only one (inner) iteration, if matched to \code{"doubleiterate"} + we use up to \code{Maxiter} (inner) iterations. } + \item{maxiter}{ the maximum number of iterations. } + \item{tol}{ the desired accuracy (convergence tolerance).} + \item{loRad0}{ for numerical reasons: the effective lower bound for the zero search; + internally set to \code{max(loRad,loRad0)}. } + \item{\dots}{ additional parameters. } + \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{withSmooth}{logical of length 1: shall a smoothing spline be used? } + \item{withPrint}{logical of length 1: shall current grid value be printed out? } \item{thGrid}{numeric; grid values. } \item{optFct}{function with arguments \code{theta}, \code{PFam}, and modifyfct; determines the Lagrange multipliers. } @@ -68,7 +106,7 @@ } \details{ \code{.MBRE.th} computes the Lagrange multipliers for the MBRE estimator, - \code{.OMSE.th} for the OMSE estimator at radius \code{r=0.5}, + \code{.OMSE.th} for the OMSE estimator at radius \code{radius}, and \code{.RMXE.th} the RMXE estimator. \code{.getLMGrid} in a large loop computes the Lagrange multipliers for Modified: branches/robast-0.9/pkg/RobAStRDA/man/0RobRDA-package.Rd =================================================================== --- branches/robast-0.9/pkg/RobAStRDA/man/0RobRDA-package.Rd 2013-03-13 17:38:23 UTC (rev 632) +++ branches/robast-0.9/pkg/RobAStRDA/man/0RobRDA-package.Rd 2013-03-14 12:50:49 UTC (rev 633) @@ -7,15 +7,23 @@ } \description{ This package only contains sysdata.rda (with corresponding interpolation grids -for speedup); it is currently used in package RobExtremes. -The code to produce its contents can be drawn from CRAN-packages -ROptEst and RobExtremes, more specifically: see ?.RMXE.xi (RobExtremes) -resp. ?.RMXE.th (ROptEst), as well as the contents of the (system) folder +for speedup); it is currently used in package \pkg{RobExtremes}. +The code to produce its contents is split into two parts: (a) grid construction +and (b) interpolator construction. While the code for (a) can be drawn from +CRAN-packages \pkg{ROptEst} and \pkg{RobExtremes}, more specifically: +see \code{?.RMXE.xi} (\pkg{RobExtremes}) resp. \code{?.RMXE.th} (\pkg{ROptEst}), +as well as the contents of the (system) folder of package RobExtremes, i.e., - dir(file.path(system.file(package="RobExtremes"),"AddMaterial","interpolation")) + \code{dir(file.path(system.file(package="RobExtremes"),"AddMaterial","interpolation"))}, +the code for (b) resides in the present package (and does not need to know anything +about the grid construction). As it is not meant for users but rather for +developers, it is not exported to the namespace; still, it is documented, +see \code{?.generateInterpolators}. The reason to separate the rda file from the actual R packages is to -keep the latter small while we expect this package to only need seldom updates. +keep the latter small while we expect the present package to only need +seldom updates. + See also mail exchange P.Ruckdeschel - U.Ligges on R-devel--- \url{https://stat.ethz.ch/pipermail/r-devel/2013-February/065794.html}. } Modified: branches/robast-0.9/pkg/RobExtremes/R/interpolLM.R =================================================================== --- branches/robast-0.9/pkg/RobExtremes/R/interpolLM.R 2013-03-13 17:38:23 UTC (rev 632) +++ branches/robast-0.9/pkg/RobExtremes/R/interpolLM.R 2013-03-14 12:50:49 UTC (rev 633) @@ -33,7 +33,11 @@ .svInt <- function(optF = .RMXE.th, xiGrid = getShapeGrid(500, cutoff.at.0=0.005), #.svInt <- function(optF = .RMXE.th, xiGrid = getShapeGrid(5, cutoff.at.0=0.005), - PFam = GParetoFamily(shape=1,scale=2)){ + PFam = GParetoFamily(shape=1,scale=2), radius = 0.5, + upper = 1e4, lower = 1e-4, OptOrIter = "iterate", + maxiter = 50, tol = .Machine$double.eps^0.4, + loRad = 0, upRad = Inf, loRad0 = 1e-3, + withStartLM = TRUE){ namF <- gsub("\\.th$","",paste(deparse(substitute(optF)))) namF <- gsub("^\\.(.+)","\\1",namF) to <- gsub("XXXX",gsub(" ","",name(PFam)), @@ -43,7 +47,10 @@ PFam = PFam, toFileCSV = to, getFun = ROptEst:::.getLMGrid, modifyfct = .modify.xi.PFam.call, optFct = optF, - nameInSysdata = namF, withPrint = TRUE) + nameInSysdata = namF, withPrint = TRUE, radius = radius, + upper = upper, lower = lower, OptOrIter = OptOrIter, + maxiter = maxiter, tol = tol, loRad = loRad, upRad = upRad, + loRad0 = loRad0, withStartLM = withStartLM) } Modified: branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/getLMInterpol.R =================================================================== --- branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/getLMInterpol.R 2013-03-13 17:38:23 UTC (rev 632) +++ branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/getLMInterpol.R 2013-03-14 12:50:49 UTC (rev 633) @@ -1,7 +1,7 @@ -getLMs <- function(Gridnam,Famnam,xi=0.7, baseDir="C:/rtest/robast"){ +getLMs <- function(Gridnam,Famnam,xi=0.7, baseDir="C:/rtest/robast", withPrint=FALSE){ ## Gridnam in (Sn,OMSE,RMXE,MBRE) ## Famnam in "Generalized Pareto Family", - ## "Generalized Extreme Value Family with positive shape parameter: Frechet Family", + ## "GEV Family", ## "Gamma family", ## "Weibull Family" ## xi Scaleparameter (can be vector) @@ -12,17 +12,20 @@ load(file, envir=nE) Gnams <- c("Sn","OMSE","RMXE","MBRE") Fnams <- c("Generalized Pareto Family", - "Generalized Extreme Value Family with positive shape parameter: Frechet Family", + "GEV Family", "Gamma family", "Weibull Family") if(! Gridnam %in% Gnams) stop("Falscher Gittername") if(! Famnam %in% Fnams) stop("Falscher Familienname") + Famnam0 <- gsub(" ","",Famnam) isSn <- (Gridnam == "Sn") GN0 <- Gridnam; if(isSn) GN0 <- "SnGrids" - GN <- paste(".",GN0,".",if(getRversion()<"2.16") "O" else "N", sep="") - fct <- get(GN,envir=nE)[[Famnam]]$fct + GN <- paste(".",GN0, sep="") + funN <- paste("fun",".",if(getRversion()<"2.16") "O" else "N",sep="") + if(withPrint) print(c(GN, Famnam0, funN)) + fct <- get(GN,envir=nE)[[Famnam0]][[funN]] - if(!isSn)){ + if(!isSn){ ## f?r Gridnam != Sn ist LM f?r jeden xi Wert ein Vektor der L?nge 13, genauer # in 1:13 (clip=b, cent.a=a1.a,a2.a, cent.i=a1.i,a2.i, ## stand.a=A.a=matrix(c(A11.a,(A12.a+A21.a)/2, Modified: branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/plotInterpol.R =================================================================== --- branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/plotInterpol.R 2013-03-13 17:38:23 UTC (rev 632) +++ branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/plotInterpol.R 2013-03-14 12:50:49 UTC (rev 633) @@ -1,7 +1,8 @@ -plotLM <- function(Gridnam,Famnam,whichLM, baseDir="C:/rtest/robast"){ +plotLM <- function(Gridnam,Famnam,whichLM, baseDir="C:/rtest/robast", + withSmooth=FALSE, gridRestriction = NULL, prehook={}, posthook={}, ...){ ## Gridnam in (Sn,OMSE,RMXE,MBRE) ## Famnam in "Generalized Pareto Family", - ## "Generalized Extreme Value Family with positive shape parameter: Frechet Family", + ## "GEV Family", ## "Gamma family", ## "Weibull Family" ## whichLM ignoriert f?r Gridnam == Sn @@ -12,24 +13,58 @@ # (A12.i+A21.i)/2,A.22.i), 2, 2), ## und optIC = Y.a min(1,b/norm(Y.i)), Y.* = A.* Lambda - a.* ## basedir: Oberverzeichnis des r-forge svn checkouts - file <- file.path(baseDir, "branches/robast-0.9/pkg/RobExtremes/R/sysdata.rda") + 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", - "Generalized Extreme Value Family with positive shape parameter: Frechet Family", + "GEV Family", "Gamma family", "Weibull Family") + Gridnam <- Gnams[pmatch(Gridnam, Gnams)] + Famnam <- Fnams[pmatch(Famnam, Fnams)] if(! Gridnam %in% Gnams) stop("Falscher Gittername") if(! Famnam %in% Fnams) stop("Falscher Familienname") isSn <- (Gridnam == "Sn") + Famnam0 <- gsub(" ","",Famnam) GN0 <- Gridnam; if(isSn) GN0 <- "SnGrids" - GN <- paste(".",GN0,".",if(getRversion()<"2.16") "O" else "N", sep="") - gr <- get(GN,envir=nE)[[Famnam]]$grid - - if(!isSn) if(whichLM<1 | whichLM>13) stop("Falsche Koordinate") + GN <- paste(".",GN0,sep="") + funN <- paste("fun",".",if(getRversion()<"2.16") "O" else "N",sep="") + gN <- if(withSmooth) "gridS" else "grid" + gr <- get(GN,envir=nE)[[Famnam0]][[gN]] + if(is.null(gridRestriction)) gridRestriction <- rep(TRUE, nrow(gr)) + if(!isSn) if(whichLM!="all") if(whichLM<1 | whichLM>13) stop("Falsche Koordinate") + if(!isSn) if(whichLM=="all"){ + eval(prehook) + par(mfrow=c(4,4)) + for(i in 2:14) + plot(gr[gridRestriction,1], gr[gridRestriction,i], ...) + par(mfrow=c(1,1)) + eval(posthook) + return(invisible(NULL)) + } if(isSn) whichLM <- 1 wM <- whichLM + 1 - plot(gr[,1], gr[,wm]) + eval(prehook) + plot(gr[gridRestriction,1], gr[gridRestriction,wM], ...) + eval(posthook) + return(invisible(NULL)) } + +if(FALSE){ +## Examples +plotLM("OMSE","Gamma","all", type="l", gridR=-(1:20)) +plotLM("OMSE","Pareto","all", type="l", gridR=-(1:20)) +plotLM("OMSE","Gener","all", type="l", gridR=-(1:20)) +plotLM("OMSE","GEV","all", type="l", gridR=-(1:20)) +plotLM("OMSE","Wei","all", type="l", gridR=-(1:20)) +plotLM("MBRE","Wei","all", type="l", gridR=-(1:20)) +plotLM("MBRE","GE","all", type="l", gridR=-(1:20)) +plotLM("MBRE","Gene","all", type="l", gridR=-(1:20)) +plotLM("MBRE","Gam","all", type="l", gridR=-(1:20)) +plotLM("RMXE","Gam","all", type="l", gridR=-(1:20)) +plotLM("RMXE","Wei","all", type="l", gridR=-(1:20)) +plotLM("RMXE","Gene","all", type="l", gridR=-(1:20)) +plotLM("RMXE","GE","all", type="l", gridR=-(1:20)) +} \ No newline at end of file Modified: branches/robast-0.9/pkg/RobExtremes/man/internal-interpolate.Rd =================================================================== --- branches/robast-0.9/pkg/RobExtremes/man/internal-interpolate.Rd 2013-03-13 17:38:23 UTC (rev 632) +++ branches/robast-0.9/pkg/RobExtremes/man/internal-interpolate.Rd 2013-03-14 12:50:49 UTC (rev 633) @@ -33,7 +33,10 @@ optFct = .RMXE.xi, GridFileName="LMGrid.Rdata", withPrint = FALSE) .svInt(optF = .RMXE.th, xiGrid = getShapeGrid(500, cutoff.at.0=0.005), - PFam = GParetoFamily(shape=1,scale=2)) + PFam = GParetoFamily(shape=1,scale=2), radius = 0.5, upper = 1e4, + lower = 1e-4, OptOrIter = "iterate", maxiter = 50, + tol = .Machine$double.eps^0.4, loRad = 0, upRad = Inf, loRad0 = 1e-3, + withStartLM = TRUE) .generateInterpGridSn(xiGrid = getShapeGrid(500, cutoff.at.0=0.005), PFam = GParetoFamily(), withPrint = TRUE) @@ -60,6 +63,26 @@ \item{GridFileName}{character; if \code{GridFileName!=""}, the pure y-grid values are saved under this filename. } \item{withPrint}{logical of length 1: shall current shape value be printed out?} + \item{radius}{ [for OMSE]: positive numeric of length 1: the radius of the + neighborhood for which the LM's are to be computed; + defaults to 0.5. } + \item{loRad}{ the lower end point of the interval to be searched. } + \item{upRad}{ the upper end point of the interval to be searched. } + \item{upper}{ upper bound for the optimal clipping bound. } + \item{lower}{ lower bound for the optimal clipping bound. } + \item{OptOrIter}{character; which method to be used for determining Lagrange + multipliers \code{A} and \code{a}: if (partially) matched to \code{"optimize"}, + \code{getLagrangeMultByOptim} is used; otherwise: by default, or if matched to + \code{"iterate"} or to \code{"doubleiterate"}, + \code{getLagrangeMultByIter} is used. More specifically, + when using \code{getLagrangeMultByIter}, and if argument \code{risk} is of + class \code{"asGRisk"}, by default and if matched to \code{"iterate"} + we use only one (inner) iteration, if matched to \code{"doubleiterate"} + we use up to \code{Maxiter} (inner) iterations. } + \item{loRad0}{ for numerical reasons: the effective lower bound for the zero search; + 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? } } \details{ \code{.getpsi} reads the respective interpolating function From noreply at r-forge.r-project.org Fri Mar 15 08:53:46 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 15 Mar 2013 08:53:46 +0100 (CET) Subject: [Robast-commits] r634 - in branches/robast-0.9/pkg: ROptEst/R ROptEst/man RobExtremes/R RobExtremes/inst/AddMaterial/interpolation RobExtremes/man RobExtremesBuffer Message-ID: <20130315075346.DE07A1847D0@r-forge.r-project.org> Author: ruckdeschel Date: 2013-03-15 08:53:46 +0100 (Fri, 15 Mar 2013) New Revision: 634 Modified: branches/robast-0.9/pkg/ROptEst/R/LowerCaseMultivariate.R branches/robast-0.9/pkg/ROptEst/R/getInfRobIC_asAnscombe.R branches/robast-0.9/pkg/ROptEst/R/getInfRobIC_asBias.R branches/robast-0.9/pkg/ROptEst/R/getInfRobIC_asGRisk.R branches/robast-0.9/pkg/ROptEst/R/getInfRobIC_asHampel.R branches/robast-0.9/pkg/ROptEst/R/getInfRobIC_asUnOvShoot.R branches/robast-0.9/pkg/ROptEst/R/interpolLM.R branches/robast-0.9/pkg/ROptEst/R/optIC.R branches/robast-0.9/pkg/ROptEst/R/radiusMinimaxIC.R branches/robast-0.9/pkg/ROptEst/R/roptest.new.R branches/robast-0.9/pkg/ROptEst/man/getInfRobIC.Rd branches/robast-0.9/pkg/ROptEst/man/internalRobestHelpers.Rd branches/robast-0.9/pkg/ROptEst/man/optIC.Rd branches/robast-0.9/pkg/ROptEst/man/radiusMinimaxIC.Rd branches/robast-0.9/pkg/RobExtremes/R/interpolLM.R branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/getLMInterpol.R branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/interpolationscripts.R branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/plotInterpol.R branches/robast-0.9/pkg/RobExtremes/man/internal-interpolate.Rd branches/robast-0.9/pkg/RobExtremesBuffer/interpolRisk-Test.R Log: (1) introduced a helper function .dynScopeEval for evaluation acc. to dynamical scoping for use in roptest -- otherwise arguments of roptest could not get evaluated correctly when used in nested expressions like print(system.time({re1<-roptest(dat0,PFam,risk=RMXRRisk())})) . (2) took up Matthias' suggestion to allow for NA return values in optIC and radiusMinimaxIC in case of convergence problems; this is controlled now by argument returnNAifProblem; internally, getInfRobIC - methods now have a logical variable problem (TRUE in case of problems) which is returned as item of the return list. Technically, all getInfRobIC methods now had to be supplemented with a ... argument, because they might get passed on argument returnNAifProblem. (3) enhanced documentation for getLMinterpol, plotInterpol (4) increased precision in calling tuning parameters of optIC and radiusMinimaxIC in the generation of the grids Modified: branches/robast-0.9/pkg/ROptEst/R/LowerCaseMultivariate.R =================================================================== --- branches/robast-0.9/pkg/ROptEst/R/LowerCaseMultivariate.R 2013-03-14 12:50:49 UTC (rev 633) +++ branches/robast-0.9/pkg/ROptEst/R/LowerCaseMultivariate.R 2013-03-15 07:53:46 UTC (rev 634) @@ -86,13 +86,15 @@ erg <- optim(p.vec, bmin.fct, method = "Nelder-Mead", control = list(reltol = tol, maxit = 100*maxiter), L2deriv = L2deriv, Distr = Distr, trafo = trafo) + problem <- (erg$convergence > 0) A.max <- max(abs(stand(w))) stand(w) <- stand(w)/A.max weight(w) <- minbiasweight(w, neighbor = neighbor, biastype = biastype, normW = normtype) - return(list(erg=erg, w=w, normtype = normtype, z.comp = z.comp, itermin = itermin)) + return(list(erg=erg, w=w, normtype = normtype, z.comp = z.comp, itermin = itermin, + problem = problem )) } @@ -132,6 +134,7 @@ control = list(reltol = tol, maxit = 100*maxiter), L2deriv = L2deriv, Distr = Distr, trafo = trafo) + problem <- (erg$convergence > 0) A <- matrix(erg$par, ncol = k, nrow = 1) b <- 1/erg$value stand(w) <- A @@ -153,6 +156,6 @@ weight(w) <- minbiasweight(w, neighbor = neighbor, biastype = biastype, normW = normtype) - return(list(A=A,b=b, w=w, a=a, itermin = itermin)) + return(list(A=A,b=b, w=w, a=a, itermin = itermin, problem = problem)) } Modified: branches/robast-0.9/pkg/ROptEst/R/getInfRobIC_asAnscombe.R =================================================================== --- branches/robast-0.9/pkg/ROptEst/R/getInfRobIC_asAnscombe.R 2013-03-14 12:50:49 UTC (rev 633) +++ branches/robast-0.9/pkg/ROptEst/R/getInfRobIC_asAnscombe.R 2013-03-15 07:53:46 UTC (rev 634) @@ -6,7 +6,7 @@ neighbor = "UncondNeighborhood"), function(L2deriv, risk, neighbor, symm, Finfo, trafo, upper = NULL, lower = NULL, maxiter, tol, warn, noLow = FALSE, - verbose = NULL, checkBounds = TRUE){ + verbose = NULL, checkBounds = TRUE, ...){ if(missing(verbose)|| is.null(verbose)) verbose <- getRobAStBaseOption("all.verbose") Modified: branches/robast-0.9/pkg/ROptEst/R/getInfRobIC_asBias.R =================================================================== --- branches/robast-0.9/pkg/ROptEst/R/getInfRobIC_asBias.R 2013-03-14 12:50:49 UTC (rev 633) +++ branches/robast-0.9/pkg/ROptEst/R/getInfRobIC_asBias.R 2013-03-15 07:53:46 UTC (rev 634) @@ -145,7 +145,8 @@ weight(w) <- minbiasweight(w, neighbor = neighbor, biastype = biastype, normW = NormType()) return(list(A = A, a = zi*z, b = b, d = d, risk = Risk, info = info, - w = w, biastype = biastype, normtype = NormType())) + w = w, biastype = biastype, normtype = NormType(), + problem = FALSE)) }) setMethod("minmaxBias", signature(L2deriv = "UnivariateDistribution", @@ -179,7 +180,8 @@ clip(w) <- c(a, a+b) weight(w) <- minbiasweight(w, neighbor = neighbor, biastype = biastype) return(list(A = A, a = a, b = b, d = 0, risk = Risk, info = info, - w = w, biastype = biastype, normtype = NormType())) + w = w, biastype = biastype, normtype = NormType(), + problem = FALSE)) }) setMethod("minmaxBias", signature(L2deriv = "RealRandVariable", @@ -218,6 +220,7 @@ w <- eerg$w normtype <- eerg$normtype + problem <- eerg$problem if(verbose) .checkPIC(L2deriv, neighbor, Distr, trafo, z, A, w, z.comp, A.comp) @@ -243,7 +246,8 @@ r = r, at = neighbor)) return(list(A = A, a = a, b = b, d = d, risk = Risk, info = info, - w = w, biastype = biastype, normtype = normtype)) + w = w, biastype = biastype, normtype = normtype, + problem = problem)) }) @@ -301,7 +305,8 @@ r = r, at = neighbor)) return(list(A = A, a = a, b = b, d = d, risk = Risk, info = info, - w = w, biastype = biastype, normtype = normtype)) + w = w, biastype = biastype, normtype = normtype, + problem = problem)) }) @@ -346,7 +351,8 @@ weight(w) <- minbiasweight(w, neighbor = neighbor, biastype = biastype) return(list(A = A, a = zi*z, b = b, d = d, risk = Risk, info = info, - w = w, biastype = biastype, normtype = NormType())) + w = w, biastype = biastype, normtype = NormType(), + problem = FALSE)) }) setMethod("minmaxBias", signature(L2deriv = "UnivariateDistribution", @@ -417,5 +423,6 @@ }else{return(noIC())} return(list(A = A0, a = a0, b = b0, d = d0, risk = Risk0, info = infotxt, w = w, biastype = biastype, - normtype = NormType())) + normtype = NormType(), + problem = FALSE)) }) Modified: branches/robast-0.9/pkg/ROptEst/R/getInfRobIC_asGRisk.R =================================================================== --- branches/robast-0.9/pkg/ROptEst/R/getInfRobIC_asGRisk.R 2013-03-14 12:50:49 UTC (rev 633) +++ branches/robast-0.9/pkg/ROptEst/R/getInfRobIC_asGRisk.R 2013-03-15 07:53:46 UTC (rev 634) @@ -6,7 +6,7 @@ neighbor = "UncondNeighborhood"), function(L2deriv, risk, neighbor, symm, Finfo, trafo, upper = NULL, lower = NULL, maxiter, tol, - warn, noLow = FALSE, verbose = NULL){ + warn, noLow = FALSE, verbose = NULL, ...){ if(missing(verbose)|| is.null(verbose)) verbose <- getRobAStBaseOption("all.verbose") @@ -62,6 +62,7 @@ ## assign("l2D",L2deriv,.GlobalEnv) ### prec <- 1 + problem <- FALSE repeat{ iter <- iter + 1 z.old <- z @@ -131,11 +132,13 @@ if(prec < tol) break if(abs(prec.old - prec) < 1e-10){ if(iter>1) + problem <- TRUE cat("algorithm did not converge!\n", "achieved precision:\t", prec, "\n") break } if(iter > maxiter){ if(iter>1) + problem <- TRUE cat("maximum iterations reached!\n", "achieved precision:\t", prec, "\n") break } @@ -180,7 +183,7 @@ normW = NormType()) ## print(list(A = A, a = a, b = b)) return(list(A = A, a = a, b = b, d = NULL, risk = Risk, info = info, w = w, - biastype = biastype, normtype = normtype(risk))) + biastype = biastype, normtype = normtype(risk), problem = problem )) }) @@ -267,8 +270,8 @@ iter <- 0 prec <- 1 iter.In <- 0 + problem <- FALSE - ## determining A,a,b with either optimization of iteration: if(OptOrIter == 1){ if(is.null(lower)){ @@ -401,10 +404,12 @@ } if(prec < tol) break if(abs(prec.old - prec) < 1e-10){ + problem <- TRUE cat("algorithm did not converge!\n", "achieved precision:\t", prec, "\n") break } if(iter > maxiter){ + problem <- TRUE cat("maximum iterations reached!\n", "achieved precision:\t", prec, "\n") break } @@ -486,7 +491,7 @@ return(list(A = A, a = a, b = b, d = NULL, risk = Risk, info = info, w = w, biastype = biastype, normtype = normtype, call = mc, iter = iter, prec = prec, OIcall = OptIterCall, - iter.In = iter.In, prec.In = prec.In)) + iter.In = iter.In, prec.In = prec.In, problem = problem )) }) ### helper function to recursively evaluate list Modified: branches/robast-0.9/pkg/ROptEst/R/getInfRobIC_asHampel.R =================================================================== --- branches/robast-0.9/pkg/ROptEst/R/getInfRobIC_asHampel.R 2013-03-14 12:50:49 UTC (rev 633) +++ branches/robast-0.9/pkg/ROptEst/R/getInfRobIC_asHampel.R 2013-03-15 07:53:46 UTC (rev 634) @@ -6,7 +6,7 @@ neighbor = "UncondNeighborhood"), function(L2deriv, risk, neighbor, symm, Finfo, trafo, upper = NULL, lower = NULL, maxiter, tol, warn, noLow = FALSE, - verbose = NULL, checkBounds = TRUE){ + verbose = NULL, checkBounds = TRUE, ...){ if(missing(verbose)|| is.null(verbose)) verbose <- getRobAStBaseOption("all.verbose") Modified: branches/robast-0.9/pkg/ROptEst/R/getInfRobIC_asUnOvShoot.R =================================================================== --- branches/robast-0.9/pkg/ROptEst/R/getInfRobIC_asUnOvShoot.R 2013-03-14 12:50:49 UTC (rev 633) +++ branches/robast-0.9/pkg/ROptEst/R/getInfRobIC_asUnOvShoot.R 2013-03-15 07:53:46 UTC (rev 634) @@ -5,7 +5,7 @@ risk = "asUnOvShoot", neighbor = "UncondNeighborhood"), function(L2deriv, risk, neighbor, symm, Finfo, trafo, - upper, lower, maxiter, tol, warn){ + upper, lower, maxiter, tol, warn, ...){ biastype <- biastype(risk) radius <- neighbor at radius if(identical(all.equal(radius, 0), TRUE)){ Modified: branches/robast-0.9/pkg/ROptEst/R/interpolLM.R =================================================================== --- branches/robast-0.9/pkg/ROptEst/R/interpolLM.R 2013-03-14 12:50:49 UTC (rev 633) +++ branches/robast-0.9/pkg/ROptEst/R/interpolLM.R 2013-03-15 07:53:46 UTC (rev 634) @@ -9,8 +9,9 @@ A.start = A.start, upper = upper, lower = lower, OptOrIter = OptOrIter, maxiter = maxiter, tol = tol, warn = FALSE, - loRad0 = loRad0) - return(c(b=clip(IC), a=cent(IC), a.w = cent(weight(IC)), + loRad0 = loRad0, returnNAifProblem = TRUE) + if(is.na(IC)) return(NA) + return(list(b=clip(IC), a=cent(IC), a.w = cent(weight(IC)), A=stand(IC), A.w = stand(weight(IC)))) } @@ -24,10 +25,11 @@ z.start = z.start, A.start = A.start, upper = upper, lower = lower, OptOrIter = OptOrIter, maxiter = maxiter, tol = tol, warn = TRUE, noLow = FALSE, - .withEvalAsVar = FALSE) + .withEvalAsVar = FALSE, returnNAifProblem = TRUE) + if(is.na(IC)) return(NA) mA <- max(stand(IC)) mAw <- max(stand(weight(IC))) - return(c(b=clip(IC), a=cent(IC), aw=cent(weight(IC)), + return(list(b=clip(IC), a=cent(IC), aw=cent(weight(IC)), A=stand(IC)/mA, Aw=stand(weight(IC))/mAw)) } @@ -42,8 +44,9 @@ z.start = z.start, A.start = A.start, upper = upper, lower = lower, OptOrIter = OptOrIter, maxiter = maxiter, tol = tol, warn = TRUE, noLow = FALSE, - .withEvalAsVar = FALSE) - res=c(b=clip(IC), a=cent(IC), a.w = cent(weight(IC)), + .withEvalAsVar = FALSE, returnNAifProblem = TRUE) + if(is.na(IC)) return(NA) + res=list(b=clip(IC), a=cent(IC), a.w = cent(weight(IC)), A=stand(IC), A.w = stand(weight(IC))) return(res) } @@ -71,16 +74,20 @@ maxiter = maxiter, tol = tol, loRad = loRad, upRad = upRad, loRad0 = loRad0), silent=TRUE) - if(is(a,"try-error")){ a <- rep(NA,13)}else{ + print(a) + print(A.start) + print(z.start) + if(is(a,"try-error")|any(is.na(a))){ a <- rep(NA,13)}else{ if(withStartLM){ pdim <- length(a[["a"]]) kdim <- length(a[["a.w"]]) z.start <<- a[["a.w"]] A.start <<- matrix(a[["A"]],pdim,kdim) + a <- c(a[["b"]],a[["a"]],a[["a.w"]],a[["A"]],a[["A.w"]]) } } return(a) - } + } distroptions.old <- distroptions() distrExOptions.old <- distrExOptions() Modified: branches/robast-0.9/pkg/ROptEst/R/optIC.R =================================================================== --- branches/robast-0.9/pkg/ROptEst/R/optIC.R 2013-03-14 12:50:49 UTC (rev 633) +++ branches/robast-0.9/pkg/ROptEst/R/optIC.R 2013-03-15 07:53:46 UTC (rev 634) @@ -6,7 +6,7 @@ lower = 1e-4, OptOrIter = "iterate", maxiter = 50, tol = .Machine$double.eps^0.4, warn = TRUE, noLow = FALSE, verbose = NULL, ..., - .withEvalAsVar = TRUE){ + .withEvalAsVar = TRUE, returnNAifProblem = FALSE){ if(missing(verbose)|| is.null(verbose)) verbose <- getRobAStBaseOption("all.verbose") L2derivDim <- numberOfMaps(model at center@L2deriv) @@ -26,6 +26,7 @@ res <- c(res, modifyIC = getModifyIC(L2FamIC = model at center, neighbor = model at neighbor, risk = risk)) + if(returnNAifProblem) if(!is.null(res$problem)) if(res$problem) return(NA) IC.o <- generateIC(model at neighbor, model at center, res) }else{ if(is(model at center@distribution, "UnivariateDistribution")){ @@ -58,6 +59,7 @@ maxiter = maxiter, tol = tol, warn = warn, verbose = verbose, ...,.withEvalAsVar = .withEvalAsVar) options(ow) + if(returnNAifProblem) if(!is.null(res$problem)) if(res$problem) return(NA) res$info <- c("optIC", res$info) res <- c(res, modifyIC = getModifyIC(L2FamIC = model at center, neighbor = model at neighbor, Modified: branches/robast-0.9/pkg/ROptEst/R/radiusMinimaxIC.R =================================================================== --- branches/robast-0.9/pkg/ROptEst/R/radiusMinimaxIC.R 2013-03-14 12:50:49 UTC (rev 633) +++ branches/robast-0.9/pkg/ROptEst/R/radiusMinimaxIC.R 2013-03-15 07:53:46 UTC (rev 634) @@ -9,7 +9,7 @@ A.start = NULL, upper = NULL, lower = NULL, OptOrIter = "iterate", maxiter = 50, tol = .Machine$double.eps^0.4, warn = FALSE, - verbose = NULL, loRad0 = 1e-3, ...){ + verbose = NULL, loRad0 = 1e-3, ..., returnNAifProblem = FALSE){ if(missing(verbose)|| is.null(verbose)) verbose <- getRobAStBaseOption("all.verbose") ow <- options("warn") @@ -167,6 +167,7 @@ tol = .Machine$double.eps^0.25)$root , silent = TRUE) if(is(leastFavR, "try-error")){ + if(returnNAifProblem) return(NA) warnRund <- 1; isE <- TRUE fl <- (0.2/lower)^(1/6); fu <- (0.5/upper)^(1/6) while(warnRund < 7 && isE ){ @@ -192,8 +193,9 @@ } neighbor at radius <- leastFavR args.IC$neighbor <- args.R$neighbor <- neighbor - + args.IC$returnNAifProblem <- returnNAifProblem res <- do.call(getInfRobIC, args.IC) + if(returnNAifProblem) if(!is.null(res$problem)) if(res$problem) return(NA) options(ow) res$info <- c("radiusMinimaxIC", paste("radius minimax IC for radius interval [", round(loRad, 3), ", ", round(upRad, 3), "]", sep="")) Modified: branches/robast-0.9/pkg/ROptEst/R/roptest.new.R =================================================================== --- branches/robast-0.9/pkg/ROptEst/R/roptest.new.R 2013-03-14 12:50:49 UTC (rev 633) +++ branches/robast-0.9/pkg/ROptEst/R/roptest.new.R 2013-03-15 07:53:46 UTC (rev 634) @@ -1,6 +1,16 @@ ############################################################################### ## Optimally robust estimation ############################################################################### +.dynScopeEval <- function(expr){ + le <- length(sys.calls()) + i <- 1 + while(i< le){ + a <- try(eval(expr,envir=sys.frame(-i)),silent=TRUE) + if(!is(a,"try-error")) return(a) + i <- i + 1 + } + stop("Could not evaluate expression.") +} roptest <- function(x, L2Fam, eps, eps.lower, eps.upper, fsCor = 1, initial.est, neighbor = ContNeighborhood(), risk = asMSE(), steps = 1L, @@ -15,14 +25,16 @@ withLogScale = TRUE,..withCheck=FALSE, withTimings = FALSE, withMDE = NULL, withEvalAsVar = NULL){ - es.call <- match.call() + es.call <- es.call.e <- match.call() + es.call.e <- (as.list(es.call.e)) + es.call.e[["..."]] <- NULL + for(i in seq(along.with=es.call.e)) + es.call.e[[i]] <- .dynScopeEval(es.call.e[[i]]) es.call0 <- match.call(expand.dots=FALSE) mwt <- !is.null(es.call$withTimings) es.call$withTimings <- NULL - es.call0$withTimings <- NULL dots <- es.call0[["..."]] - es.call0$"..." <- NULL - es.call1 <- .constructArg.list(roptest,es.call0, onlyFormal=FALSE, + es.call1 <- .constructArg.list(roptest,es.call.e, onlyFormal=FALSE, debug = ..withCheck)$mc res <- .constructArg.list(gennbCtrl,es.call1, onlyFormal=TRUE, Modified: branches/robast-0.9/pkg/ROptEst/man/getInfRobIC.Rd =================================================================== --- branches/robast-0.9/pkg/ROptEst/man/getInfRobIC.Rd 2013-03-14 12:50:49 UTC (rev 633) +++ branches/robast-0.9/pkg/ROptEst/man/getInfRobIC.Rd 2013-03-15 07:53:46 UTC (rev 634) @@ -45,7 +45,7 @@ \S4method{getInfRobIC}{UnivariateDistribution,asHampel,UncondNeighborhood}(L2deriv, risk, neighbor, symm, Finfo, trafo, upper = NULL, lower=NULL, maxiter, tol, warn, noLow = FALSE, - verbose = NULL, checkBounds = TRUE) + verbose = NULL, checkBounds = TRUE, ...) \S4method{getInfRobIC}{RealRandVariable,asHampel,UncondNeighborhood}(L2deriv, risk, neighbor, Distr, DistrSymm, L2derivSymm, @@ -58,7 +58,7 @@ \S4method{getInfRobIC}{UnivariateDistribution,asAnscombe,UncondNeighborhood}( L2deriv, risk, neighbor, symm, Finfo, trafo, upper = NULL, lower=NULL, maxiter, tol, warn, noLow = FALSE, - verbose = NULL, checkBounds = TRUE) + verbose = NULL, checkBounds = TRUE, ...) \S4method{getInfRobIC}{RealRandVariable,asAnscombe,UncondNeighborhood}(L2deriv, risk, neighbor, Distr, DistrSymm, L2derivSymm, @@ -70,7 +70,7 @@ \S4method{getInfRobIC}{UnivariateDistribution,asGRisk,UncondNeighborhood}(L2deriv, risk, neighbor, symm, Finfo, trafo, upper = NULL, lower = NULL, maxiter, tol, warn, noLow = FALSE, - verbose = NULL) + verbose = NULL, ...) \S4method{getInfRobIC}{RealRandVariable,asGRisk,UncondNeighborhood}(L2deriv, risk, neighbor, Distr, DistrSymm, L2derivSymm, @@ -81,7 +81,7 @@ \S4method{getInfRobIC}{UnivariateDistribution,asUnOvShoot,UncondNeighborhood}( L2deriv, risk, neighbor, symm, Finfo, trafo, - upper, lower, maxiter, tol, warn) + upper, lower, maxiter, tol, warn, ...) } \arguments{ \item{L2deriv}{ L2-derivative of some L2-differentiable family Modified: branches/robast-0.9/pkg/ROptEst/man/internalRobestHelpers.Rd =================================================================== --- branches/robast-0.9/pkg/ROptEst/man/internalRobestHelpers.Rd 2013-03-14 12:50:49 UTC (rev 633) +++ branches/robast-0.9/pkg/ROptEst/man/internalRobestHelpers.Rd 2013-03-15 07:53:46 UTC (rev 634) @@ -4,6 +4,7 @@ \alias{.plotRescaledAxis} \alias{.legendCoord} \alias{.SelectOrderData} +\alias{.dynScopeEval} \title{Internal / Helper functions of package ROptEst for function robest} @@ -12,6 +13,7 @@ in package \pkg{ROptEst}.} \usage{ +.dynScopeEval(expr) .constructArg.list(fun,matchCall, onlyFormal=FALSE, debug =FALSE) .fix.in.defaults(call.list, fun, withEval=TRUE) .pretreat(x, na.rm = TRUE) @@ -20,24 +22,28 @@ .isOKfsCor(fsCor) } \arguments{ - \item{fun}{function, a matched call of which is manipulated} - \item{matchCall}{a return value of a call to \code{match.call}} + \item{expr}{an expression. } + \item{fun}{function, a matched call of which is manipulated. } + \item{matchCall}{a return value of a call to \code{match.call}. } \item{onlyFormal}{logical; shall arguments not explicitely contained in - the formals of \code{fun} be kept in the matched call?} - \item{debug}{logical: if switched on, issues information for debugging.} + the formals of \code{fun} be kept in the matched call? } + \item{debug}{logical: if switched on, issues information for debugging. } \item{call.list}{a list of matched arguments drawn from a call to \code{match.call} applied to \code{fun} which is to be supplemented by defaults of - not-yet-matched formals} - \item{withEval}{logical: shall arguments be evaluated?} - \item{x}{input data \code{x} of \code{robest} or \code{roptest}.} + not-yet-matched formals. } + \item{withEval}{logical: shall arguments be evaluated? } + \item{x}{input data \code{x} of \code{robest} or \code{roptest}. } \item{na.rm}{logical: if \code{TRUE}, the estimator is evaluated at - \code{complete.cases(x)}.} + \code{complete.cases(x)}. } \item{\dots}{input from \code{robest} or \code{roptest} from which to conclude - on radiuses} - \item{steps}{number of steps to be used in kStep estimator in \code{robest}} - \item{fsCor}{argument \code{fsCor} of \code{robest}} + on radiuses. } + \item{steps}{number of steps to be used in kStep estimator in \code{robest}. } + \item{fsCor}{argument \code{fsCor} of \code{robest}. } } \details{ +\code{.dynScopeEval} marches up the stack of calls to evaluate an expression, + hence realizes dynamical scoping. + \code{.constructArg.list} takes a function \code{fun} and the return value of \code{match.call} and, as return value, produces a list of arguments where the formal arguments of \code{fun} are set to their default values and Modified: branches/robast-0.9/pkg/ROptEst/man/optIC.Rd =================================================================== --- branches/robast-0.9/pkg/ROptEst/man/optIC.Rd 2013-03-14 12:50:49 UTC (rev 633) +++ branches/robast-0.9/pkg/ROptEst/man/optIC.Rd 2013-03-15 07:53:46 UTC (rev 634) @@ -17,7 +17,8 @@ OptOrIter = "iterate", maxiter = 50, tol = .Machine$double.eps^0.4, warn = TRUE, noLow = FALSE, verbose = NULL, ..., - .withEvalAsVar = TRUE) + .withEvalAsVar = TRUE, + returnNAifProblem = FALSE) \S4method{optIC}{InfRobModel,asUnOvShoot}(model, risk, upper = 1e4, lower = 1e-4, maxiter = 50, @@ -51,11 +52,14 @@ when using \code{getLagrangeMultByIter}, and if argument \code{risk} is of class \code{"asGRisk"}, by default and if matched to \code{"iterate"} we use only one (inner) iteration, if matched to \code{"doubleiterate"} - we use up to \code{Maxiter} (inner) iterations.} - \item{verbose}{ logical: if \code{TRUE}, some messages are printed } + we use up to \code{Maxiter} (inner) iterations. } + \item{verbose}{ logical: if \code{TRUE}, some messages are printed. } \item{.withEvalAsVar}{logical (of length 1): if \code{TRUE}, risks based on covariances are to be - evaluated (default), otherwise just a call is returned.} + evaluated (default), otherwise just a call is returned. } + \item{returnNAifProblem}{logical (of length 1): + if \code{TRUE} (not the default), in case of convergence problems in + the algorithm, returns \code{NA}. } } \details{ In case of the finite-sample risk \code{"fiUnOvShoot"} one can choose between two algorithms for the computation of this risk where the least favorable Modified: branches/robast-0.9/pkg/ROptEst/man/radiusMinimaxIC.Rd =================================================================== --- branches/robast-0.9/pkg/ROptEst/man/radiusMinimaxIC.Rd 2013-03-14 12:50:49 UTC (rev 633) +++ branches/robast-0.9/pkg/ROptEst/man/radiusMinimaxIC.Rd 2013-03-15 07:53:46 UTC (rev 634) @@ -14,7 +14,8 @@ L2Fam, neighbor, risk, loRad = 0, upRad = Inf, z.start = NULL, A.start = NULL, upper = NULL, lower = NULL, OptOrIter = "iterate", maxiter = 50, tol = .Machine$double.eps^0.4, - warn = FALSE, verbose = NULL, loRad0 = 1e-3, ...) + warn = FALSE, verbose = NULL, loRad0 = 1e-3, ..., + returnNAifProblem = FALSE) } \arguments{ \item{L2Fam}{ L2-differentiable family of probability measures. } @@ -42,6 +43,9 @@ \item{loRad0}{ for numerical reasons: the effective lower bound for the zero search; internally set to \code{max(loRad,loRad0)}.} \item{\dots}{further arguments to be passed on to \code{getInfRobIC}} + \item{returnNAifProblem}{logical (of length 1): + if \code{TRUE} (not the default), in case of convergence problems in + the algorithm, returns \code{NA}. } } \details{ In case the neighborhood radius is unknown, Rieder et al. (2001, 2008) Modified: branches/robast-0.9/pkg/RobExtremes/R/interpolLM.R =================================================================== --- branches/robast-0.9/pkg/RobExtremes/R/interpolLM.R 2013-03-14 12:50:49 UTC (rev 633) +++ branches/robast-0.9/pkg/RobExtremes/R/interpolLM.R 2013-03-15 07:53:46 UTC (rev 634) @@ -31,11 +31,11 @@ withPrint = withPrint)} -.svInt <- function(optF = .RMXE.th, xiGrid = getShapeGrid(500, cutoff.at.0=0.005), +.svInt <- function(optF = .RMXE.th, xiGrid = getShapeGrid(700, cutoff.at.0=0.005), #.svInt <- function(optF = .RMXE.th, xiGrid = getShapeGrid(5, cutoff.at.0=0.005), PFam = GParetoFamily(shape=1,scale=2), radius = 0.5, upper = 1e4, lower = 1e-4, OptOrIter = "iterate", - maxiter = 50, tol = .Machine$double.eps^0.4, + maxiter = 150, tol = .Machine$double.eps^0.5, loRad = 0, upRad = Inf, loRad0 = 1e-3, withStartLM = TRUE){ namF <- gsub("\\.th$","",paste(deparse(substitute(optF)))) Modified: branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/getLMInterpol.R =================================================================== --- branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/getLMInterpol.R 2013-03-14 12:50:49 UTC (rev 633) +++ branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/getLMInterpol.R 2013-03-15 07:53:46 UTC (rev 634) @@ -1,9 +1,9 @@ getLMs <- function(Gridnam,Famnam,xi=0.7, baseDir="C:/rtest/robast", withPrint=FALSE){ - ## Gridnam in (Sn,OMSE,RMXE,MBRE) + ## Gridnam in (Sn,OMSE,RMXE,MBRE) ## uses partial matching!! ## Famnam in "Generalized Pareto Family", ## "GEV Family", ## "Gamma family", - ## "Weibull Family" + ## "Weibull Family" ## uses partial matching!! ## xi Scaleparameter (can be vector) ## basedir: Oberverzeichnis des r-forge svn checkouts file <- file.path(baseDir, "branches/robast-0.9/pkg/RobAStRDA/R/sysdata.rda") @@ -15,6 +15,8 @@ "GEV Family", "Gamma family", "Weibull Family") + Gridnam <- Gnams[pmatch(Gridnam, Gnams)] + Famnam <- Fnams[pmatch(Famnam, Fnams)] if(! Gridnam %in% Gnams) stop("Falscher Gittername") if(! Famnam %in% Fnams) stop("Falscher Familienname") Famnam0 <- gsub(" ","",Famnam) Modified: branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/interpolationscripts.R =================================================================== --- branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/interpolationscripts.R 2013-03-14 12:50:49 UTC (rev 633) +++ branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/interpolationscripts.R 2013-03-15 07:53:46 UTC (rev 634) @@ -15,9 +15,9 @@ .RMXE.th <- ROptEst:::.RMXE.th .modify.xi.PFam.call <- RobExtremes:::.modify.xi.PFam.call # -PF <- GParetoFamily() +#PF <- GParetoFamily() #PF <- GEVFamily() -#PF <- GammaFamily() +PF <- GammaFamily() #PF <- WeibullFamily() ### .svInt <- RobExtremes:::.svInt @@ -25,7 +25,7 @@ RobExtremes:::.generateInterpGridSn(PFam = PF)} ## to make this parallel, start this on several processors #.svInt1() -#.svInt(.OMSE.th, PFam=PF) +.svInt(.OMSE.th, PFam=PF) .svInt(.MBRE.th, PFam=PF) .svInt(.RMXE.th, PFam=PF) setwd(oldwd) Modified: branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/plotInterpol.R =================================================================== --- branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/plotInterpol.R 2013-03-14 12:50:49 UTC (rev 633) +++ branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/plotInterpol.R 2013-03-15 07:53:46 UTC (rev 634) @@ -1,18 +1,26 @@ plotLM <- function(Gridnam,Famnam,whichLM, baseDir="C:/rtest/robast", withSmooth=FALSE, gridRestriction = NULL, prehook={}, posthook={}, ...){ - ## Gridnam in (Sn,OMSE,RMXE,MBRE) - ## Famnam in "Generalized Pareto Family", + ## Gridnam in (Sn,OMSE,RMXE,MBRE) ## uses partial matching!! + ## Famnam in "Generalized Pareto Family", ## uses partial matching!! ## "GEV Family", ## "Gamma family", ## "Weibull Family" - ## whichLM ignoriert f?r Gridnam == Sn + ## whichLM is ignored for Gridnam == Sn # in 1:13 (clip=b, cent.a=a1.a,a2.a, cent.i=a1.i,a2.i, ## stand.a=A.a=matrix(c(A11.a,(A12.a+A21.a)/2, # (A12.a+A21.a)/2,A.22.a), 2, 2), ## stand.i=A.i=matrix(c(A11.i,(A12.i+A21.i)/2, # (A12.i+A21.i)/2,A.22.i), 2, 2), - ## und optIC = Y.a min(1,b/norm(Y.i)), Y.* = A.* Lambda - a.* + ## and optIC = Y.a min(1,b/norm(Y.i)), Y.* = A.* Lambda - a.* + ## or "all" then all LMs are plotted ## basedir: Oberverzeichnis des r-forge svn checkouts + ## gridRestriction: an expression that can be used as index in xi[gridRestriction] + ## to restrict the plotted grid-values + ## prehook: an expression to be evaluated before plotting --- typically something + ## like pdf("myfile.pdf") + ## posthook: an expression to be evaluated after plotting --- typically something + ## like dev.off() + ## withSmooth: logical shall item grid or gridS be used for plotting file <- file.path(baseDir, "branches/robast-0.9/pkg/RobAStRDA/R/sysdata.rda") if(!file.exists(file)) stop("Fehler mit Checkout") nE <- new.env() Modified: branches/robast-0.9/pkg/RobExtremes/man/internal-interpolate.Rd =================================================================== --- branches/robast-0.9/pkg/RobExtremes/man/internal-interpolate.Rd 2013-03-14 12:50:49 UTC (rev 633) +++ branches/robast-0.9/pkg/RobExtremes/man/internal-interpolate.Rd 2013-03-15 07:53:46 UTC (rev 634) @@ -32,10 +32,10 @@ .getLMGrid(xiGrid = getShapeGrid(), PFam = GParetoFamily(scale=1,shape=2), optFct = .RMXE.xi, GridFileName="LMGrid.Rdata", withPrint = FALSE) -.svInt(optF = .RMXE.th, xiGrid = getShapeGrid(500, cutoff.at.0=0.005), +.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 = 50, - tol = .Machine$double.eps^0.4, loRad = 0, upRad = Inf, loRad0 = 1e-3, + lower = 1e-4, OptOrIter = "iterate", maxiter = 150, + tol = .Machine$double.eps^0.5, loRad = 0, upRad = Inf, loRad0 = 1e-3, withStartLM = TRUE) .generateInterpGridSn(xiGrid = getShapeGrid(500, cutoff.at.0=0.005), Modified: branches/robast-0.9/pkg/RobExtremesBuffer/interpolRisk-Test.R =================================================================== [TRUNCATED] To get the complete diff run: svnlook diff /svnroot/robast -r 634 From noreply at r-forge.r-project.org Fri Mar 15 13:27:10 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 15 Mar 2013 13:27:10 +0100 (CET) Subject: [Robast-commits] r635 - in branches/robast-0.9/pkg: ROptEst/R ROptEst/man RobExtremes/R RobExtremes/inst/AddMaterial/interpolation RobExtremes/man Message-ID: <20130315122710.B5FBB18450D@r-forge.r-project.org> Author: ruckdeschel Date: 2013-03-15 13:27:10 +0100 (Fri, 15 Mar 2013) New Revision: 635 Modified: branches/robast-0.9/pkg/ROptEst/R/interpolLM.R branches/robast-0.9/pkg/ROptEst/R/radiusMinimaxIC.R branches/robast-0.9/pkg/ROptEst/man/internal-interpolate.Rd branches/robast-0.9/pkg/ROptEst/man/radiusMinimaxIC.Rd branches/robast-0.9/pkg/RobExtremes/R/AllClass.R branches/robast-0.9/pkg/RobExtremes/R/Expectation.R branches/robast-0.9/pkg/RobExtremes/R/interpolLM.R branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/interpolationscripts.R branches/robast-0.9/pkg/RobExtremes/man/E.Rd branches/robast-0.9/pkg/RobExtremes/man/internal-interpolate.Rd Log: (1) for GammaFamily: in RobExtremes overloaded E() method by quantile-trick integration (2) radiusMinimaxIC gains arguments loRad.s upRad.s to have different search intervals for inner and outer optimization in RMX -> leave inner range as [0,Inf] and in the sequence of xi-grid values only search in [r.old/1.4, r.old*1.4] in the outer optimization where r.old is lf radius from the previous grid value. (3) as both edges can be critic => start from median grid-value and first go from there to left edge and then from there to right edge (and afterwards reorder). Modified: branches/robast-0.9/pkg/ROptEst/R/interpolLM.R =================================================================== --- branches/robast-0.9/pkg/ROptEst/R/interpolLM.R 2013-03-15 07:53:46 UTC (rev 634) +++ branches/robast-0.9/pkg/ROptEst/R/interpolLM.R 2013-03-15 12:27:10 UTC (rev 635) @@ -11,8 +11,11 @@ tol = tol, warn = FALSE, loRad0 = loRad0, returnNAifProblem = TRUE) if(is.na(IC)) return(NA) + txt <- "least favorable radius:" + wL <- grepl(txt, Infos(IC)[,"message"]) + rad <- as.numeric(gsub(txt, "", Infos(IC)[wL,"message"])) return(list(b=clip(IC), a=cent(IC), a.w = cent(weight(IC)), - A=stand(IC), A.w = stand(weight(IC)))) + A=stand(IC), A.w = stand(weight(IC)), rad=rad)) } .MBRE.th <- function(th, PFam, modifyfct, @@ -20,7 +23,7 @@ lower = 1e-4, OptOrIter = "iterate", maxiter = 50, tol = .Machine$double.eps^0.4, ...){ PFam <- modifyfct(th,PFam) - RobM <- InfRobModel(center = PFam, neighbor = ContNeighborhood(radius = 15)) + RobM <- InfRobModel(center = PFam, neighbor = ContNeighborhood(radius = 6)) IC <- optIC(model = RobM, risk = asBias(), verbose = FALSE, z.start = z.start, A.start = A.start, upper = upper, lower = lower, OptOrIter = OptOrIter, @@ -57,13 +60,20 @@ upper = 1e4, lower = 1e-4, OptOrIter = "iterate", maxiter = 50, tol = .Machine$double.eps^0.4, loRad = 0, upRad = Inf, loRad0 = 1e-3, + loRad.s=0.2, up.Rad.s=1, withStartLM = TRUE ){ wprint <- function(...){ if (withPrint) print(...)} thGrid <- unique(sort(thGrid)) + lG <- length(thGrid) + lG2 <- lG%/%2 + olG <- c(lG2:1,(lG2+1):lG) + thGrid <- thGrid[olG] itLM <- 0 - z.start <- NULL - A.start <- NULL + z1 <- z.start <- NULL + A1 <- A.start <- NULL + r1l <- r.start.l <- NULL + r1u <- r.start.u <- NULL getLM <- function(th){ itLM <<- itLM + 1 if(withPrint) cat("Evaluation Nr.", itLM," at th = ",th,"\n") @@ -72,17 +82,35 @@ z.start = z.start, A.start = A.start, upper = upper, lower = lower, OptOrIter = OptOrIter, maxiter = maxiter, tol = tol, - loRad = loRad, upRad = upRad, loRad0 = loRad0), + loRad = loRad, upRad = upRad, loRad0 = loRad0, + loRad.s = r.start.l, upRad.s = r.start.u), silent=TRUE) print(a) print(A.start) print(z.start) + print(c(r.start.l,r.start.u)) if(is(a,"try-error")|any(is.na(a))){ a <- rep(NA,13)}else{ if(withStartLM){ - pdim <- length(a[["a"]]) - kdim <- length(a[["a.w"]]) + if(itLM==1){ + z1 <<- a[["a.w"]] + A1 <<- a[["A"]] + if(!is.null(a$rad)){ + r1l <<- max(a[["rad"]]/1.3,loRad) + r1u <<- min(a[["rad"]]*1.3,upRad) + } + } z.start <<- a[["a.w"]] - A.start <<- matrix(a[["A"]],pdim,kdim) + A.start <<- a[["A"]] + if(!is.null(a$rad)){ + r.start.l <<- max(a[["rad"]]/1.3,loRad) + r.start.u <<- min(a[["rad"]]*1.3,upRad) + } + if(itLM==lG2){ + z.start <<- z1 + A.start <<- A1 + r.start.l <<- r1l + r.start.u <<- r1u + } a <- c(a[["b"]],a[["a"]],a[["a.w"]],a[["A"]],a[["A.w"]]) } } Modified: branches/robast-0.9/pkg/ROptEst/R/radiusMinimaxIC.R =================================================================== --- branches/robast-0.9/pkg/ROptEst/R/radiusMinimaxIC.R 2013-03-15 07:53:46 UTC (rev 634) +++ branches/robast-0.9/pkg/ROptEst/R/radiusMinimaxIC.R 2013-03-15 12:27:10 UTC (rev 635) @@ -9,7 +9,8 @@ A.start = NULL, upper = NULL, lower = NULL, OptOrIter = "iterate", maxiter = 50, tol = .Machine$double.eps^0.4, warn = FALSE, - verbose = NULL, loRad0 = 1e-3, ..., returnNAifProblem = FALSE){ + verbose = NULL, loRad0 = 1e-3, ..., returnNAifProblem = FALSE, + loRad.s = NULL, upRad.s = NULL){ if(missing(verbose)|| is.null(verbose)) verbose <- getRobAStBaseOption("all.verbose") ow <- options("warn") @@ -20,6 +21,7 @@ stop("'upRad' is not of length == 1") if(loRad >= upRad) stop("'upRad < loRad' is not fulfilled") + biastype <- biastype(risk) L2derivDim <- numberOfMaps(L2Fam at L2deriv) trafo <- trafo(L2Fam at param) @@ -160,8 +162,9 @@ } } - lower <- max(loRad, loRad0) - upper <- if(upRad == Inf) max(lower+2, 4) else upRad + lower <- if(is.null(loRad.s)) max(loRad, loRad0) else loRad.s + upper <- if(is.null(upRad.s)) { + if(upRad == Inf) max(lower+2, 4) else upRad } else upRad.s leastFavR <- try( uniroot(fct.Ie, lower = lower, upper = upper, tol = .Machine$double.eps^0.25)$root , silent = TRUE) Modified: branches/robast-0.9/pkg/ROptEst/man/internal-interpolate.Rd =================================================================== --- branches/robast-0.9/pkg/ROptEst/man/internal-interpolate.Rd 2013-03-15 07:53:46 UTC (rev 634) +++ branches/robast-0.9/pkg/ROptEst/man/internal-interpolate.Rd 2013-03-15 12:27:10 UTC (rev 635) @@ -38,7 +38,7 @@ upper = 1e4, lower = 1e-4, OptOrIter = "iterate", maxiter = 50, tol = .Machine$double.eps^0.4, loRad = 0, upRad = Inf, loRad0 = 1e-3, - withStartLM = TRUE) + loRad.s = 0.2, up.Rad.s = 1, withStartLM = TRUE) .saveGridToCSV(Grid, toFileCSV, namPFam, nameInSysdata) @@ -62,8 +62,19 @@ \item{radius}{ [for OMSE]: positive numeric of length 1: the radius of the neighborhood for which the LM's are to be computed; defaults to 0.5. } - \item{loRad}{ the lower end point of the interval to be searched. } - \item{upRad}{ the upper end point of the interval to be searched. } + \item{loRad}{ the lower end point of the interval to be searched + in the inner optimization (for the least favorable situation + to the user-guessed radius). } + \item{upRad}{ the upper end point of the interval to be searched in the + inner optimization (for the least favorable situation + to the user-guessed radius). } + \item{loRad.s}{ the lower end point of the interval + to be searched in the outer optimization + (for the user-guessed radius); if \code{NULL} + set to \code{loRad} in the algorithm. } + \item{upRad.s}{ the upper end point of the interval to be searched in the + outer optimization (for the user-guessed radius); if + \code{NULL} set to \code{upRad} in the algorithm. } \item{z.start}{ initial value for the centering constant. } \item{A.start}{ initial value for the standardizing matrix. } \item{upper}{ upper bound for the optimal clipping bound. } Modified: branches/robast-0.9/pkg/ROptEst/man/radiusMinimaxIC.Rd =================================================================== --- branches/robast-0.9/pkg/ROptEst/man/radiusMinimaxIC.Rd 2013-03-15 07:53:46 UTC (rev 634) +++ branches/robast-0.9/pkg/ROptEst/man/radiusMinimaxIC.Rd 2013-03-15 12:27:10 UTC (rev 635) @@ -15,14 +15,18 @@ upper = NULL, lower = NULL, OptOrIter = "iterate", maxiter = 50, tol = .Machine$double.eps^0.4, warn = FALSE, verbose = NULL, loRad0 = 1e-3, ..., - returnNAifProblem = FALSE) + returnNAifProblem = FALSE, loRad.s = NULL, upRad.s = NULL) } \arguments{ \item{L2Fam}{ L2-differentiable family of probability measures. } \item{neighbor}{ object of class \code{"Neighborhood"}. } \item{risk}{ object of class \code{"RiskType"}. } - \item{loRad}{ the lower end point of the interval to be searched. } - \item{upRad}{ the upper end point of the interval to be searched. } + \item{loRad}{ the lower end point of the interval to be searched + in the inner optimization (for the least favorable situation + to the user-guessed radius). } + \item{upRad}{ the upper end point of the interval to be searched in the + inner optimization (for the least favorable situation + to the user-guessed radius). } \item{z.start}{ initial value for the centering constant. } \item{A.start}{ initial value for the standardizing matrix. } \item{upper}{ upper bound for the optimal clipping bound. } @@ -46,6 +50,13 @@ \item{returnNAifProblem}{logical (of length 1): if \code{TRUE} (not the default), in case of convergence problems in the algorithm, returns \code{NA}. } + \item{loRad.s}{ the lower end point of the interval + to be searched in the outer optimization + (for the user-guessed radius); if \code{NULL} (default) + set to \code{loRad} in the algorithm. } + \item{upRad.s}{ the upper end point of the interval to be searched in the + outer optimization (for the user-guessed radius); if + \code{NULL} (default) set to \code{upRad} in the algorithm. } } \details{ In case the neighborhood radius is unknown, Rieder et al. (2001, 2008) Modified: branches/robast-0.9/pkg/RobExtremes/R/AllClass.R =================================================================== --- branches/robast-0.9/pkg/RobExtremes/R/AllClass.R 2013-03-15 07:53:46 UTC (rev 634) +++ branches/robast-0.9/pkg/RobExtremes/R/AllClass.R 2013-03-15 12:27:10 UTC (rev 635) @@ -235,7 +235,7 @@ ### for integration: setClassUnion("DistributionsIntegratingByQuantiles", - c("Weibull", "GEV", "GPareto", "Pareto")) + c("Weibull", "GEV", "GPareto", "Pareto", "Gammad")) ## models: Modified: branches/robast-0.9/pkg/RobExtremes/R/Expectation.R =================================================================== --- branches/robast-0.9/pkg/RobExtremes/R/Expectation.R 2013-03-15 07:53:46 UTC (rev 634) +++ branches/robast-0.9/pkg/RobExtremes/R/Expectation.R 2013-03-15 12:27:10 UTC (rev 635) @@ -150,3 +150,7 @@ signature(object = "DistributionsIntegratingByQuantiles", fun = "function", cond = "missing"))) +setMethod("E", signature(object = "Gammad", fun = "function", cond = "missing"), + getMethod("E", + signature(object = "DistributionsIntegratingByQuantiles", + fun = "function", cond = "missing"))) Modified: branches/robast-0.9/pkg/RobExtremes/R/interpolLM.R =================================================================== --- branches/robast-0.9/pkg/RobExtremes/R/interpolLM.R 2013-03-15 07:53:46 UTC (rev 634) +++ branches/robast-0.9/pkg/RobExtremes/R/interpolLM.R 2013-03-15 12:27:10 UTC (rev 635) @@ -37,6 +37,7 @@ 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){ namF <- gsub("\\.th$","",paste(deparse(substitute(optF)))) namF <- gsub("^\\.(.+)","\\1",namF) @@ -50,7 +51,8 @@ nameInSysdata = namF, withPrint = TRUE, radius = radius, upper = upper, lower = lower, OptOrIter = OptOrIter, maxiter = maxiter, tol = tol, loRad = loRad, upRad = upRad, - loRad0 = loRad0, withStartLM = withStartLM) + loRad0 = loRad0, loRad.s = loRad.s, up.Rad.s = up.Rad.s, + withStartLM = withStartLM) } Modified: branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/interpolationscripts.R =================================================================== --- branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/interpolationscripts.R 2013-03-15 07:53:46 UTC (rev 634) +++ branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/interpolationscripts.R 2013-03-15 12:27:10 UTC (rev 635) @@ -21,11 +21,11 @@ #PF <- WeibullFamily() ### .svInt <- RobExtremes:::.svInt -.svInt1 <- function(){ - RobExtremes:::.generateInterpGridSn(PFam = PF)} +#.svInt1 <- function(){ +# RobExtremes:::.generateInterpGridSn(PFam = PF)} ## to make this parallel, start this on several processors #.svInt1() -.svInt(.OMSE.th, PFam=PF) -.svInt(.MBRE.th, PFam=PF) +#.svInt(.OMSE.th, PFam=PF) +#.svInt(.MBRE.th, PFam=PF) .svInt(.RMXE.th, PFam=PF) setwd(oldwd) Modified: branches/robast-0.9/pkg/RobExtremes/man/E.Rd =================================================================== --- branches/robast-0.9/pkg/RobExtremes/man/E.Rd 2013-03-15 07:53:46 UTC (rev 634) +++ branches/robast-0.9/pkg/RobExtremes/man/E.Rd 2013-03-15 12:27:10 UTC (rev 635) @@ -10,6 +10,8 @@ \alias{E,Weibull,function,missing-method} \alias{E,GEV,missing,missing-method} \alias{E,Pareto,missing,missing-method} +\alias{E,Gammad,function,missing-method} +\alias{E,Pareto,function,missing-method} \title{Generic Function for the Computation of (Conditional) Expectations} \description{ Modified: branches/robast-0.9/pkg/RobExtremes/man/internal-interpolate.Rd =================================================================== --- branches/robast-0.9/pkg/RobExtremes/man/internal-interpolate.Rd 2013-03-15 07:53:46 UTC (rev 634) +++ branches/robast-0.9/pkg/RobExtremes/man/internal-interpolate.Rd 2013-03-15 12:27:10 UTC (rev 635) @@ -36,7 +36,7 @@ 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, - withStartLM = TRUE) + loRad.s = 0.2, up.Rad.s = 1, withStartLM = TRUE) .generateInterpGridSn(xiGrid = getShapeGrid(500, cutoff.at.0=0.005), PFam = GParetoFamily(), withPrint = TRUE) @@ -66,8 +66,19 @@ \item{radius}{ [for OMSE]: positive numeric of length 1: the radius of the neighborhood for which the LM's are to be computed; defaults to 0.5. } - \item{loRad}{ the lower end point of the interval to be searched. } - \item{upRad}{ the upper end point of the interval to be searched. } + \item{loRad}{ the lower end point of the interval to be searched + in the inner optimization (for the least favorable situation + to the user-guessed radius). } + \item{upRad}{ the upper end point of the interval to be searched in the + inner optimization (for the least favorable situation + to the user-guessed radius). } + \item{loRad.s}{ the lower end point of the interval + to be searched in the outer optimization + (for the user-guessed radius); if \code{NULL} + set to \code{loRad} in the algorithm. } + \item{upRad.s}{ the upper end point of the interval to be searched in the + outer optimization (for the user-guessed radius); if + \code{NULL} set to \code{upRad} in the algorithm. } \item{upper}{ upper bound for the optimal clipping bound. } \item{lower}{ lower bound for the optimal clipping bound. } \item{OptOrIter}{character; which method to be used for determining Lagrange From noreply at r-forge.r-project.org Fri Mar 15 15:12:32 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 15 Mar 2013 15:12:32 +0100 (CET) Subject: [Robast-commits] r636 - branches/robast-0.9/pkg/ROptEst/R Message-ID: <20130315141232.4410D184EC7@r-forge.r-project.org> Author: ruckdeschel Date: 2013-03-15 15:12:31 +0100 (Fri, 15 Mar 2013) New Revision: 636 Modified: branches/robast-0.9/pkg/ROptEst/R/interpolLM.R Log: ROptEst: yet some small bug in interpolLM.R (Aw instead of A.w in MBRE.th) Modified: branches/robast-0.9/pkg/ROptEst/R/interpolLM.R =================================================================== --- branches/robast-0.9/pkg/ROptEst/R/interpolLM.R 2013-03-15 12:27:10 UTC (rev 635) +++ branches/robast-0.9/pkg/ROptEst/R/interpolLM.R 2013-03-15 14:12:31 UTC (rev 636) @@ -10,7 +10,7 @@ OptOrIter = OptOrIter, maxiter = maxiter, tol = tol, warn = FALSE, loRad0 = loRad0, returnNAifProblem = TRUE) - if(is.na(IC)) return(NA) + if(!is(IC,"IC")) if(is.na(IC)) return(NA) txt <- "least favorable radius:" wL <- grepl(txt, Infos(IC)[,"message"]) rad <- as.numeric(gsub(txt, "", Infos(IC)[wL,"message"])) @@ -29,11 +29,11 @@ lower = lower, OptOrIter = OptOrIter, maxiter = maxiter, tol = tol, warn = TRUE, noLow = FALSE, .withEvalAsVar = FALSE, returnNAifProblem = TRUE) - if(is.na(IC)) return(NA) + if(!is(IC,"IC")) if(is.na(IC)) return(NA) mA <- max(stand(IC)) mAw <- max(stand(weight(IC))) - return(list(b=clip(IC), a=cent(IC), aw=cent(weight(IC)), - A=stand(IC)/mA, Aw=stand(weight(IC))/mAw)) + return(list(b=clip(IC), a=cent(IC), a.w=cent(weight(IC)), + A=stand(IC)/mA, A.w=stand(weight(IC))/mAw)) } .OMSE.th <- function(th, PFam, modifyfct, radius = 0.5, @@ -48,7 +48,7 @@ lower = lower, OptOrIter = OptOrIter, maxiter = maxiter, tol = tol, warn = TRUE, noLow = FALSE, .withEvalAsVar = FALSE, returnNAifProblem = TRUE) - if(is.na(IC)) return(NA) + if(!is(IC,"IC")) if(is.na(IC)) return(NA) res=list(b=clip(IC), a=cent(IC), a.w = cent(weight(IC)), A=stand(IC), A.w = stand(weight(IC))) return(res) @@ -114,6 +114,7 @@ a <- c(a[["b"]],a[["a"]],a[["a.w"]],a[["A"]],a[["A.w"]]) } } + print(a) return(a) } From noreply at r-forge.r-project.org Sat Mar 16 12:25:55 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sat, 16 Mar 2013 12:25:55 +0100 (CET) Subject: [Robast-commits] r637 - in branches/robast-0.9/pkg: ROptEst/R RobAStRDA/R RobAStRDA/man RobExtremes/R RobExtremes/inst/AddMaterial/interpolation RobExtremesBuffer Message-ID: <20130316112555.20F01183B91@r-forge.r-project.org> Author: ruckdeschel Date: 2013-03-16 12:25:54 +0100 (Sat, 16 Mar 2013) New Revision: 637 Modified: branches/robast-0.9/pkg/ROptEst/R/interpolLM.R branches/robast-0.9/pkg/RobAStRDA/R/interpolAux.R branches/robast-0.9/pkg/RobAStRDA/R/sysdata.rda branches/robast-0.9/pkg/RobAStRDA/man/internal-interpolate.Rd branches/robast-0.9/pkg/RobExtremes/R/interpolLM.R branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/interpolationscripts.R branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/plotInterpol.R branches/robast-0.9/pkg/RobExtremesBuffer/interpolMBREGEVFamily.csv branches/robast-0.9/pkg/RobExtremesBuffer/interpolMBREGammafamily.csv branches/robast-0.9/pkg/RobExtremesBuffer/interpolMBREGeneralizedParetoFamily.csv branches/robast-0.9/pkg/RobExtremesBuffer/interpolMBREWeibullFamily.csv branches/robast-0.9/pkg/RobExtremesBuffer/interpolOMSEGEVFamily.csv branches/robast-0.9/pkg/RobExtremesBuffer/interpolOMSEGammafamily.csv branches/robast-0.9/pkg/RobExtremesBuffer/interpolOMSEGeneralizedParetoFamily.csv branches/robast-0.9/pkg/RobExtremesBuffer/interpolOMSEWeibullFamily.csv branches/robast-0.9/pkg/RobExtremesBuffer/interpolRMXEGeneralizedParetoFamily.csv Log: All but 3 grids recomputed (with NA-entries omitted); only .RMXE-Gamma,-Weibull,-GEV are not yet redone. On first inspection they have improved a lot, but still, some have to be smoothed ... RobAStRDA: Smoothing parameter df of .MakeSmoothGridList can now be adjusted coordinatewise, and smoothing can be restricted to specific thGrid values by argument gridRestrForSmooth -- see ?.MakeSmoothGridList plotInterpol gains functionality for interactive try out of smoothing parameters Modified: branches/robast-0.9/pkg/ROptEst/R/interpolLM.R =================================================================== --- branches/robast-0.9/pkg/ROptEst/R/interpolLM.R 2013-03-15 14:12:31 UTC (rev 636) +++ branches/robast-0.9/pkg/ROptEst/R/interpolLM.R 2013-03-16 11:25:54 UTC (rev 637) @@ -172,7 +172,7 @@ getFun = .getLMGrid, ..., modifyfct, nameInSysdata, GridFileName, withPrint = TRUE){ if(missing(GridFileName)) - GridFileName <- paste(sub("^\\.(.+)","\\1",nameInSysdata),".Rdata",sep="") + GridFileName <- paste(gsub("^\\.(.+)","\\1",nameInSysdata),".Rdata",sep="") Grid <- getFun(thGrid = thGrid, PFam = PFam, ..., modifyfct = modifyfct, withPrint = withPrint, GridFileName = GridFileName) .saveGridToCSV(Grid,toFileCSV,name(PFam),nameInSysdata) Modified: branches/robast-0.9/pkg/RobAStRDA/R/interpolAux.R =================================================================== --- branches/robast-0.9/pkg/RobAStRDA/R/interpolAux.R 2013-03-15 14:12:31 UTC (rev 636) +++ branches/robast-0.9/pkg/RobAStRDA/R/interpolAux.R 2013-03-16 11:25:54 UTC (rev 637) @@ -2,11 +2,25 @@ paste(sep="", name, if(getRversion()<"2.16") ".O" else ".N") } -.MakeSmoothGridList <- function(thGrid, Y, df=NULL){ +.MakeSmoothGridList <- function(thGrid, Y, df = NULL, + gridRestrForSmooth = NULL){ if(length(dim(Y))==3) LMGrid <- Y[,1,,drop=TRUE] else LMGrid <- Y[,drop=FALSE] + if(!is.null(df)){ + df0 <- vector("list",ncol(LMGrid)) + if(is.numeric(df)){ + df <- rep(df,length.out=ncol(LMGrid)) + for(i in 1:ncol(LMGrid)) df0[[i]] <- df[i] + df <- df0 + } + }else{ + df0 <- vector("list",ncol(LMGrid)+1) + df0[[ncol(LMGrid)+1]] <- NULL + df <- df0 + } + iNA <- apply(LMGrid,1, function(u) any(is.na(u))) LMGrid <- LMGrid[!iNA,,drop=FALSE] thGrid <- thGrid[!iNA] @@ -14,9 +28,33 @@ thGrid <- thGrid[oG] LMGrid <- LMGrid[oG,,drop=FALSE] - LMGrid <- apply(LMGrid,2,function(u) if(is.null(df)) - smooth.spline(thGrid,u)$y else smooth.spline(thGrid,u,df=df)$y - ) + if(is.null(gridRestrForSmooth)) + gridRestrForSmooth <- as.data.frame(matrix(TRUE,nrow(LMGrid),ncol(LMGrid))) + if((is.vector(gridRestrForSmooth)&&!is.list(gridRestrForSmooth))|| + is.matrix(gridRestrForSmooth)) + gridRestrForSmooth <- as.data.frame(gridRestrForSmooth) + + if(is.list(gridRestrForSmooth)){ + gm <- vector("list",ncol(LMGrid)) + idx <- rep(1:length(gridRestrForSmooth), length.out=ncol(LMGrid)) + for (i in 1:ncol(LMGrid)){ + if(!is.null(gridRestrForSmooth[[idx[i]]])){ + gm[[i]] <- gridRestrForSmooth[[idx[i]]] + }else{ + gm[[i]] <- rep(TRUE,nrow(LMGrid)) + } + } + gridRestrForSmooth <- gm + } + + for(i in 1:ncol(LMGrid)){ + gmi <- gridRestrForSmooth[[i]] + if(is.null(df[[i]])){ + LMGrid[gmi,i] <- smooth.spline(thGrid[gmi],LMGrid[gmi,i])$y + } else { + LMGrid[gmi,i] <- smooth.spline(thGrid[gmi],LMGrid[gmi,i],df=df[[i]])$y + } + } return(cbind(xi=thGrid,LM=LMGrid)) } @@ -86,7 +124,8 @@ ############################################################################ .saveGridToRda <- function(fromFileCSV, toFileRDA = "sysdata.rda", withMerge =FALSE, withPrint = TRUE, - withSmooth = TRUE, df = NULL){ + withSmooth = TRUE, df = NULL, + gridRestrForSmooth = NULL){ ### check whether input is complete if(missing(fromFileCSV)) stop("You must specify argument 'fromFileCSV'.") @@ -96,7 +135,6 @@ ## and new grids newEnv <- new.env() - ### determine what objects already exist in sysdata.rda - type file if(file.exists(toFileRDA)){ load(file=toFileRDA,envir=newEnv) @@ -137,13 +175,13 @@ if(withSmooth) InterpGrids[[namPFam]]$gridS <- .MakeSmoothGridList(gr0[,1],gr0[,-1,drop=FALSE], - df = df) + df = df, gridRestrForSmooth = gridRestrForSmooth) cat(gettext("Grid successfully merged.\n")) }else{ InterpGrids[[namPFam]]$grid <- Grid InterpGrids[[namPFam]]$gridS <- .MakeSmoothGridList(Grid[,1],Grid[,-1,drop=FALSE], - df = df) + df = df, gridRestrForSmooth = gridRestrForSmooth) cat(gettext("Grid successfully overwritten.\n")) } l.ng <- -1 @@ -158,7 +196,8 @@ if(l.ng>0){ ## a new family is entered InterpGrids[[l.ng]]$grid <- Grid InterpGrids[[l.ng]]$gridS <- - .MakeSmoothGridList(Grid[,1], Grid[,-1,drop = FALSE], df = df) + .MakeSmoothGridList(Grid[,1], Grid[,-1,drop = FALSE], + df = df, gridRestrForSmooth = gridRestrForSmooth) cat(gettext("New Grid successfully produced.\n")) names(InterpGrids)[l.ng] <- namPFam } @@ -257,7 +296,8 @@ } .copy_smoothGrid <- function(gridEntry = NULL, rdafileOld, gridnamOld, FamnamOld, - rdafileNew, gridnamNew, FamnamNew, withSmooth = FALSE, df = NULL){ + rdafileNew, gridnamNew, FamnamNew, withSmooth = FALSE, + df = NULL, gridRestrForSmooth = NULL){ if(missing(rdafileOld)) stop("Argument 'rdafileOld' must not be missing.") if(missing(gridnamOld)) stop("Argument 'gridnamOld' must not be missing.") @@ -273,7 +313,8 @@ gridEntry <- gr[[FamnamOld]]$grid else gr[[FamnamNew]]$grid <- gridEntry if(withSmooth){ gr[[FamnamNew]]$gridS <- .MakeSmoothGridList(gridEntry[,1], - gridEntry[,-1, drop = FALSE], df = df) + gridEntry[,-1, drop = FALSE], df = df, + gridRestrForSmooth = gridRestrForSmooth) }else gr[[FamnamNew]]$gridS <- NULL assign(gridnamNew,gr,envir=nE) what <- ls(envir=nE, all.names = TRUE) Modified: branches/robast-0.9/pkg/RobAStRDA/R/sysdata.rda =================================================================== (Binary files differ) Modified: branches/robast-0.9/pkg/RobAStRDA/man/internal-interpolate.Rd =================================================================== --- branches/robast-0.9/pkg/RobAStRDA/man/internal-interpolate.Rd 2013-03-15 14:12:31 UTC (rev 636) +++ branches/robast-0.9/pkg/RobAStRDA/man/internal-interpolate.Rd 2013-03-16 11:25:54 UTC (rev 637) @@ -23,14 +23,15 @@ \usage{ .versionSuff(name) -.MakeSmoothGridList(thGrid, Y, df=NULL) +.MakeSmoothGridList(thGrid, Y, df = NULL, gridRestrForSmooth = NULL) .readGridFromCSV(fromFileCSV) .generateInterpolators(Grid, approxOrspline = "spline", extrapol = c(NA,NA)) .saveGridToRda(fromFileCSV, toFileRDA = "sysdata.rda", withMerge = FALSE, - withPrint = TRUE, withSmooth = TRUE, df = NULL) + withPrint = TRUE, withSmooth = TRUE, df = NULL, + gridRestrForSmooth = NULL) .mergeGrid(Grid1, Grid2) @@ -44,7 +45,8 @@ excludeGrids = NULL, excludeNams = NULL) .copy_smoothGrid(gridEntry = NULL, rdafileOld, gridnamOld, FamnamOld, rdafileNew, - gridnamNew, FamnamNew, withSmooth = FALSE, df = NULL) + gridnamNew, FamnamNew, withSmooth = FALSE, df = NULL, + gridRestrForSmooth = NULL) .renameGridName(rdafileOld, gridnamOld, FamnamOld, rdafileNew, gridnamNew, FamnamNew) @@ -59,7 +61,19 @@ contains precomputed y-values, so that call to \code{getFun} resp. \code{optFct} can be omitted. } \item{df}{argument \code{df} of \code{\link{smooth.spline}}; if \code{NULL} - (default) it is omitted; controls the degree to which we smooth.} + (default) it is omitted (and the default of + \code{\link{smooth.spline}} used); controls the degree to which + we smooth; can be vectorized; to allow for \code{NULL}-entries + in some (of the 13) LMs, it can also be a list of length 13, + some entries being \code{NULL}, some numeric. } + \item{gridRestrForSmooth}{an expression that can be used as index in + \code{theta[gridRestrForSmooth]} to restrict the grid-values to + be smoothed; the excluded grid values are left unchanged. If the argument + is \code{NULL} no restriction is used. Can be a matrix of same dimension + as the \code{Y}-grid to allow for column-individual restrictions, + or a list of same length as number of columns of \code{Y} + with columnwise restrictions of \code{Y} (and \code{NULL} entries + are interpreted as no restriction). } \item{fromFileCSV}{character; names of the csv files from which the grids are read. } \item{Grid, gridEntry}{matrix; grid to be used. } Modified: branches/robast-0.9/pkg/RobExtremes/R/interpolLM.R =================================================================== --- branches/robast-0.9/pkg/RobExtremes/R/interpolLM.R 2013-03-15 14:12:31 UTC (rev 636) +++ branches/robast-0.9/pkg/RobExtremes/R/interpolLM.R 2013-03-16 11:25:54 UTC (rev 637) @@ -40,7 +40,7 @@ loRad.s=0.2, up.Rad.s=1, withStartLM = TRUE){ namF <- gsub("\\.th$","",paste(deparse(substitute(optF)))) - namF <- gsub("^\\.(.+)","\\1",namF) + namF <- gsub(" ", "",namF)) to <- gsub("XXXX",gsub(" ","",name(PFam)), gsub("YYYY", namF, "interpolYYYYXXXX.csv")) print(to) Modified: branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/interpolationscripts.R =================================================================== --- branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/interpolationscripts.R 2013-03-15 14:12:31 UTC (rev 636) +++ branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/interpolationscripts.R 2013-03-16 11:25:54 UTC (rev 637) @@ -25,7 +25,7 @@ # RobExtremes:::.generateInterpGridSn(PFam = PF)} ## to make this parallel, start this on several processors #.svInt1() -#.svInt(.OMSE.th, PFam=PF) +.svInt(.OMSE.th, PFam=PF, xiGrid = getShapeGrid(3, cutoff.at.0=0.005)) #.svInt(.MBRE.th, PFam=PF) .svInt(.RMXE.th, PFam=PF) setwd(oldwd) Modified: branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/plotInterpol.R =================================================================== --- branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/plotInterpol.R 2013-03-15 14:12:31 UTC (rev 636) +++ branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/plotInterpol.R 2013-03-16 11:25:54 UTC (rev 637) @@ -1,5 +1,7 @@ plotLM <- function(Gridnam,Famnam,whichLM, baseDir="C:/rtest/robast", - withSmooth=FALSE, gridRestriction = NULL, prehook={}, posthook={}, ...){ + withSmooth = FALSE, plotGridRestriction = NULL, + smoothtry = FALSE, df = NULL, gridRestrForSmooth = NULL, + prehook={}, posthook={}, ...){ ## Gridnam in (Sn,OMSE,RMXE,MBRE) ## uses partial matching!! ## Famnam in "Generalized Pareto Family", ## uses partial matching!! ## "GEV Family", @@ -13,14 +15,41 @@ # (A12.i+A21.i)/2,A.22.i), 2, 2), ## and optIC = Y.a min(1,b/norm(Y.i)), Y.* = A.* Lambda - a.* ## or "all" then all LMs are plotted - ## basedir: Oberverzeichnis des r-forge svn checkouts - ## gridRestriction: an expression that can be used as index in xi[gridRestriction] - ## to restrict the plotted grid-values + ## basedir: folder with r-forge svn checkout + ## plotGridRestriction: an expression that can be used as index in + ## xi[plotGridRestriction] to restrict the plotted + ## grid-values ## prehook: an expression to be evaluated before plotting --- typically something ## like pdf("myfile.pdf") ## posthook: an expression to be evaluated after plotting --- typically something ## like dev.off() - ## withSmooth: logical shall item grid or gridS be used for plotting + ## withSmooth: logical; shall item grid or gridS be used for plotting + ## --------------------------- + ### for interactive try-out of several smoothing values + ## + ## smoothtry: logical; shall interactive try-out of smoothing be used + ## if TRUE overrides withSmooth + ## df: smoothing parameter (see below) + ## gridRestrForSmooth: restriction of smoothing for particular theta-grid-values + ## (see below) + ### + ## copied from help to .MakeSmoothGridList + ## +# \item{df}{argument \code{df} of \code{\link{smooth.spline}}; if \code{NULL} +# (default) it is omitted (and the default of +# \code{\link{smooth.spline}} used); controls the degree to which +# we smooth; can be vectorized; to allow for \code{NULL}-entries +# in some (of the 13) LMs, it can also be a list of length 13, +# some entries being \code{NULL}, some numeric. } +# \item{gridRestrForSmooth}{an expression that can be used as index in +# \code{theta[gridRestrForSmooth]} to restrict the grid-values to +# be smoothed; the excluded grid values are left unchanged. If the argument +# is \code{NULL} no restriction is used. Can be a matrix of same dimension +# as the \code{Y}-grid to allow for column-individual restrictions, +# or a list of same length as number of columns of \code{Y} +# with columnwise restrictions of \code{Y} (and \code{NULL} entries +# are interpreted as no restriction). } + file <- file.path(baseDir, "branches/robast-0.9/pkg/RobAStRDA/R/sysdata.rda") if(!file.exists(file)) stop("Fehler mit Checkout") nE <- new.env() @@ -39,15 +68,23 @@ GN0 <- Gridnam; if(isSn) GN0 <- "SnGrids" GN <- paste(".",GN0,sep="") funN <- paste("fun",".",if(getRversion()<"2.16") "O" else "N",sep="") - gN <- if(withSmooth) "gridS" else "grid" - gr <- get(GN,envir=nE)[[Famnam0]][[gN]] - if(is.null(gridRestriction)) gridRestriction <- rep(TRUE, nrow(gr)) + if(!smoothtry){ + gN <- if(withSmooth) "gridS" else "grid" + gr <- get(GN,envir=nE)[[Famnam0]][[gN]] + }else{ + gr <- get(GN,envir=nE)[[Famnam0]][["grid"]] +# gr <- RobAStRDA:::.MakeSmoothGridList(gr[,1],gr[,-1], df = df, +# gridRestrForSmooth = gridRestrForSmooth) + gr <- .MakeSmoothGridList(gr[,1],gr[,-1], df = df, + gridRestrForSmooth = gridRestrForSmooth) + } + if(is.null(plotGridRestriction)) plotGridRestriction <- rep(TRUE, nrow(gr)) if(!isSn) if(whichLM!="all") if(whichLM<1 | whichLM>13) stop("Falsche Koordinate") if(!isSn) if(whichLM=="all"){ eval(prehook) par(mfrow=c(4,4)) for(i in 2:14) - plot(gr[gridRestriction,1], gr[gridRestriction,i], ...) + plot(gr[plotGridRestriction,1], gr[plotGridRestriction,i], ...) par(mfrow=c(1,1)) eval(posthook) return(invisible(NULL)) @@ -62,17 +99,19 @@ if(FALSE){ ## Examples -plotLM("OMSE","Gamma","all", type="l", gridR=-(1:20)) -plotLM("OMSE","Pareto","all", type="l", gridR=-(1:20)) -plotLM("OMSE","Gener","all", type="l", gridR=-(1:20)) -plotLM("OMSE","GEV","all", type="l", gridR=-(1:20)) -plotLM("OMSE","Wei","all", type="l", gridR=-(1:20)) -plotLM("MBRE","Wei","all", type="l", gridR=-(1:20)) -plotLM("MBRE","GE","all", type="l", gridR=-(1:20)) -plotLM("MBRE","Gene","all", type="l", gridR=-(1:20)) -plotLM("MBRE","Gam","all", type="l", gridR=-(1:20)) -plotLM("RMXE","Gam","all", type="l", gridR=-(1:20)) -plotLM("RMXE","Wei","all", type="l", gridR=-(1:20)) -plotLM("RMXE","Gene","all", type="l", gridR=-(1:20)) -plotLM("RMXE","GE","all", type="l", gridR=-(1:20)) +plotLM("OMSE","Gamma","all", type="l", plotG=-(1:8)) +plotLM("OMSE","Gener","all", type="l", plotG=-(1:8)) +plotLM("OMSE","GEV","all", type="l", plotG=-(1:8)) +plotLM("OMSE","Wei","all", type="l", plotG=-(1:8)) +plotLM("MBRE","Wei","all", type="l", plotG=-(1:8)) +plotLM("MBRE","GE","all", type="l", plotG=-(1:8)) +plotLM("MBRE","Gene","all", type="l", plotG=-(1:8)) +plotLM("MBRE","Gam","all", type="l", plotG=-(1:8)) +plotLM("RMXE","Gam","all", type="l", plotG=-(1:8)) +plotLM("RMXE","Wei","all", type="l", plotG=-(1:8)) +plotLM("RMXE","Gene","all", type="l", plotG=-(1:8)) +plotLM("RMXE","GE","all", type="l", plotG=-(1:8)) +plotLM("MBRE","GE","all", type="l") +plotLM("MBRE","GE","all", type="l", sm = TRUE, df = 10, gridR = -(1:15)) +plotLM("MBRE","GE","all", type="l", sm = TRUE, df = 4, gridR = -(1:15)) } \ No newline at end of file Modified: branches/robast-0.9/pkg/RobExtremesBuffer/interpolMBREGEVFamily.csv =================================================================== --- branches/robast-0.9/pkg/RobExtremesBuffer/interpolMBREGEVFamily.csv 2013-03-15 14:12:31 UTC (rev 636) +++ branches/robast-0.9/pkg/RobExtremesBuffer/interpolMBREGEVFamily.csv 2013-03-16 11:25:54 UTC (rev 637) @@ -1,492 +1,506 @@ -" 5.00000000000000010408e-03" " 1.81357633287360164864e+00" "-2.24449754695824399420e-01" "-1.47885705270914519227e-01" "-4.58921540973249220130e-01" "-1.81549049260172734588e-01" " 5.18224508955159923751e-01" "-7.33531573128324149158e-02" "-7.36695431812270096206e-02" " 1.00000000000000000000e+00" " 5.18224508955159923751e-01" "-7.33531573128324149158e-02" "-7.36695431812270096206e-02" " 1.00000000000000000000e+00" -" 2.14517304631997030029e-02" " 1.82170362017730180781e+00" "-2.21448911244242041541e-01" "-1.50355403686426691845e-01" "-4.55269605129110077613e-01" "-1.76720769852665327004e-01" " 5.08063065632790911152e-01" "-5.82186275198257746633e-02" "-5.77077143417919283253e-02" " 1.00000000000000000000e+00" " 5.08143619270839841384e-01" "-5.80051768448633583986e-02" "-5.81911274646265477828e-02" " 1.00000000000000000000e+00" -" 3.98406374501992024961e-02" " 1.83083370984061777342e+00" "-2.17035963582212471090e-01" "-1.51512983390812039364e-01" "-4.54345392222172295149e-01" "-1.72894960142815801163e-01" " 4.96136067101396682766e-01" "-4.74932769628111234317e-02" "-4.86195811306312300482e-02" " 1.00000000000000000000e+00" " 4.95936248408226754147e-01" "-4.77016787664086075460e-02" "-4.85995950036596374710e-02" " 1.00000000000000000000e+00" -" 4.27829746040001568375e-02" " 1.83229759826328653105e+00" "-2.16118212042312296539e-01" "-1.52374008396431198653e-01" "-4.52639888751594832161e-01" "-1.72932720214651891588e-01" " 4.94720174340536444912e-01" "-4.54195759788707867366e-02" "-4.51729009100261397203e-02" " 1.00000000000000000000e+00" " 4.94720174340536444912e-01" "-4.54195759788707867366e-02" "-4.51729009100261397203e-02" " 1.00000000000000000000e+00" -" 6.40397156295258174197e-02" " 1.84287543551152532828e+00" "-2.09674326233737051695e-01" "-1.54762162850679618753e-01" "-4.48045578614404638174e-01" "-1.66938935089539775003e-01" " 4.81144590091446000546e-01" "-2.80584353688964997786e-02" "-3.19411963298408749234e-02" " 1.00000000000000000000e+00" " 4.80470980864551755474e-01" "-2.87525051330816128203e-02" "-3.19533813366238497733e-02" " 1.00000000000000000000e+00" -" 7.96812749003984049923e-02" " 1.85070371763565866274e+00" "-2.08536238317104577478e-01" "-1.56919373979981485734e-01" "-4.45272376876807263191e-01" "-1.65208357534006367029e-01" " 4.76384421706800675889e-01" "-1.95038700097885028817e-02" "-2.00647499048494833140e-02" " 1.00000000000000000000e+00" " 4.75947149369317923373e-01" "-1.97086007479972957768e-02" "-2.02230671057971982119e-02" " 1.00000000000000000000e+00" -" 8.52248570399394278496e-02" " 1.85347985392406511274e+00" "-2.07900841379440981527e-01" "-1.57705602351155882435e-01" "-4.45456845353655817021e-01" "-1.64450967560591382322e-01" " 4.73547754619834226908e-01" "-1.47010272358679451588e-02" "-1.46008738936339865777e-02" " 1.00000000000000000000e+00" " 4.73190003587921015349e-01" "-1.54744589399295820464e-02" "-1.47551495011547725844e-02" " 1.00000000000000000000e+00" -" 1.06341241002067987687e-01" " 1.86407717660864613585e+00" "-2.04038293795141795206e-01" "-1.60749650474153876756e-01" "-4.40849240782102969050e-01" "-1.60979520513820612004e-01" " 4.62876655217478893967e-01" " 9.72114778390573863092e-05" "-8.42891877730452790569e-04" " 1.00000000000000000000e+00" " 4.62173942462537512554e-01" "-7.70146016848490032672e-05" "-1.28603273751948785943e-03" " 1.00000000000000000000e+00" -" 1.19521912350597614427e-01" " 1.87071107891449406324e+00" "-2.01555709907786650970e-01" "-1.61798168032950273609e-01" "-4.39355126712112520337e-01" "-1.58267308423409414075e-01" " 4.56173937376610993955e-01" " 7.99529334775864186646e-03" " 7.98285749610598907577e-03" " 1.00000000000000000000e+00" " 4.56243546526286347653e-01" " 8.08383164904142269280e-03" " 7.97491549049226915169e-03" " 1.00000000000000000000e+00" -" 1.27391651478953704668e-01" " 1.87467845381020259410e+00" "-1.99887198519305114841e-01" "-1.62214108649143956553e-01" "-4.35652477622920419886e-01" "-1.56162774606530135868e-01" " 4.53276494006642161061e-01" " 1.32964504467802183130e-02" " 1.30645222855357446418e-02" " 1.00000000000000000000e+00" " 4.53783095362249866422e-01" " 1.29589301251803803994e-02" " 1.19070988677393678479e-02" " 1.00000000000000000000e+00" -" 1.48378817222630354777e-01" " 1.88528306742171802846e+00" "-1.96857494101617430671e-01" "-1.64894436497434737632e-01" "-4.33483972627471070282e-01" "-1.53146635514376988629e-01" " 4.44055568874093808951e-01" " 2.76925977606299264511e-02" " 2.76782765166379354782e-02" " 1.00000000000000000000e+00" " 4.43582440347021933480e-01" " 2.65155609011622182825e-02" " 2.73437746621024158067e-02" " 1.00000000000000000000e+00" -" 1.59362549800796809985e-01" " 1.89084580370348631639e+00" "-1.94459975649268451692e-01" "-1.65167490222664581356e-01" "-4.31789965496753858076e-01" "-1.50578102907902772190e-01" " 4.38181637859916706113e-01" " 3.32399220716845036905e-02" " 3.37822257687323684872e-02" " 1.00000000000000000000e+00" " 4.38045516927180411670e-01" " 3.33810518567187394789e-02" " 3.35127512956347253792e-02" " 1.00000000000000000000e+00" -" 1.69305414639138729349e-01" " 1.89588500206250176738e+00" "-1.92237411020182491495e-01" "-1.66712756361419578433e-01" "-4.28597609342009910893e-01" "-1.48468578659457506319e-01" " 4.33485765860617155987e-01" " 4.21763540139890938385e-02" " 4.31078513011782862852e-02" " 1.00000000000000000000e+00" " 4.34135195703849285920e-01" " 4.24271326560168374198e-02" " 4.29721595962449867678e-02" " 1.00000000000000000000e+00" -" 1.90174070534208650152e-01" " 1.90650237952790413409e+00" "-1.90446388794238752329e-01" "-1.68062321880127041318e-01" "-4.28633064041238465158e-01" "-1.45075414580951467247e-01" " 4.26066359533377736479e-01" " 5.36284044036416385204e-02" " 5.39047890722203978942e-02" " 1.00000000000000000000e+00" " 4.26066359533377736479e-01" " 5.36284044036416385204e-02" " 5.39047890722203978942e-02" " 1.00000000000000000000e+00" -" 1.99203187250996005542e-01" " 1.91110176606159587465e+00" "-1.88579437506588371010e-01" "-1.70162076561279212994e-01" "-4.25592052015728139480e-01" "-1.45216175407850839330e-01" " 4.23417579929574350306e-01" " 5.86145841664037423047e-02" " 5.76814585654925882086e-02" " 1.00000000000000000000e+00" " 4.23417579929574350306e-01" " 5.86145841664037423047e-02" " 5.76814585654925882086e-02" " 1.00000000000000000000e+00" -" 2.10987364747485084404e-01" " 1.91711834734776820355e+00" "-1.86679259952975490355e-01" "-1.70757163695493652256e-01" "-4.24386593128949107800e-01" "-1.42636944401326126730e-01" " 4.17790926687134411832e-01" " 6.62608568447949491942e-02" " 6.57220468047886308138e-02" " 1.00000000000000000000e+00" " 4.17790926687134411832e-01" " 6.62608568447949491942e-02" " 6.57220468047886308138e-02" " 1.00000000000000000000e+00" -" 2.31747832682678900351e-01" " 1.92773776737950242044e+00" "-1.83940932931882183965e-01" "-1.72109598457032775265e-01" "-4.22266145537809611810e-01" "-1.38694450737669700002e-01" " 4.09502187334504830218e-01" " 7.91329072256186927259e-02" " 7.94698175609502288630e-02" " 1.00000000000000000000e+00" " 4.09502187334504830218e-01" " 7.91329072256186927259e-02" " 7.94698175609502288630e-02" " 1.00000000000000000000e+00" -" 2.39043824701195228855e-01" " 1.93147517605161533893e+00" "-1.81763340762608666124e-01" "-1.72681402409168516243e-01" "-4.21329960451714891079e-01" "-1.37452475630147369356e-01" " 4.05966050944434997394e-01" " 8.29164515404993973657e-02" " 8.11334542709693240514e-02" " 1.00000000000000000000e+00" " 4.05831068620737756003e-01" " 8.28745767717891240745e-02" " 8.05291380045802113186e-02" " 1.00000000000000000000e+00" -" 2.52457967740567557069e-01" " 1.93836271992803976794e+00" "-1.81193463000845739197e-01" "-1.73696000746715789598e-01" "-4.21566265058053224468e-01" "-1.35232767124049885199e-01" " 4.01626384085670862234e-01" " 9.07734428262826908984e-02" " 9.09128963056798911069e-02" " 1.00000000000000000000e+00" " 4.01202888644781818783e-01" " 9.05245364891092141324e-02" " 9.08481781051470455024e-02" " 1.00000000000000000000e+00" -" 2.73120223661343919375e-01" " 1.94897581408296471928e+00" "-1.80642441275651322030e-01" "-1.74982015704197968464e-01" "-4.18442575258591964449e-01" "-1.31988728559020607189e-01" " 3.98561451113740139451e-01" " 1.02662100775652923024e-01" " 1.06098594111868102519e-01" " 1.00000000000000000000e+00" " 3.98533328094621885906e-01" " 1.03058527463250615419e-01" " 1.06139878813551385983e-01" " 1.00000000000000000000e+00" -" 2.78884462151394396656e-01" " 1.95194394392986336761e+00" "-1.78187632330723821905e-01" "-1.76234227016729749771e-01" "-4.15002474446507063632e-01" "-1.30785600600483303824e-01" " 3.94567167725847323112e-01" " 1.08643377250491196540e-01" " 1.09935595401980640284e-01" " 1.00000000000000000000e+00" " 3.94371237747624170389e-01" " 1.08692728041646993753e-01" " 1.09787604138102262707e-01" " 1.00000000000000000000e+00" -" 2.93737016782436521911e-01" " 1.95962867002094442981e+00" "-1.76006233890053570557e-01" "-1.76017903375845441438e-01" "-4.16800091535223737882e-01" "-1.28693807115416308795e-01" " 3.87804254369114642653e-01" " 1.13410200785950654456e-01" " 1.13426633450955605120e-01" " 1.00000000000000000000e+00" " 3.87939814110230318800e-01" " 1.14074870338533571057e-01" " 1.13688684562727390648e-01" " 1.00000000000000000000e+00" -" 3.14310728217555401809e-01" " 1.97026989402602570323e+00" "-1.73962045758433991871e-01" "-1.77481607760214848968e-01" "-4.14027685138004641896e-01" "-1.25963102842284985217e-01" " 3.82104927124610749267e-01" " 1.24625951561890491170e-01" " 1.25527481256040573943e-01" " 1.00000000000000000000e+00" " 3.81778214194348819444e-01" " 1.25144095510945130290e-01" " 1.25607978091816896438e-01" " 1.00000000000000000000e+00" -" 3.18725099601593619969e-01" " 1.97255818998371390549e+00" "-1.72930735663139184544e-01" "-1.77396585573541570868e-01" "-4.14617703253063241142e-01" "-1.25023321084555105731e-01" " 3.79822070451222959520e-01" " 1.26714900424334059315e-01" " 1.26567392892025870621e-01" " 1.00000000000000000000e+00" " 3.79874906239952569997e-01" " 1.26520740164107220460e-01" " 1.26105531774140161572e-01" " 1.00000000000000000000e+00" -" 3.34843705962408810795e-01" " 1.98092047684842320621e+00" "-1.70274678679581847884e-01" "-1.78653429787690998243e-01" "-4.11405942071117913805e-01" "-1.22559331200983445687e-01" " 3.74273701693347726760e-01" " 1.35105329417008812598e-01" " 1.34639811515937790620e-01" " 1.00000000000000000000e+00" " 3.75023191821807655444e-01" " 1.34899359350960618142e-01" " 1.34486391473781496941e-01" " 1.00000000000000000000e+00" -" 3.55338266932213375782e-01" " 1.99157793193281995592e+00" "-1.68861891788168239081e-01" "-1.79639101585473831557e-01" "-4.11150470518950039711e-01" "-1.19540594776575456737e-01" " 3.68169473181114925708e-01" " 1.45289041499842536131e-01" " 1.45421399548979396465e-01" " 1.00000000000000000000e+00" " 3.68064423103658278080e-01" " 1.45792833916735392608e-01" " 1.45316827492299294189e-01" " 1.00000000000000000000e+00" -" 3.58565737051792843282e-01" " 1.99325928201677005092e+00" "-1.68088152730626105846e-01" "-1.79452621871856787816e-01" "-4.09589497898819043797e-01" "-1.19673053303831891658e-01" " 3.67480477614653910923e-01" " 1.47206845764279753430e-01" " 1.46780561910211160281e-01" " 1.00000000000000000000e+00" " 3.67474659119407243146e-01" " 1.47459142783165964019e-01" " 1.47962385967833898182e-01" " 1.00000000000000000000e+00" -" 3.75796698935874085024e-01" " 2.00224356895539079559e+00" "-1.66005387539434834387e-01" "-1.81003722800379907021e-01" "-4.06967311905129858207e-01" "-1.17838238962381824937e-01" " 3.62328485487730389547e-01" " 1.56820365956303525712e-01" " 1.56022823204245209006e-01" " 1.00000000000000000000e+00" " 3.61635512408597481482e-01" " 1.56070359999738145218e-01" " 1.55466379955065903129e-01" " 1.00000000000000000000e+00" -" 3.96221262591437028977e-01" " 2.01292114203179650644e+00" "-1.64134541183186599689e-01" "-1.81573549339193895946e-01" "-4.06599260011305418949e-01" "-1.14112339796905826184e-01" " 3.57268523744273480691e-01" " 1.65915721392144999147e-01" " 1.65358311266045665544e-01" " 1.00000000000000000000e+00" " 3.57268523744273480691e-01" " 1.65915721392144999147e-01" " 1.65358311266045665544e-01" " 1.00000000000000000000e+00" -" 3.98406374501992011083e-01" " 2.01406465801608414168e+00" "-1.63359347492141315783e-01" "-1.81938559261247578824e-01" "-4.05678540777555496355e-01" "-1.14427869102482024366e-01" " 3.56033522051043826995e-01" " 1.66452880346637521747e-01" " 1.65506458432017722338e-01" " 1.00000000000000000000e+00" " 3.56557012749407875596e-01" " 1.66351599423153695412e-01" " 1.65339643993273971434e-01" " 1.00000000000000000000e+00" -" 4.16614193187194392642e-01" " 2.02360826783990788158e+00" "-1.61392940998634243366e-01" "-1.82197107971740934751e-01" "-4.05639702646240607464e-01" "-1.11070945291743189420e-01" " 3.50654327495739881471e-01" " 1.75118142318103936494e-01" " 1.74769579041459566238e-01" " 1.00000000000000000000e+00" " 3.50599447604181935212e-01" " 1.75348510505069499210e-01" " 1.74970046192169104149e-01" " 1.00000000000000000000e+00" -" 4.36977702492617525731e-01" " 2.03428881590178090022e+00" "-1.59825364420835946966e-01" "-1.83414104447304965317e-01" "-4.04327742817793267527e-01" "-1.09131151937912437844e-01" " 3.45995951816330360451e-01" " 1.84186595150317961034e-01" " 1.83698505075733431458e-01" " 1.00000000000000000000e+00" " 3.45735671727974147593e-01" " 1.84351934846023718384e-01" " 1.84531191536261823805e-01" " 1.00000000000000000000e+00" -" 4.38247011952191289907e-01" " 2.03493201787984778761e+00" "-1.61778956011384394964e-01" "-1.84741390458027010535e-01" "-4.05503606289195905887e-01" "-1.08596093193116055575e-01" " 3.47437982832751679485e-01" " 1.87795107561500446147e-01" " 1.90948175287012411605e-01" " 1.00000000000000000000e+00" " 3.47611900608600532525e-01" " 1.87625603312824018598e-01" " 1.91117931239299876367e-01" " 1.00000000000000000000e+00" -" 4.57313980523084140373e-01" " 2.04499990318908952958e+00" "-1.57632954978096817555e-01" "-1.83818106139373937946e-01" "-4.03785849182797584866e-01" "-1.05458860259442885332e-01" " 3.40610817976483515324e-01" " 1.93784740638320546191e-01" " 1.93531549138136999000e-01" " 1.00000000000000000000e+00" " 3.40956238550359558293e-01" " 1.93176064914911044257e-01" " 1.93865537514476327097e-01" " 1.00000000000000000000e+00" -" 4.77625197262214196137e-01" " 2.05576215076779522661e+00" "-1.55471040919639896805e-01" "-1.84436652285859509215e-01" "-4.00166527997676102490e-01" "-1.03568764489028797282e-01" " 3.36072910549359005206e-01" " 2.01980837800672108351e-01" " 2.01543799544738971852e-01" " 1.00000000000000000000e+00" " 3.36376975414062917569e-01" " 2.02163343849419724352e-01" " 2.01950788170536438271e-01" " 1.00000000000000000000e+00" -" 4.78087649402390457709e-01" " 2.05600560617205774250e+00" "-1.56107974585544484469e-01" "-1.83829363744616058884e-01" "-4.01820120271884184682e-01" "-1.02412901287741969769e-01" " 3.36824825766857349763e-01" " 2.02619177958996060651e-01" " 2.02757487818918391564e-01" " 1.00000000000000000000e+00" " 3.36824825766857349763e-01" " 2.02619177958996060651e-01" " 2.02757487818918391564e-01" " 1.00000000000000000000e+00" -" 4.97913504345446511490e-01" " 2.06649991357224971367e+00" "-1.53375495014640150782e-01" "-1.84672353507325415212e-01" "-3.98578030814480621657e-01" "-1.00919636345967039803e-01" " 3.31055955619719899374e-01" " 2.10177295430298449741e-01" " 2.09665955518348795517e-01" " 1.00000000000000000000e+00" " 3.31250290827163951235e-01" " 2.10233737334792170071e-01" " 2.10218765523974088216e-01" " 1.00000000000000000000e+00" [TRUNCATED] To get the complete diff run: svnlook diff /svnroot/robast -r 637 From noreply at r-forge.r-project.org Sat Mar 16 13:05:16 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sat, 16 Mar 2013 13:05:16 +0100 (CET) Subject: [Robast-commits] r638 - branches/robast-0.9/pkg/RobExtremes/R Message-ID: <20130316120516.CBA6A184976@r-forge.r-project.org> Author: ruckdeschel Date: 2013-03-16 13:05:16 +0100 (Sat, 16 Mar 2013) New Revision: 638 Modified: branches/robast-0.9/pkg/RobExtremes/R/interpolLM.R Log: RobExtremes: argh -- a typo... Modified: branches/robast-0.9/pkg/RobExtremes/R/interpolLM.R =================================================================== --- branches/robast-0.9/pkg/RobExtremes/R/interpolLM.R 2013-03-16 11:25:54 UTC (rev 637) +++ branches/robast-0.9/pkg/RobExtremes/R/interpolLM.R 2013-03-16 12:05:16 UTC (rev 638) @@ -40,7 +40,7 @@ loRad.s=0.2, up.Rad.s=1, withStartLM = TRUE){ namF <- gsub("\\.th$","",paste(deparse(substitute(optF)))) - namF <- gsub(" ", "",namF)) + namF <- gsub(" ", "",namF) to <- gsub("XXXX",gsub(" ","",name(PFam)), gsub("YYYY", namF, "interpolYYYYXXXX.csv")) print(to) From noreply at r-forge.r-project.org Mon Mar 18 18:44:15 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 18 Mar 2013 18:44:15 +0100 (CET) Subject: [Robast-commits] r639 - in branches/robast-0.9/pkg: RobAStRDA/R RobExtremes/inst/AddMaterial/interpolation RobExtremesBuffer Message-ID: <20130318174415.99CA31813EC@r-forge.r-project.org> Author: ruckdeschel Date: 2013-03-18 18:44:15 +0100 (Mon, 18 Mar 2013) New Revision: 639 Modified: branches/robast-0.9/pkg/RobAStRDA/R/sysdata.rda branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/plotInterpol.R branches/robast-0.9/pkg/RobExtremesBuffer/interpolRMXEGammafamily.csv branches/robast-0.9/pkg/RobExtremesBuffer/interpolRMXEWeibullFamily.csv Log: + integrated grids from Weekend (RMXE for Gamma & Weibull, both quite good, it seems); + enhanced examples to plotInterpol.R a little Modified: branches/robast-0.9/pkg/RobAStRDA/R/sysdata.rda =================================================================== (Binary files differ) Modified: branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/plotInterpol.R =================================================================== --- branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/plotInterpol.R 2013-03-16 12:05:16 UTC (rev 638) +++ branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/plotInterpol.R 2013-03-18 17:44:15 UTC (rev 639) @@ -99,18 +99,18 @@ if(FALSE){ ## Examples -plotLM("OMSE","Gamma","all", type="l", plotG=-(1:8)) -plotLM("OMSE","Gener","all", type="l", plotG=-(1:8)) -plotLM("OMSE","GEV","all", type="l", plotG=-(1:8)) -plotLM("OMSE","Wei","all", type="l", plotG=-(1:8)) -plotLM("MBRE","Wei","all", type="l", plotG=-(1:8)) -plotLM("MBRE","GE","all", type="l", plotG=-(1:8)) -plotLM("MBRE","Gene","all", type="l", plotG=-(1:8)) -plotLM("MBRE","Gam","all", type="l", plotG=-(1:8)) -plotLM("RMXE","Gam","all", type="l", plotG=-(1:8)) -plotLM("RMXE","Wei","all", type="l", plotG=-(1:8)) -plotLM("RMXE","Gene","all", type="l", plotG=-(1:8)) -plotLM("RMXE","GE","all", type="l", plotG=-(1:8)) +plotLM("OMSE","Gamma","all", type="l", plotG=-(1:8), main ="Gamma-OMSE", xlab=expression(xi),ylab="LM", pre=windows()) +plotLM("OMSE","Gener","all", type="l", plotG=-(1:8), main ="GPD-OMSE", xlab=expression(xi),ylab="LM", pre=windows()) +plotLM("OMSE","GEV","all", type="l", plotG=-(1:8), main ="GEV-OMSE", xlab=expression(xi),ylab="LM", pre=windows()) +plotLM("OMSE","Wei","all", type="l", plotG=-(1:8), main ="Weibull-OMSE", xlab=expression(xi),ylab="LM", pre=windows()) +plotLM("MBRE","Gam","all", type="l", plotG=-(1:8), main ="Gamma-MBRE", xlab=expression(xi),ylab="LM", pre=windows()) +plotLM("MBRE","Gene","all", type="l", plotG=-(1:8), main ="GPD-MBRE", xlab=expression(xi),ylab="LM", pre=windows()) +plotLM("MBRE","GE","all", type="l", plotG=-(1:8), main ="GEV-MBRE", xlab=expression(xi),ylab="LM", pre=windows()) +plotLM("MBRE","Wei","all", type="l", plotG=-(1:8), main ="Weibull-MBRE", xlab=expression(xi),ylab="LM", pre=windows()) +plotLM("RMXE","Gam","all", type="l", plotG=-(1:8), main ="Gamma-RMXE", xlab=expression(xi),ylab="LM", pre=windows()) +plotLM("RMXE","Gene","all", type="l", plotG=-(1:8), main ="GPD-RMXE", xlab=expression(xi),ylab="LM", pre=windows()) +plotLM("RMXE","GE","all", type="l", plotG=-(1:8), main ="GEV-RMXE", xlab=expression(xi),ylab="LM", pre=windows()) +plotLM("RMXE","Wei","all", type="l", plotG=-(1:8), main ="Weibull-RMXE", xlab=expression(xi),ylab="LM", pre=windows()) plotLM("MBRE","GE","all", type="l") plotLM("MBRE","GE","all", type="l", sm = TRUE, df = 10, gridR = -(1:15)) plotLM("MBRE","GE","all", type="l", sm = TRUE, df = 4, gridR = -(1:15)) Modified: branches/robast-0.9/pkg/RobExtremesBuffer/interpolRMXEGammafamily.csv =================================================================== --- branches/robast-0.9/pkg/RobExtremesBuffer/interpolRMXEGammafamily.csv 2013-03-16 12:05:16 UTC (rev 638) +++ branches/robast-0.9/pkg/RobExtremesBuffer/interpolRMXEGammafamily.csv 2013-03-18 17:44:15 UTC (rev 639) @@ -1,496 +1,544 @@ -" 3.98406374501992024961e-02" " 4.90621395856920025835e+03" "-3.98398313356505967553e-02" "-3.48882163125406033130e-03" "-3.98398876049943853617e-02" " 3.06352929382583509532e-02" " 1.00000000000000000000e+00" " 8.75711967348501152397e-02" "-2.90319538573563761074e-08" "-4.46233044040541911273e-11" " 1.00000000000000000000e+00" " 8.75740784383949311120e-02" "-3.30122362061888898291e-08" " 2.56855752674618789588e-09" -" 4.27829746040001568375e-02" " 2.77339001383300546877e+03" "-4.27827479086906187211e-02" " 2.02671172511600765354e-03" "-4.27825299988003338036e-02" " 9.43577965186521705476e-02" " 1.00000000000000000000e+00" "-4.73721731215045460672e-02" "-9.48617519369253703530e-09" " 2.85879222752357087970e-10" " 1.00000000000000000000e+00" "-4.73735907828344363080e-02" "-1.75385915318706266801e-08" "-5.05135549671046610339e-10" -" 6.40397156295258174197e-02" " 2.05682263133413130163e+02" "-3.88965423504291902645e+03" " 2.45112489149905882213e-01" "-6.30025217881828442090e-02" "-3.86339718020805422682e+00" " 6.19984987381872997503e+04" "-4.24691839211229815731e+00" "-4.24691839211228838735e+00" " 5.81200387395273791735e-03" " 6.19984987383544939803e+04" "-4.24691839288920025552e+00" "-4.24691839288920469642e+00" " 5.81200387509930686825e-03" -" 7.96812749003984049923e-02" " 6.72268075728239722366e+01" "-1.80121947851000709306e+03" " 2.11987986634972452871e-01" "-7.81818155221196964266e-02" "-3.48514534925823182832e+00" " 2.31812410633738727483e+04" "-3.19413762146860769064e+00" "-3.19413762146861301972e+00" " 1.08275230538157664351e-02" " 2.31812410629163568956e+04" "-3.19413762323368244367e+00" "-3.19413762323368510820e+00" " 1.08275230610317321073e-02" -" 8.52248570399394278496e-02" " 5.07169591178862830816e+01" "-1.43653923414538985526e+03" " 2.13063931309316889617e-01" "-8.35118175197413076249e-02" "-3.28032044669606026588e+00" " 1.73225222154081166082e+04" "-3.07777251008097074703e+00" "-3.07777251008095653617e+00" " 1.34030944847253127850e-02" " 1.73225222151754278457e+04" "-3.07777251219303682461e+00" "-3.07777251219303327190e+00" " 1.34030944946877117463e-02" -" 1.27391651478953704668e-01" " 2.96753487178572719074e+01" "-2.10079424287011784500e+00" " 1.44060333422147551774e-02" "-5.09710771095033821076e-02" "-2.78969413009521161051e-01" " 4.33632757335164527035e+01" "-3.92439540519312901612e-01" "-3.92439540519312624056e-01" " 2.00632487908332796112e-02" " 4.33632757336551790672e+01" "-3.92439540525005514660e-01" "-3.92439540525005625682e-01" " 2.00632487911301012062e-02" -" 1.48378817222630354777e-01" " 1.72291415671812906396e+01" "-1.25887828261861001167e+00" " 1.27017451719757361317e-02" "-4.83611511473088090396e-02" "-2.09242595387069713064e-01" " 2.76808224718652127194e+01" "-3.81366694010405293813e-01" "-3.81366694010405127280e-01" " 2.74398581867459183392e-02" " 2.76808224733631504932e+01" "-3.81366694324291599649e-01" "-3.81366694324291544138e-01" " 2.74398582111639657843e-02" -" 1.59362549800796809985e-01" " 1.38245575997927403478e+01" "-1.16842998408291376400e+00" " 1.34289692301170996563e-02" "-5.07738199520109678708e-02" "-2.08200748875255525761e-01" " 2.46350291449022655854e+01" "-3.95697665793361019748e-01" "-3.95697665793361574860e-01" " 3.19985053639839853168e-02" " 2.46350291449924618803e+01" "-3.95697666261176417279e-01" "-3.95697666261176139724e-01" " 3.19985054078759725837e-02" -" 1.69305414639138729349e-01" " 1.18891334158162926826e+01" "-1.11358229430997623943e+00" " 1.42908371665171653186e-02" "-5.32368895354910498519e-02" "-2.07682756497228865333e-01" " 2.25206748037440895871e+01" "-4.10955558867496906217e-01" "-4.10955558867497017239e-01" " 3.65324414315767731498e-02" " 2.25206748055165775213e+01" "-4.10955564334707479368e-01" "-4.10955564334707423857e-01" " 3.65324420022630838578e-02" -" 1.90174070534208650152e-01" " 9.35435291050879769159e+00" "-1.08044960647291032885e+00" " 1.71671384806164131764e-02" "-5.98100809859383186762e-02" "-2.09544832717630524765e-01" " 1.96535987973863406353e+01" "-4.53524565534020818180e-01" "-4.53524565534020818180e-01" " 4.75230152694982657668e-02" " 1.96535987982444630973e+01" "-4.53524568120423576811e-01" "-4.53524568120423965389e-01" " 4.75230155933428211057e-02" -" 1.99203187250996005542e-01" " 8.63177367625432268028e+00" "-1.08054671796164725173e+00" " 1.87927545013368245408e-02" "-6.28646795703065031091e-02" "-2.09284898719088674479e-01" " 1.87704999505429412920e+01" "-4.75212246377592795188e-01" "-4.75212246377592462121e-01" " 5.29484455827157751706e-02" " 1.87704999496209978815e+01" "-4.75212257046725816689e-01" "-4.75212257046725705667e-01" " 5.29484470417686328703e-02" -" 2.10987364747485084404e-01" " 7.89495280190292003653e+00" "-1.08272478205156308384e+00" " 2.11836801057954590699e-02" "-6.67670223980379312634e-02" "-2.07074582118045746881e-01" " 1.77840079083737592214e+01" "-5.05424037060227759888e-01" "-5.05424037060227759888e-01" " 6.06640117311829374369e-02" " 1.77840079030211697386e+01" "-5.05424065584550885610e-01" "-5.05424065584550996633e-01" " 6.06640160118639762410e-02" -" 2.31747832682678900351e-01" " 6.96549222277173729623e+00" "-1.08591756380680770633e+00" " 2.60834796181453471009e-02" "-7.32297186570396441141e-02" "-1.99064211340391761240e-01" " 1.63595138795921002384e+01" "-5.63059676686684662528e-01" "-5.63059676686684218438e-01" " 7.61021514315752406477e-02" " 1.63595138741083871992e+01" "-5.63059739784063206791e-01" "-5.63059739784063206791e-01" " 7.61021622846069084600e-02" -" 2.39043824701195228855e-01" " 6.71506661529819393053e+00" "-1.08576715067830820161e+00" " 2.79969044308939693511e-02" "-7.53403435448455616186e-02" "-1.95257779063286618371e-01" " 1.59261001702726918694e+01" "-5.84410515463077873122e-01" "-5.84410515463077762099e-01" " 8.21108066738150538244e-02" " 1.59261001692334467350e+01" "-5.84410605503606017663e-01" "-5.84410605503606128686e-01" " 8.21108228805550455220e-02" -" 2.52457967740567557069e-01" " 6.32642657113665052293e+00" "-1.08397842573306935066e+00" " 3.17732846859549028506e-02" "-7.90144085020081793358e-02" "-1.87370026516965326735e-01" " 1.52008296302938550326e+01" "-6.24999307202349418944e-01" "-6.24999307202349640988e-01" " 9.39886973689473964599e-02" " 1.52008296276431966731e+01" "-6.24999316681954852903e-01" "-6.24999316681954852903e-01" " 9.39886991771231306014e-02" -" 2.73120223661343919375e-01" " 5.86054565723505760388e+00" "-1.07675174270105000751e+00" " 3.81790850778755547212e-02" "-8.41212093369636537687e-02" "-1.73792093971795569285e-01" " 1.42262411311552376958e+01" "-6.90347049616827357355e-01" "-6.90347049616827579399e-01" " 1.14468590467747780015e-01" " 1.42262411234869823318e+01" "-6.90347105233546254333e-01" "-6.90347105233546587399e-01" " 1.14468602710095707087e-01" -" 2.78884462151394396656e-01" " 5.75201442976995913625e+00" "-1.07384329157713631631e+00" " 4.00865280093648940207e-02" "-8.54246826170494133468e-02" "-1.69804332612700781269e-01" " 1.39802344732038328345e+01" "-7.09132626306257951576e-01" "-7.09132626306257951576e-01" " 1.20673544336714164138e-01" " 1.39802344542978502773e+01" "-7.09132704430280425001e-01" "-7.09132704430280758068e-01" " 1.20673562145531557133e-01" -" 2.93737016782436521911e-01" " 5.50534112444137679887e+00" "-1.06572504878006601992e+00" " 4.52612103966269635480e-02" "-8.86030467341802491221e-02" "-1.59477892528903819613e-01" " 1.33936479646754271755e+01" "-7.58681651055657990668e-01" "-7.58681651055658212712e-01" " 1.37701047548081295657e-01" " 1.33936479277400888321e+01" "-7.58681807696590437828e-01" "-7.58681807696590104761e-01" " 1.37701086086997576130e-01" -" 3.14310728217555401809e-01" " 5.22477380526114121295e+00" "-1.05298017077551087084e+00" " 5.30158869259773554705e-02" "-9.25685204623956092718e-02" "-1.45223938573746907954e-01" " 1.26769234468276064121e+01" "-8.29779620191396283246e-01" "-8.29779620191396172224e-01" " 1.63854310710746464697e-01" " 1.26769234210548660258e+01" "-8.29779729552313161101e-01" "-8.29779729552313383145e-01" " 1.63854340444833990187e-01" -" 3.18725099601593619969e-01" " 5.17218637572680872694e+00" "-1.05019061246653921948e+00" " 5.47708386044076511734e-02" "-9.33585144321179977167e-02" "-1.42217717247687863713e-01" " 1.25369223268961960116e+01" "-8.45448920311356100221e-01" "-8.45448920311356322266e-01" " 1.69873322441044971587e-01" " 1.25369222925830108295e+01" "-8.45449054320367321402e-01" "-8.45449054320367432425e-01" " 1.69873359709633325876e-01" -" 3.34843705962408810795e-01" " 4.99714603743972851646e+00" "-1.03942183676188659724e+00" " 6.14194816189008729879e-02" "-9.60728160553424026524e-02" "-1.31417153903528205472e-01" " 1.20548996619445567546e+01" "-9.03430741680765647672e-01" "-9.03430741680765647672e-01" " 1.93092141431868896673e-01" " 1.20548995832204681733e+01" "-9.03430956940520446530e-01" "-9.03430956940520002441e-01" " 1.93092206312747122210e-01" -" 3.55338266932213375782e-01" " 4.80848835212702141462e+00" "-1.02605290996380937862e+00" " 7.04801133608707330858e-02" "-9.91827372154317349340e-02" "-1.18260756727604263161e-01" " 1.15130985252428459376e+01" "-9.79595474229698837121e-01" "-9.79595474229698282009e-01" " 2.25593223237249007607e-01" " 1.15130984763053323405e+01" "-9.79595608028816067225e-01" "-9.79595608028815734158e-01" " 2.25593267274345143925e-01" -" 3.58565737051792843282e-01" " 4.78112549325510460818e+00" "-1.02389870315559328162e+00" " 7.19371880834948490557e-02" "-9.96629971743636933201e-02" "-1.16317689032301482821e-01" " 1.14306271121750082642e+01" "-9.91352564531411184490e-01" "-9.91352564531411406534e-01" " 2.30953255630966414191e-01" " 1.14306271204852514245e+01" "-9.91352766172546640000e-01" "-9.91352766172546417955e-01" " 2.30953320590581961946e-01" -" 3.75796698935874085024e-01" " 4.64956383679932816477e+00" "-1.01321446630502731701e+00" " 8.01777225846822122479e-02" "-1.01940327943174410819e-01" "-1.05872647176156062243e-01" " 1.10382258775968953302e+01" "-1.05811901404796704362e+00" "-1.05811901404796748771e+00" " 2.61514395993658776973e-01" " 1.10382258049259363020e+01" "-1.05811933747618946988e+00" "-1.05811933747618946988e+00" " 2.61514511079505851399e-01" -" 3.96221262591437028977e-01" " 4.51425437257312456296e+00" "-1.00145376905422378577e+00" " 9.05591220616228792517e-02" "-1.04389412157229563571e-01" "-9.41929758580785925215e-02" " 1.06213535915269705612e+01" "-1.13918324300928874848e+00" "-1.13918324300928874848e+00" " 3.01078568713512462196e-01" " 1.06213534354423462247e+01" "-1.13918359103034960711e+00" "-1.13918359103034960711e+00" " 3.01078704650452000369e-01" -" 3.98406374501992011083e-01" " 4.50098104934506348940e+00" "-1.00018392527484145660e+00" " 9.16962930064360443039e-02" "-1.04632791046878781405e-01" "-9.30129894443291194150e-02" " 1.05794649164347038806e+01" "-1.14795774722938115353e+00" "-1.14795774722938070944e+00" " 3.05523618145975284222e-01" " 1.05794647693845824676e+01" "-1.14795812071552494338e+00" "-1.14795812071552472133e+00" " 3.05523764749996928902e-01" -" 4.16614193187194392642e-01" " 4.39783090409609300764e+00" "-9.90665637499441920077e-01" " 1.01572907905533194040e-01" "-1.06555722365235860938e-01" "-8.33127678235265622941e-02" " 1.02530096537468153883e+01" "-1.22251632888563843693e+00" "-1.22251632888563843693e+00" " 3.44403602347700621422e-01" " 1.02530096826727810111e+01" "-1.22251624519936030744e+00" "-1.22251624519936030744e+00" " 3.44403567548464961678e-01" -" 4.36977702492617525731e-01" " 4.29889641802759303602e+00" "-9.84362305953593308416e-01" " 1.13637919295537570541e-01" "-1.08601616499385503212e-01" "-7.31989109012433913914e-02" " 9.94738184333072972265e+00" "-1.31066734592466915821e+00" "-1.31066734592466893616e+00" " 3.92118160244477598209e-01" " 9.94738209339225143424e+00" "-1.31066767570110087604e+00" "-1.31066767570110109808e+00" " 3.92118293926930150395e-01" -" 4.38247011952191289907e-01" " 4.29117899858109819178e+00" "-9.80291198571826338792e-01" " 1.13983864326219166974e-01" "-1.08566149169378761696e-01" "-7.24952238994421016560e-02" " 9.90653311208549602895e+00" "-1.31350626303490458646e+00" "-1.31350626303490480851e+00" " 3.94762532360405482557e-01" " 9.90653297934499832422e+00" "-1.31350656100605278631e+00" "-1.31350656100605278631e+00" " 3.94762668257430671126e-01" -" 4.57313980523084140373e-01" " 4.20941204973802562961e+00" "-9.71635550909273115749e-01" " 1.25475480593730481793e-01" "-1.10081959979550711437e-01" "-6.35686515214207992219e-02" " 9.63242247373047533188e+00" "-1.39566429311591000406e+00" "-1.39566429311591022611e+00" " 4.43015928477170528588e-01" " 9.63242229837331898068e+00" "-1.39566469099541068388e+00" "-1.39566469099541068388e+00" " 4.43016121025793574439e-01" -" 4.77625197262214196137e-01" " 4.13308304283456973138e+00" "-9.63966462730627138278e-01" " 1.38423974783638353836e-01" "-1.11524807841622303206e-01" "-5.46555956039045318096e-02" " 9.37155933257174034168e+00" "-1.48557275137942323973e+00" "-1.48557275137942346177e+00" " 4.98652543080654320207e-01" " 9.37155893408415607837e+00" "-1.48557318588149311900e+00" "-1.48557318588149311900e+00" " 4.98652782752878609429e-01" -" 4.78087649402390457709e-01" " 4.13142928417032528898e+00" "-9.63709019306507985725e-01" " 1.38709319123140550900e-01" "-1.11550685759254197826e-01" "-5.44662666078049514939e-02" " 9.36553403005023099581e+00" "-1.48757559499542879600e+00" "-1.48757559499542857395e+00" " 4.99954503750551726426e-01" " 9.36553373443547698685e+00" "-1.48757613038184843823e+00" "-1.48757613038184821619e+00" " 4.99954786351073932060e-01" -" 4.97913504345446511490e-01" " 4.06669048160863777497e+00" "-9.56684807907798195892e-01" " 1.51886948883400707544e-01" "-1.12730903983279631686e-01" "-4.63512909098483388837e-02" " 9.13485543914094755280e+00" "-1.57699345576712768313e+00" "-1.57699345576712746109e+00" " 5.58535956621527773791e-01" " 9.13485519689517566633e+00" "-1.57699390033920483489e+00" "-1.57699390033920505694e+00" " 5.58536206556233261189e-01" -" 5.17928286852589625511e-01" " 4.00934449510702073383e+00" "-9.49896971725854744051e-01" " 1.65751745759292551385e-01" "-1.13670509842189890182e-01" "-3.85933062475358884535e-02" " 8.92338864744120385808e+00" "-1.66943863784179336029e+00" "-1.66943863784179291621e+00" " 6.22235778115671434030e-01" " 8.92338843829025663013e+00" "-1.66943893377742891282e+00" "-1.66943893377742846873e+00" " 6.22235958022452684268e-01" -" 5.18181036708362463550e-01" " 4.00860675656782650123e+00" "-9.49964522081156004241e-01" " 1.65955550698083292849e-01" "-1.13690541671239514487e-01" "-3.85025446644413557595e-02" " 8.92151647789144064404e+00" "-1.67073408625889596735e+00" "-1.67073408625889618939e+00" " 6.23102968478536967112e-01" " 8.92151627759882970281e+00" "-1.67073441538683598040e+00" "-1.67073441538683553631e+00" " 6.23103166179669099023e-01" -" 5.38429914203115922433e-01" " 3.95794233169146281170e+00" "-9.44395340576035136060e-01" " 1.80646520109733754733e-01" "-1.14494193201577040830e-01" "-3.11859758963740976712e-02" " 8.72953167588008049904e+00" "-1.76634960893736936427e+00" "-1.76634960893736914223e+00" " 6.92303846898944863497e-01" " 8.72953140386906412118e+00" "-1.76635001843650774056e+00" "-1.76635001843650774056e+00" " 6.92304110750319945389e-01" -" 5.57768924302788793312e-01" " 3.91648983785840965055e+00" "-9.41058966688380960086e-01" " 1.95487197689593023009e-01" "-1.15160341886849287851e-01" "-2.46324648723614397783e-02" " 8.56974451115511293153e+00" "-1.86078576302482412430e+00" "-1.86078576302482368021e+00" " 7.63279889717014548012e-01" " 8.56974427667291926980e+00" "-1.86078606752639852395e+00" "-1.86078606752639830191e+00" " 7.63280100769813452111e-01" -" 5.58662243186231033398e-01" " 3.91408100800339253666e+00" "-9.39040863877215636890e-01" " 1.95833270230526823585e-01" "-1.15075829779874377889e-01" "-2.42844862062294927774e-02" " 8.55344181401025416278e+00" "-1.86347483071449770975e+00" "-1.86347483071449793179e+00" " 7.66231575319177848904e-01" " 8.55344137855323616293e+00" "-1.86347529074023920970e+00" "-1.86347529074023854356e+00" " 7.66231905091654286188e-01" -" 5.78880118080907335454e-01" " 3.87657506987037026036e+00" "-9.33699341433012142133e-01" " 2.11416698300612687644e-01" "-1.15456618955476930655e-01" "-1.78294579539171257898e-02" " 8.38993582949059124587e+00" "-1.96160076242107983546e+00" "-1.96160076242107961342e+00" " 8.44838489596977715301e-01" " 8.38993560328591314601e+00" "-1.96160117033801428832e+00" "-1.96160117033801428832e+00" " 8.44838780451547810557e-01" -" 5.97609561752988072136e-01" " 3.84665546154386950306e+00" "-9.29250167544056648872e-01" " 2.26317111582505059442e-01" "-1.15655748710939101920e-01" "-1.21840472041631481259e-02" " 8.25100127663736060413e+00" "-2.05396115022494463176e+00" "-2.05396115022494418767e+00" " 9.22127340468199108159e-01" " 8.25100104703985159915e+00" "-2.05396142309221430011e+00" "-2.05396142309221385602e+00" " 9.22127554606496424583e-01" -" 5.99085622916895488288e-01" " 3.84406247319487448522e+00" "-9.29829768250297949983e-01" " 2.27734340534437862402e-01" "-1.15719783739764908725e-01" "-1.17447732581017847547e-02" " 8.24448768119800057264e+00" "-2.06224208236337869238e+00" "-2.06224208236337869238e+00" " 9.28737089296587714493e-01" " 8.24448743828682850676e+00" "-2.06224236232662283541e+00" "-2.06224236232662372359e+00" " 9.28737310570141971766e-01" -" 6.19280832850907736464e-01" " 3.81726552156687493067e+00" "-9.24547336500839644913e-01" " 2.44074292962971978183e-01" "-1.15705799343177997973e-01" "-6.02682125942180860201e-03" " 8.10313590439545983202e+00" "-2.16241352525964458664e+00" "-2.16241352525964458664e+00" " 1.01702429690363893577e+00" " 8.10313566541569940682e+00" "-2.16241384131665093093e+00" "-2.16241384131665093093e+00" " 1.01702455637598321303e+00" -" 6.37450199203187239938e-01" " 3.79640985982614020955e+00" "-9.20234614652012838931e-01" " 2.59170465728247756410e-01" "-1.15574919750923016393e-01" "-1.16362474780779901265e-03" " 7.98492335362636485030e+00" "-2.25352922393079291297e+00" "-2.25352922393079291297e+00" " 1.10080806186126212154e+00" " 7.98492295453725819954e+00" "-2.25352947798902381038e+00" "-2.25352947798902381038e+00" " 1.10080830826455766669e+00" -" 6.39467815670481498636e-01" " 3.79554442468505204289e+00" "-9.22115993113791221347e-01" " 2.61772976939132095975e-01" "-1.15606480482893264616e-01" "-4.17699394609866050780e-04" " 7.98453063305361787627e+00" "-2.26836564295094778032e+00" "-2.26836564295094822441e+00" " 1.11255593164693866726e+00" " 7.98453030752884629351e+00" "-2.26836597483595303615e+00" "-2.26836597483595348024e+00" " 1.11255622928670727667e+00" -" 6.59648633284134366939e-01" " 3.77620815298916534530e+00" "-9.16456792450311086284e-01" " 2.78379313872675948627e-01" "-1.15303462358790187459e-01" " 4.42625474298496707909e-03" " 7.85731736800764668516e+00" "-2.36789095812971117638e+00" "-2.36789095812971028820e+00" " 1.20945853977665640500e+00" " 7.85731701600971543797e+00" "-2.36789131602546332189e+00" "-2.36789131602546287780e+00" " 1.20945887840670529556e+00" -" 6.77290836653386407740e-01" " 3.76329681926711856477e+00" "-9.13089693347079789376e-01" " 2.93811590657579169150e-01" "-1.14937176700903656568e-01" " 8.61856310243926636294e-03" " 7.75987709012370707740e+00" "-2.45879999582988162388e+00" "-2.45879999582988206797e+00" " 1.29999612012668097627e+00" " 7.75987692760913905232e+00" "-2.45880015672653051695e+00" "-2.45880015672653096104e+00" " 1.29999627960196995069e+00" -" 6.79825343200614606864e-01" " 3.76167480320319080889e+00" "-9.12623520225617990143e-01" " 2.96050386458269532142e-01" "-1.14876501301879138661e-01" " 9.20135194013220990283e-03" " 7.74639242478624812094e+00" "-2.47192462084049280335e+00" "-2.47192462084049324744e+00" " 1.31333166570341974833e+00" " 7.74639203429445277749e+00" "-2.47192501563611344295e+00" "-2.47192501563611388704e+00" " 1.31333205928397789286e+00" -" 6.99999999999999955591e-01" " 3.75089560471720506740e+00" "-9.08712555708308999947e-01" " 3.13970019589331794663e-01" "-1.14290700263639855017e-01" " 1.37064665842055437989e-02" " 7.64189183689192041982e+00" "-2.57654825419595656655e+00" "-2.57654825419595656655e+00" " 1.42229221647755621483e+00" " 7.64189146051255097092e+00" "-2.57654860912651129112e+00" "-2.57654860912651173521e+00" " 1.42229259281441455798e+00" -" 7.17131474103585686564e-01" " 3.74386453490675386035e+00" "-9.05420947694479338885e-01" " 3.29357921672626730025e-01" "-1.13692134329401117743e-01" " 1.73433363153605961393e-02" " 7.55721619564925362056e+00" "-2.66528274841087808866e+00" "-2.66528274841087808866e+00" " 1.51852558801177361936e+00" " 7.55721592824399834853e+00" "-2.66528302130670402548e+00" "-2.66528302130670402548e+00" " 1.51852588478241878889e+00" -" 7.20174656799385304318e-01" " 3.74335604960708767663e+00" "-9.05334217466885027292e-01" " 3.32295806658657266741e-01" "-1.13604786814814021079e-01" " 1.79304015434713324983e-02" " 7.54577610500580142627e+00" "-2.68247830907940709722e+00" "-2.68247830907940665313e+00" " 1.53669347062261985037e+00" " 7.54577563225161807026e+00" "-2.68247871063794907087e+00" "-2.68247871063794907087e+00" " 1.53669392747428146251e+00" -" 7.40351366715865544244e-01" " 3.73901078892412952470e+00" "-9.01245401872131868259e-01" " 3.50614612608619480305e-01" "-1.12735917194449336565e-01" " 2.19683738326071006930e-02" " 7.45112934589635500515e+00" "-2.78743821232844446456e+00" "-2.78743821232844490865e+00" " 1.65557549210550325469e+00" " 7.45112890643685865655e+00" "-2.78743856274999579625e+00" "-2.78743856274999535216e+00" " 1.65557591623269151349e+00" -" 7.56972111553784854365e-01" " 3.73783991211515598252e+00" "-8.98075223096425512281e-01" " 3.65872856062326945459e-01" "-1.11960796604026441292e-01" " 2.50126113979936455511e-02" " 7.37901340053540177877e+00" "-2.87515020042987012872e+00" "-2.87515020042987012872e+00" " 1.75786159842763423100e+00" " 7.37901376456892066358e+00" "-2.87515012353309717952e+00" "-2.87515012353309717952e+00" " 1.75786143800763716705e+00" -" 7.60532184329518412547e-01" " 3.73774529305881131336e+00" "-8.97358914260230955406e-01" " 3.69135938373024274917e-01" "-1.11782293210477501333e-01" " 2.56537204359283226018e-02" " 7.36363002159114188316e+00" "-2.89374966894266849593e+00" "-2.89374966894266894002e+00" " 1.78009422663424721200e+00" " 7.36362971411521627374e+00" "-2.89374998898586044405e+00" "-2.89374998898586044405e+00" " 1.78009461013869163537e+00" -" 7.80719167149092174718e-01" " 3.73920515568297151532e+00" "-8.93580128437514997763e-01" " 3.87868272405095970701e-01" "-1.10717190480526306295e-01" " 2.91668605181140232208e-02" " 7.28048183102070911588e+00" "-3.00017273584170629519e+00" "-3.00017273584170585110e+00" " 1.90962034182485385081e+00" " 7.28048155645383054946e+00" "-3.00017293702616694162e+00" "-3.00017293702616738571e+00" " 1.90962061517085057716e+00" -" 7.96812749003984022167e-01" " 3.74215994992092948479e+00" "-8.90513859482163772086e-01" " 4.02870293439692939153e-01" "-1.09792529099786095870e-01" " 3.18167535922433616924e-02" " 7.21686839193136009385e+00" "-3.08502864184071068365e+00" "-3.08502864184071023956e+00" " 2.01646256940132717617e+00" " 7.21686787232589033181e+00" "-3.08502898752039911301e+00" "-3.08502898752039955710e+00" " 2.01646306946039377550e+00" -" 8.00914377083104422894e-01" " 3.74318575527860675223e+00" "-8.89731531833003463916e-01" " 4.06700938079185947416e-01" "-1.09547940252035069797e-01" " 3.24677600080431963403e-02" " 7.20109034208252296594e+00" "-3.10667831424185925115e+00" "-3.10667831424185969524e+00" " 2.04420712312008578948e+00" " 7.20108982474549108588e+00" "-3.10667867223124805065e+00" "-3.10667867223124760656e+00" " 2.04420763990599985149e+00" -" 8.21119881919092575728e-01" " 3.74978051074245311014e+00" "-8.84968366970140474237e-01" " 4.25242841966119611286e-01" "-1.08216091396424254900e-01" " 3.56066670528910333982e-02" " 7.12115106733431080244e+00" "-3.21134278068315071053e+00" "-3.21134278068315115462e+00" " 2.18284767042016136784e+00" " 7.12115095705695289041e+00" "-3.21134306334145014361e+00" "-3.21134306334145014361e+00" " 2.18284800723850969106e+00" -" 8.36653386454183189969e-01" " 3.75626552917330336356e+00" "-8.83127895138310470280e-01" " 4.40375999873449497368e-01" "-1.07247653747857038531e-01" " 3.78813431322628096920e-02" " 7.07041937497533634627e+00" "-3.29560624761266085514e+00" "-3.29560624761265996696e+00" " 2.29479754808542235622e+00" " 7.07041908948655972722e+00" "-3.29560640253173131597e+00" "-3.29560640253173176006e+00" " 2.29479780942887678918e+00" -" 8.41337756813768877784e-01" " 3.75835805228160912961e+00" "-8.82338875400771383006e-01" " 4.44781649591912353614e-01" "-1.06958319940427995509e-01" " 3.84631292090882315193e-02" " 7.05515076957627318421e+00" "-3.32088907903343155681e+00" "-3.32088907903343155681e+00" " 2.32911312663623970565e+00" " 7.05515049213803191464e+00" "-3.32088922361999694388e+00" "-3.32088922361999649979e+00" " 2.32911337706562404648e+00" -" 8.61570085796883988749e-01" " 3.76963002136980396273e+00" "-8.77684522307474845881e-01" " 4.63417334526890323243e-01" "-1.05489675930593648778e-01" " 4.11535437930508132820e-02" " 6.98344578904267176966e+00" "-3.42627806786187028010e+00" "-3.42627806786187072419e+00" " 2.47805167887963717632e+00" " 6.98344554517769022794e+00" "-3.42627815048831196876e+00" "-3.42627815048831196876e+00" " 2.47805186849483938261e+00" -" 8.76494023904382579815e-01" " 3.77909135226671200058e+00" "-8.75028927002753809106e-01" " 4.77558969404785593760e-01" "-1.04430224692619672000e-01" " 4.30364794938045275297e-02" " 6.93465864636740292326e+00" "-3.50495520073717070630e+00" "-3.50495520073717026222e+00" " 2.59165694270973823166e+00" " 6.93465820755726358726e+00" "-3.50495548187783523275e+00" "-3.50495548187783523275e+00" " 2.59165743288664707222e+00" -" 8.81818963291637447632e-01" " 3.78257392795194835600e+00" "-8.73980753144620869932e-01" " 4.82562346162182076448e-01" "-1.04032148009350108864e-01" " 4.36953627268860944621e-02" " 6.91722834570849443026e+00" "-3.53279181446264667343e+00" "-3.53279181446264622934e+00" " 2.63273844681167457082e+00" " 6.91722804122732526366e+00" "-3.53279185582193777648e+00" "-3.53279185582193733239e+00" " 2.63273861005458309492e+00" -" 9.02086495654553344181e-01" " 3.79799898657566314952e+00" "-8.69927687117245440618e-01" " 5.01530091677151457219e-01" "-1.02449122719968116479e-01" " 4.60719467460025816630e-02" " 6.85456184719391803384e+00" "-3.63960775902319655373e+00" "-3.63960775902319655373e+00" " 2.79249162505953218982e+00" " 6.85456151369121347017e+00" "-3.63960793064785104178e+00" "-3.63960793064785104178e+00" " 2.79249196572672442329e+00" -" 9.16334661354581747617e-01" " 3.80968166965568411086e+00" "-8.67064678685501744049e-01" " 5.14757753393631944938e-01" "-1.01384326704223551308e-01" " 4.75614650796718704817e-02" " 6.81016287010839249660e+00" "-3.71352892761496988783e+00" "-3.71352892761496899965e+00" " 2.90706299866295569956e+00" " 6.81016254529629794234e+00" "-3.71352908224533662107e+00" "-3.71352908224533662107e+00" " 2.90706332472083062157e+00" -" 9.22374802737785715046e-01" " 3.81422503806725599063e+00" "-8.64725078231934451978e-01" " 5.19599980756672352733e-01" "-1.00877575170079933353e-01" " 4.81259089926378419433e-02" " 6.78701837458412082782e+00" "-3.74158335175526568506e+00" "-3.74158335175526568506e+00" " 2.95388017986651130187e+00" " 6.78701812678214455588e+00" "-3.74158350217303325991e+00" "-3.74158350217303325991e+00" " 2.95388047261970143609e+00" -" 9.42686019476915770809e-01" " 3.83401085914196571025e+00" "-8.62202361854551457832e-01" " 5.39563551936762419992e-01" "-9.92484481055325856724e-02" " 5.02688201255142089185e-02" " 6.73594261049710496536e+00" "-3.85269582579277036771e+00" "-3.85269582579276992362e+00" " 3.12697861895410689215e+00" " 6.73594225874305863044e+00" "-3.85269600465081918372e+00" "-3.85269600465082007190e+00" " 3.12697900656979310696e+00" -" 9.56175298804780915418e-01" " 3.84673544652245347208e+00" "-8.59584028621495077616e-01" " 5.52061450113386920080e-01" "-9.81818838207715177679e-02" " 5.15105313813915069443e-02" " 6.69725713721620508068e+00" "-3.92220112445492929965e+00" "-3.92220112445492929965e+00" " 3.24152009514918582056e+00" " 6.69725675916753715455e+00" "-3.92220138343523805347e+00" "-3.92220138343523805347e+00" " 3.24152061112269107568e+00" -" 9.63022297507382329940e-01" " 3.85430167120043698503e+00" "-8.57564557559832296718e-01" " 5.57947807514158622411e-01" "-9.75844500200148540214e-02" " 5.20945270601871276983e-02" " 6.67593936216114780535e+00" "-3.95620549261538512198e+00" "-3.95620549261538556607e+00" " 3.29945850041028787558e+00" " 6.67593897184716933424e+00" "-3.95620565868541973487e+00" "-3.95620565868541973487e+00" " 3.29945890553491860686e+00" -" 9.83385806812805518540e-01" " 3.87642609629187662179e+00" "-8.57298159903620127231e-01" " 5.79225771636781128215e-01" "-9.69637324515232740252e-02" " 5.39581497913679680734e-02" " 6.63478892091395522357e+00" "-4.06994333216582049317e+00" "-4.06994333216582138135e+00" " 3.48492602143910223944e+00" " 6.63496229494953215777e+00" "-4.07010612591893661261e+00" "-4.07010612591893750078e+00" " 3.48497151319155085147e+00" -" 9.96015936254980083220e-01" " 3.89045427669406107540e+00" "-8.51647550672810060846e-01" " 5.88678339989356036455e-01" "-9.48517702894998149254e-02" " 5.48735271589402689996e-02" " 6.59059003265847387354e+00" "-4.12800847151660654788e+00" "-4.12800847151660654788e+00" " 3.59243311443171098318e+00" " 6.59058967412733043290e+00" "-4.12800859323021374081e+00" "-4.12800859323021374081e+00" " 3.59243346801340113217e+00" [TRUNCATED] To get the complete diff run: svnlook diff /svnroot/robast -r 639 From noreply at r-forge.r-project.org Mon Mar 18 19:16:48 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 18 Mar 2013 19:16:48 +0100 (CET) Subject: [Robast-commits] r640 - in branches/robast-0.9/pkg: RobExtremes/inst/AddMaterial/interpolation RobExtremesBuffer Message-ID: <20130318181648.25CA6184C68@r-forge.r-project.org> Author: ruckdeschel Date: 2013-03-18 19:16:47 +0100 (Mon, 18 Mar 2013) New Revision: 640 Added: branches/robast-0.9/pkg/RobExtremesBuffer/GEV-MBRE.pdf branches/robast-0.9/pkg/RobExtremesBuffer/GEV-OMSE.pdf branches/robast-0.9/pkg/RobExtremesBuffer/GEV-RMXE.pdf branches/robast-0.9/pkg/RobExtremesBuffer/GPD-MBRE.pdf branches/robast-0.9/pkg/RobExtremesBuffer/GPD-OMSE.pdf branches/robast-0.9/pkg/RobExtremesBuffer/GPD-RMXE.pdf branches/robast-0.9/pkg/RobExtremesBuffer/Gamma-MBRE.pdf branches/robast-0.9/pkg/RobExtremesBuffer/Gamma-OMSE.pdf branches/robast-0.9/pkg/RobExtremesBuffer/Gamma-RMXE.pdf branches/robast-0.9/pkg/RobExtremesBuffer/Weibull-MBRE.pdf branches/robast-0.9/pkg/RobExtremesBuffer/Weibull-OMSE.pdf branches/robast-0.9/pkg/RobExtremesBuffer/Weibull-RMXE.pdf Modified: branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/plotInterpol.R Log: integrated calls for LM-plots to pdf's (without smoothing) and corresponding pdf files Modified: branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/plotInterpol.R =================================================================== --- branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/plotInterpol.R 2013-03-18 17:44:15 UTC (rev 639) +++ branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/plotInterpol.R 2013-03-18 18:16:47 UTC (rev 640) @@ -114,4 +114,16 @@ plotLM("MBRE","GE","all", type="l") plotLM("MBRE","GE","all", type="l", sm = TRUE, df = 10, gridR = -(1:15)) plotLM("MBRE","GE","all", type="l", sm = TRUE, df = 4, gridR = -(1:15)) -} \ No newline at end of file +plotLM("OMSE","Gamma","all", type="l", plotG=-(1:8), main ="Gamma-OMSE", xlab=expression(xi),ylab="LM", pre=pdf("Gamma-OMSE.pdf"), post=dev.off()) +plotLM("OMSE","Gener","all", type="l", plotG=-(1:8), main ="GPD-OMSE", xlab=expression(xi),ylab="LM", pre=pdf("GPD-OMSE.pdf"), post=dev.off()) +plotLM("OMSE","GEV","all", type="l", plotG=-(1:8), main ="GEV-OMSE", xlab=expression(xi),ylab="LM", pre=pdf("GEV-OMSE.pdf"), post=dev.off()) +plotLM("OMSE","Wei","all", type="l", plotG=-(1:8), main ="Weibull-OMSE", xlab=expression(xi),ylab="LM", pre=pdf("Weibull-OMSE.pdf"), post=dev.off()) +plotLM("MBRE","Gam","all", type="l", plotG=-(1:8), main ="Gamma-MBRE", xlab=expression(xi),ylab="LM", pre=pdf("Gamma-MBRE.pdf"), post=dev.off()) +plotLM("MBRE","Gene","all", type="l", plotG=-(1:8), main ="GPD-MBRE", xlab=expression(xi),ylab="LM", pre=pdf("GPD-MBRE.pdf"), post=dev.off()) +plotLM("MBRE","GE","all", type="l", plotG=-(1:8), main ="GEV-MBRE", xlab=expression(xi),ylab="LM", pre=pdf("GEV-MBRE.pdf"), post=dev.off()) +plotLM("MBRE","Wei","all", type="l", plotG=-(1:8), main ="Weibull-MBRE", xlab=expression(xi),ylab="LM", pre=pdf("Weibull-MBRE.pdf"), post=dev.off()) +plotLM("RMXE","Gam","all", type="l", plotG=-(1:8), main ="Gamma-RMXE", xlab=expression(xi),ylab="LM", pre=pdf("Gamma-RMXE.pdf"), post=dev.off()) +plotLM("RMXE","Gene","all", type="l", plotG=-(1:8), main ="GPD-RMXE", xlab=expression(xi),ylab="LM", pre=pdf("GPD-RMXE.pdf"), post=dev.off()) +plotLM("RMXE","GE","all", type="l", plotG=-(1:8), main ="GEV-RMXE", xlab=expression(xi),ylab="LM", pre=pdf("GEV-RMXE.pdf"), post=dev.off()) +plotLM("RMXE","Wei","all", type="l", plotG=-(1:8), main ="Weibull-RMXE", xlab=expression(xi),ylab="LM", pre=pdf("Weibull-RMXE.pdf"), post=dev.off()) +} Added: branches/robast-0.9/pkg/RobExtremesBuffer/GEV-MBRE.pdf =================================================================== (Binary files differ) Property changes on: branches/robast-0.9/pkg/RobExtremesBuffer/GEV-MBRE.pdf ___________________________________________________________________ Added: svn:mime-type + application/octet-stream Added: branches/robast-0.9/pkg/RobExtremesBuffer/GEV-OMSE.pdf =================================================================== (Binary files differ) Property changes on: branches/robast-0.9/pkg/RobExtremesBuffer/GEV-OMSE.pdf ___________________________________________________________________ Added: svn:mime-type + application/octet-stream Added: branches/robast-0.9/pkg/RobExtremesBuffer/GEV-RMXE.pdf =================================================================== Added: branches/robast-0.9/pkg/RobExtremesBuffer/GPD-MBRE.pdf =================================================================== (Binary files differ) Property changes on: branches/robast-0.9/pkg/RobExtremesBuffer/GPD-MBRE.pdf ___________________________________________________________________ Added: svn:mime-type + application/octet-stream Added: branches/robast-0.9/pkg/RobExtremesBuffer/GPD-OMSE.pdf =================================================================== (Binary files differ) Property changes on: branches/robast-0.9/pkg/RobExtremesBuffer/GPD-OMSE.pdf ___________________________________________________________________ Added: svn:mime-type + application/octet-stream Added: branches/robast-0.9/pkg/RobExtremesBuffer/GPD-RMXE.pdf =================================================================== (Binary files differ) Property changes on: branches/robast-0.9/pkg/RobExtremesBuffer/GPD-RMXE.pdf ___________________________________________________________________ Added: svn:mime-type + application/octet-stream Added: branches/robast-0.9/pkg/RobExtremesBuffer/Gamma-MBRE.pdf =================================================================== (Binary files differ) Property changes on: branches/robast-0.9/pkg/RobExtremesBuffer/Gamma-MBRE.pdf ___________________________________________________________________ Added: svn:mime-type + application/octet-stream Added: branches/robast-0.9/pkg/RobExtremesBuffer/Gamma-OMSE.pdf =================================================================== --- branches/robast-0.9/pkg/RobExtremesBuffer/Gamma-OMSE.pdf (rev 0) +++ branches/robast-0.9/pkg/RobExtremesBuffer/Gamma-OMSE.pdf 2013-03-18 18:16:47 UTC (rev 640) @@ -0,0 +1,511 @@ +%PDF-1.4 +%????????\r +1 0 obj +<< +/CreationDate (D:20130318191323) +/ModDate (D:20130318191323) +/Title (R Graphics Output) +/Producer (R 2.15.2) +/Creator (R) +>> +endobj +2 0 obj +<< /Type /Catalog /Pages 3 0 R >> +endobj +7 0 obj +<< /Type /Page /Parent 3 0 R /Contents 8 0 R /Resources 4 0 R >> +endobj +8 0 obj +<< +/Length 36234 /Filter /FlateDecode +>> +stream +x???K?&9????E-???x ??d?e???0?d{!????????s???WuOu????_??d>d?v????o????????|?o???e?oV?/6???K??O????o??????????????????-??R?v????????h?????????????[????????e???????/???????????/????@ ???~8???U?%?3t:?_? ??2?+???xq??_?[`?~?$`?????X?#0u`??????Q??L?dFn#0 +???,V?D?8???v??????????i? ,??????u4??tV?7 +?T?qV"BgV  ??????r`k?4?/ 9f`?/???\(U?_?y??f??7???c??w??|#????P?TndV?s???b1z2??/ m at o??|??.?F}[4o?B?? ???q?&`??}`??????X/??zn?????????W}??p???t????D`>_{?>8?vaEcH?8/?|aKGc?n5?M?????h?i?63??>??>-?{E?A???>??a???2OF^(?bV ?@?]n0????b?}N??#?P#???? ???? .Z??_pqZ0??M?B??:????*|P4?E??? .??-??A???????L?gh? k???T= +????????sHed???K????a?r??9??.???(d??f?.??A???YAb??PF6`??a?Q?Z??? ?9R???4?y?Y?(sM?br??R?y?? ??:??Mf5?L???&?v?l???U&b2???0n???a????|???? r"?? +??97?? +?e?N@?????}M?8??????Eg? ??? +a?>?2??ta??2+k?{?? ????h?}?f?F +????w |????a? ??nBD???????c?;p???qzF??,F?)???u???1?????v?????BG#tDV??{???a?z???x?lH;?9Of?????F?4;????u??????5??+???A?B|? +'pr?^????6>h`??3g???? +VX?? +??V?`'??qD?? ?7? l????r&+M?52?5?h??5?F??? h?? 5?<20??M? +?1l?}?[9???B!??8z??5??t?|???.L]>??????(U???bc??=%VQ? h? m? +MeF???R? vDS???c,?????K???#^???o?%???N?????H1????t[g???*x??8?>??????6??w??C????Q????c?????oEu?O|+j?1???'p}>?[Q????W5?V?@??!r mt;? +?@7??0.??`m????hW?! +4D??????v????VO at 7??e?? ?E'F:???1?ulD7?F??A???*.@???*fVn?*? v\??????? ???q?6.?f4d??? iQ l??????4?i ?a???B???#?v`f?IDd?I?b???*???"??? +??A?i?"r?N,y??w?????~?# i??bVnE??t???B???????\?J>????Y???????b? ?8?F???(,??#Gc"?????Q??ub??q????c??P??*,???h??8`F1??X?B????+r?/8` +??4?E??????@???????*\?l??????Z?C?$????V??0cl\?0'q6?F*_,v?4"?6?3????V?Ye?y?'??Y???a?~????`?9G?X,7c?^1ssdhT???VL????????q?i?? +???oc1tb???[???ya????y ?j?X?s?? ???7??h? l?X,/,?????0Q_0#?(?d????0X??n??16n???W?????_???z???Ym?S?U??v??Ua?8U?`?d\w? +3?Y? +???ow?????)q?8+??pQN???`? \h??U4?e??\h/??????? t???m`B?8?nu ????g?.t?????RT?s?????gtg;'3? +???s?H??m????cX??zN????O;}?+??d????CD/z>??:m?????O*iNLC???7b^??o??? D???>??'\???K?p??p ?p7??? w?]??;???'?????_???O??o??(??????? |?????F):??????K?????????(e?MR?????q????hJ??3e??)9 +zRN???+??_?????7H0*>?5&?;x?[??p??k??????^=??G8 +?????o?y????B???Q?_M????(i???'????0?????O?F?????n???X?? +???aF??:?????/*??H???NNwW k?yR?>????????????????I?A??c????|? ????????v?gV?)?????^??{???+??H??>???????1:??????;????y??#V??{?u`??2??]???Bya???Ol??,???+????L??G??9? +?7??a??'6;??1???;7?????o(?T??????~_?n8??[?6???u???"??Y??n?????Fn?.?????/?o??w8?9O??X?_ Gy?sS?c=83????n???N6??7?o?{?y?Y??>??????c>3?p>9? +O?`#w?wq?y?9???;x??x?q??? ?T^b?'??'/????Y?3????fc}?w??????6?\o???z??||???????o.?????/e?O????|q?z?o]????0~U??}?u????^?????;???A?vsK/?7?>t?????f?o?????^??? +?W??????????f{q??{???=?w??m????{????^?C???????,??^??????Bk&??`Uzz ??L7?U??'???n??Ptv??7=??B??G??m}??.4n?:?Ah?_r???Q??:?w???,d?Q?C?_|??s?g?5^????/)~?_????o??O_vY?n??>???a??Ol???/WCj"g???p"??P +??@????A?t?W??q??l????????/?n?T^9???;???F(?Py?=w????;|>???ySf?y?c???p??w?????????'??~R?n!????q?s????s??7?`??4??{??????+?o??;?76?????A'?K??gz3w? +\S???????????T>??t?QybZ???t]*9/??`???G??t>??/?O??,???????,??kr\ {???~?zL??j??? ??9w8????U?|;?^[???????:g?????OL???z? +n?9??n??u?(/?_ndk?Z?#?:?'???Z\????s? +?????4,t?TY???N??}? ??????3t?????|?_????1??Tp?L?????? +? +????p??o?TxVm??(D?T>????S?????C??]????M??b????^??p?{?????????7~?????????F?G?,Z??7?s>? ??=1????Zp?Q?G? +???;???}c?????+j_???A??'? + 6?c??????O?????????????c?P{???? l???y1u??S??G?zn??TU|x?L?]e???_???4?U(?L?[??v9Hsn??&??zV?????M?f??.M? AQ?????o???????=, ?7?????d???????7?????Y?? +#????m????7?3????t???? M2} b}]??????o????W??P???c=^y?H?%?@z??j?#E??????????O?? +%???p?? ???t???\???h????????S?F??*??U6????????)?F????CSy?a?+??^]? +?????pS?L??]?E=aW??V?????*??c{??_?`?y|(??=>???????F????????U?? f|????r???Qp?#G?|??2??z?h/V???7????Jo????pC~C??~???Q???r???}b?]?TyC??????hQ|Cz?? 7??%?U?;????L??2?? ? ?=y??,?%y???e????E?B+x??A"?Y?????????3??D??o?k??SA?????? +Pg*f??l? 71?XO[?b??y?=???Fy?????o????.??1??~??????L??U? +??`E??M??A{?"??????Z?Y?`??????o$f?G,t?'k????T8?dc??? +???? +i?g?7???G?P???P{??~???m?}`:?ey???b|?&7?X??+?G8?+?o at k}nT0k?8?O?~??? :/?????????d???D?oFxW|??E????p???,G?h??x??N?*=???~E?d1?lE?d???O??)?';??d?8??j?`?7???G?-?\p*?]T??]ZSx?.,?W???????1??T??+m??r??O??@??e7?????????*&?O}b????????? TMV??.?r????}?2pW)?V?q?B????@K??q??\q??@~ *c??S?7???E?`????Y???_????b???G???p?|?E?~|???`????/?9??????????77?_??????+?@?j??S???O??U?BxW?~Y)?????u?q???X*?GV????r???????L??=???F?\0N?????????????8??5??8u*?D{???O?-???v?WC????s?)Z#??;???Tn(>O?R?b??S???<?=+?j?% ^?C?u??T??S'???1??t??G??O????S3|?????8%?&#G???T???????????/?T??S?B???:?d??JML{???=?*:!|5???U???8?)??}?h?<5r??^qJ`?d}???-?S|n?V%??'?????'?????M?}?nur?? ?{h? v??????y???9?!3>??{|?TH??????????U????#f??? +???} +??,s0v1????10?z#=??j??????C??>L???+??/????XC>???>?A??Y^?*??/?/?Y???K^??????f?g?| ?'?o????? .??,??P??_!'??p??????????'?^8??.r?y????VZ???`???b|???{???????~?Z????1?????????F +????y,?_?o?}?~L???????^?o??'??UNJo?UN?ovs?.sV??U?x`??i?-??S+???????? +U^??V?E??+?P??|???=??4?J_?k?????#????????W????~2??i>zx?X???? ?v?J_?? +????7????W?b!??c>?S??S??_"?9??X_??<??G{2??h_?S??/?2???U?? ????Vj/ +?N;UO!/l/F?1???$????0??O?6:UR?9V??x?????[ |??\????a???? ?s?????????o?x?2???;????a??y?/x???~0??????? +?w~?+z?????>????>@.e?*.~0(x????/? ??SD????8????????T??????????`?y??q ?k??O?^lL??_?b???b7w?????G}:??;oq??w=?c??Vg ??NO???????????d??.?/n/~???????????Wz?????}o??????????}~?o?????U>???0?M?_?oVR?2_?/??yx?l????? ??nf}:y?????on7?=o????????????:??/????n???\o?}????y?????t?????K?w??l/nvsGy1?]??wY?C???????^?h|a????p????[????{???v?????????????7_??v??k?Y?I???{?Y??????j_???pK??Ro??f??????kb???,{???????c`????+TG ?Re`?P^??pBG;???f^???-w??=??0???J????>???5?&??????? ??2@??g??+0?????\!???3Uq? +(U???|? +ml??#u???+???e??U? +?*7q?p???i???@lo?;sl ?#??!r ?^v4?J"?u??ZNl,2+o???O??UY??bW!??? +??A"??N????k???x?N ???6???_??? \?3A`??????>??%?+G???=???D ??o????Q?U?&?O??????2?@Z?@?!??\x?d?????X??????/=?Y|2.??3m?v)I?7????"/?F? +BN?+?@?\?\7_~??9?? ?Y7B?? <???h????!??e??7??(?.?E# ET`?Y??u??l|?D???&z??(,a`???v?ZP}??? k???/(l??qa'f??v? g?p?????Q?S??E[B|?5?W?b|8???V?_?^N?|? +8?? ?'????A?m??&[-n???4????????h?qc??4??1?>8?,$kd,?P??e?9?V??????psb?O?o?2?N8??v?9???? +?#??_k*???V=p?1???B?7&??cb??u???YUb??cw??*????7????&;???Co??6?Sz????????q??? ??1?????15m??u.?Ln?0??a?;W@ +??l6X?>0ri??^?p?]??4~?N??:?????@ch6d?O?+??? ??'&c +??W? +?Q???~???0??6?a???L??0?i?m?[?`?GR?b?9,??? +?<2L}??td??}Y-'?#k??O??d?d??< +& +y5??????????g??(U{a?G?.D?Q N???????B????] +?c?;???`?wl???i????4????????hj?a?G??G???c?y???1??? ?????????????c`?y???!cc +??9???p?wk?+$?c7o??_???L??6???b? w??? ??h&Y??f???@?tzf???f?A? ??4??h?G??| i6c?F?l?q??0? K????? k?q]h????u?~???P? +?q??? ???Q???l?=????}w"??7????B2?2?u?Z?????????7q???8/T? ?D?g??i??lu1%?CVE?F(?e??/?;-;???A??1????G??=T?9???Q?x??? U????????.?O?dk????P,?(??l?????-]?V'?w??.?|Prh??\I?l#s.@c i??vc??? iFb???.Tc?3f???%`??~?Em2b???`? ?u????6? i7???8???/\'?IB,?????B????B??X.??rh??I?U`M??i??lf??\]??P???j7???????????8?k7!???? 9?? +wM??BN?b??????????q?]?9????Q?9??9?? i??o#6B????Bv????????}3G??Gu?z3g +??n'?]Q#s???&c3???6????????Q?L??o?D?c?C?uG?k!??%??$h???? ?a8??K?kp????C?j/???U?-l????q3?H??5?#? )?????#?VJ???W)???B?_? +???G?v8? ?i????=?%?l;x????'nR?px????3???W??d?\???? +??:??-Z??5????os???U? +E<>7?>?D??f?/Oq?^z????V?k???&?n?/N??H????5C?~ +n???Y?v????????)??O? +e?????s3.??W??~B<[??!S??O???x???*??^???q?C?H??sh?y???s?&???>w?????????z??????????g\???("?p?_elb?g~8???:?}"??????gs????}?(?1R0?M??iD???:8?|>?K;w?>?Mt?w?????M:?$7 +?/?t?02T?8g(d????4X?/>?2????(????:??!?{{HT d?$??;X?????C?}???????Q??.?7g?+~F?????UWpax"G{??s????????o(_?b??rgx/??7P~???? V?&?_?~????#?vl??Q?>?H?9?????`???m0?'??(oR???%?7??????>??_?U~?]????}??x????????`???|?xB?????G??????P??x????6???X??????2N?n.??~3?????????q?=??~??????x???{<???c?/???3CXpr?7[??????f???????????{?y?????h%???9?????g=9k???????x?|?g??\?x&?x*???\?x'??&?x&?x&??%??????????o????_????[????y^????????,{????U???=???U\??6n?v??7?+???V\???vQx?w?l7?W????z~????????s??SN??????_?Kz?+}y?/??????????~?J?^?k???U????????y?(?????Wy???????_?]???????????????\o.???y??;????^?n???W~???^?i??? +????W?x?w???W??z????+??????~8???|?????w????c???^??W~?U??*?x?????W???????=??????>??W3s}????/u?7?????????M?l/nvsO7???o????W??{?????Tq????[?????_?G?9?+???U_?N???~s7??;?^?^?????7????????9wr?7?|??????????^?l???z?????k????|???a???k?R?=??t?'?0?????e??k<-????????????o%????=?{?.{?vs????+?? +?Wy?=(??_???{>^?O???????^1?'o?r?e????x???+?v?oK??????????}i???W?/??ci??^?????K????????5?/?|??s?^????|??????e??????y??@???{y?D??????|*M?????3?6?|????)w%?1r???3?U?]??N????????Q??i^}W?'E????s?W?????n?`?????????c$??????C~?>c`???1J??=1?W?8?>b?1P?'?S???]?V??????'???b"?ik??k??T?R?*??uW???????? 6???????^?O +as?Ja o?P +??????-?n)?{?t?c-?? +???A??$L??*r?U??.Y??E??p?d?o~??2\????|V?t?????????+?:g:J ?I??$:?rf}???WZQy??J?g}??/Qz>?^e?G?bY??s???t??M?R????f-r???&f????D???L?vs?+&=??g??{?P??@??w??{????=1???S??LE?;L?l_W????v?0?_????~??$?????NQ8=,mt???r?cb??+????????o?? ?????~?!?? ??(>}0?&??M?????t?0??k????FW|??T|9?T|?4Q|?yh?Ow"M?????d?}P?????c???*??[?{N?I)?_?t?B{0?G%+>?Pd?O?/Y???MR|9?P|??I??yp^?????}y???)>??:?????q???B|\?s???^?????k?M???eS|^+5??ECS|^h5??????>???m%??oH??q??(>oZ?t??w`??yY1~/g?????????Y??F;?}? +??????L*o?o\n???p????h???~d1????9\nT??`?R_??!I???o?O??M???????C:???!e +F?????????? ??'??+????????Y???O????"F?R"??,??U?>7:? +E??_?F?? ????&^`??????Y ?_?grFx??B?b+>U? ?|??W??U?????_VyX???,????T~\?K?S???7ZV?T?f??????????~???????> +?GV??b$c??'7?????sF?l?t??1?p?x^??\?!?(??p???e??Q>?#H?j?4?y????>?F4?l7?gr??a?)M?#6? +o?????=?p?U??\w^]??,???w????Qg?'r?? +?Wq|??8????sQ????a=??x?{??B?D?XO;???~??&Zp%??P*?3????:?JK?U??h?U????T?o?????Ds? +????_??????_?M??z? +????????_????~???? +?5q??B{Z ]*???(??????[??8??g?_ +???/p?????{^?:a?~?F??W??????(>?2??+ ?b?2??c?7??x">??R?LO??8????1/?&?!??tB + F??????<;:p +???????X(?1?????yU? ?V??J?yU0?-???/?e:-??I ????0?;6~*E`??????#-?e?Bz>???D??] ????%k???c?`d???????P?g???|?#?????"?#?g?K6rf?"f?$^??b?8??????+????? +????4??`?_Q???+\??_??(C???7??????%F??????_????~:??????????I*?Dy????W?>???J?? +e?|?????OG{??>???? >??U???V?3>??{Q????r~1?W?????J_P?l????c>Q?+?????i??>~????]?,??!s=\???????_V???j_?/???[?k(??H????Y?i?(O_b???????+??=???9???zE6???X?8?yU?????<??????????epU'g??????^b?c??? _gK?a5?4\?????| +y??????T??G???????? ???8?3H????,???k?`????_?????x??????b?k&?ox^w???o1????????????g??,k??|? U?c?uIa?g }?Y1?g????.???q?)????????????????sRX?????n?`L???A??/??W?????????|???b|?(!?xb??5|G>1?W?9??????????YjX#?jX?????????M?????JR??u?6?P?/2????a?x?a +??[ +|?a +??[ +k??$5???? +>??????T?jX?S +|?a?O5??t?a??K +?n?v???5q??T?:?j?`??T?:K +;?T?V??~??O5?????K.???T?~????T??an>???c??~=Y?O5??tE???~????R.5l???u>??V??? +?????U?S +???R?*?T?:?jX?S +|?a?O5l???u>?????p??????%}?YjX????????T??A???T?jX?S +k?.5l??? +>??????T?jX+v?a?O5l???5^??6?P?:K +;???Yj?">?????p ?????6?P?O??? +>??????T?Z????T?j??C +?|?a??K +?|?a?O??W,5l"?jX?S +?|?a?O5l????2???O5?AF?????6?P?:?j??C +?|?a?O5??q?a??K +|?a?O5????u>????K?a?O5?Af???????T?dK[ +?,5l'?j??C +?|?a?O??W|?a???U8?????R?dd[ +?|?a?O5l???u>??Y?V??????x?+5????u>????6?P?ZM[ +???|?a?5????5?K +k?in5??????a?O5??t?a??K +k??n5l???u>??????T?O???5t?a???U|?a?T?:?jX???j??C +?|?a???5??? +>??????T?jX?S +k??o5l???5t????Z/5??Pl5l???u>??_??? +>??V???5??? +>??V?R?:?j??C +k????T?:?jX??x???5 ?[ +k???V?jX?v?a?O5?Q} 5??v?aO??S +k?Fp??O5???R?_~?a???U???u?V????????5???5L????+?V|?a???R?:?jX??h?a?5????V?Z???P V???u?V???xZ-5????u>?????x?,5l???u>??????T????6?P?O{?????????m?S +|?a????u>????P?a?O5??4??S +k????6?P?:?jX?S +?|?a?O5??4SjX?r?a?????C +?|?a?O5????u>?????YjX??^j??C +?|?a?O5????u>?????Yj?)>??fv?a?O5????u???O5???TjXg?a??R?:?jX?S +?|?a?O5????5? +=?????YjX??jX?S +?|?a?O5????5???T?:?jX?S +|?a????u>????6?P?:?jX???C +?|?a????jXk?R?:K +;????T?jX?S +?|?a??K +?|?a?O5???? +>?????Z????R?v???u>????3J +?|?a?O5??tRjX?S +?|?a??V?6???u>??????u>???R?V???u>???R?&?????/5?????6.5????u>??????T?Z????T?:?jXk?R?:?jX?S +k=]jX?S +?|?a?O5????u>??????u>??????T?:?jX?S +?_|?a??K +\_|?a?5???? +>??????T?j??C +|?a?O5l??? +>?????YjX??T?:?j??C +|?a?O5l??? +>??????K>????6?P?j??C +?|?a +?9?jX??R?S +???6?P?:?jX?S +|?a??~?a?5???? +>??????T?jX?S +|?a?O5l??? +>????6?P?:K?Z_??N5?u?????68??P?:?j??C?zr%?j??C +?|?_??S +?|?a?5???? +>????6?P?:?j??C +k?]jX?S +|?a?O5???? +>??????T?jX?S +|?a?O5????u???K +|?a?O5l???u>??????T?:?jX?S +?|?_??S +|?a??K +|?a?O5l???u>??????T?:?jX?S +k???????6?P?Z??6?P??>????>/5???????o?f??jX?S +|?a?O5??C?R?Z_???T?:?jX?S???R??>J5??|?a?O5l???u>??????T?:?jX?S +k?\jX?S +?|?a?5????u>?????F????????J?aM???@????T???K +?|?a?O5l???u>??????T??h???T?:?jX?S +?|?am?K +?|?a?5????u>??6???u>?????????????T?:?jX?S +?|?a?O5?????1/5????u>??????T?:?j??C +kc]jX?S +?|?aM???q??Z +k?M???V??&????????%?1???c???]jX??_ +?1?g????.???q???????S????O?ac??????{}???"Aj]????6??Q^j??j?c?aCjX?x???Q??=1?g ?a?Q??e?b??????R?jX??Z +{?1????b?_wm^|?a??w5?????Q??v?O?a???T?????K????^??ix}j?.???J?/????~??tc?p?p\??K?U?}??eFb??9f2??? ?s????????8?5Z?)xp9l;?o[?m?????S??8?V7? +?>`6[?)0???? +X?Va?)?j?{???????l??Fa?ZE?0n~bn@N"sf??4Cg???f?B??5S???4C?x0??a?0?r????Bsn(?1?????????? +/???82???????=??64??.????kqXo4`C????N [?`V,?`?U?@O_?&? +{?Rkaz?9?-??=??>???????%E=?[- ?=?,???aba??M?k????s\?8??????^??.?:(%NlH??UG??L?+??~??????a?c?? ?4?a?{h +X??S?????r???????q8?6???1p?m? ??n?0?8p ?@c?????K??(?D???Z? +???????????Y??????l???1I?8 +N?b\?^V?R?????s@~}X??#M?C??????%&??.?$6=?\?Q?4~??3??%&?B??g?|/????????B?????'?Y?MD??9L???V5c??:???e?v? +&?-.?????e?3?Y,???<????fM??;#?D'??k??@??Y??*??*p7?b;?-??]????G3(??h??q??&P ??B???\S.!r????3s?$???uR?p?????Z? +\D?C?)????P???MC6? Z??)De?s?5@??|??^?mp?Y???]j?UY ~??-m`Fg?????U? +???%_????1.??q??????fY??q?,??????.?#?S?@f??_i?????,??1xq?#?_??@? \b??8?,???q????f ??y???S|???uC??? +b?c??kt??a ? LY1???Hj?I?????]?@???ep}???????J????e?????u;,?1?q??N: ????C??????@?A?u` ?7?u smZ?T??g???;????????=?s?t7??X ?l??CIm>k +???e????m??+??????K??1+p?=1x?????a? 4?";1V1[??s?u???9n??|??6?:??8PIu?b??E????? +8X"W???z?1W[?#o????g??o? ?3?"?I(?????=N????{K?8?M??)7e2??-O????-???n)S????s8v?(?K??[? +=??["[??????:lY?{?{;???U7???s#?a7t!?Zz?`?????X??1????^?W?C???g???y+?????`r?w?f?qtx_?##?????O??l +?9C?It"???Z?]L???y?????????????p2)?e>Y??,??[?y????3?d?)??m +?>YE??/*@|Xh??m????N?P????????6}???AC?/? ??@'??7C8??8?2?v#?zv???????????p??e???1n?9???O????[??,?????[???D??u??p'o?z?L???"j??c?2??????J???5?p.??&?pQ??9? +@=?Z?]5??n ??1????r?!?[~8??{<)??!?}e+?^???Ya??pQ?V???U???AD???4???\JoMM??nd?7????i)t????l???nl,?P????+??z?D??2#,??b?l???r?wib??Ph?L?b|h@????A k????~,]?~???l?R??V???;q???"?@T? +?!????Z???ho??? ?&1?ntn??G?? +???q??ns?av??"gC??xM?p*?-?&???n??h??V7???E\ ?Y???V [ +6??q0a????&6???????.y?????_??f?????????.X ??{??%?F?l??L??????F??#??|???j?08tz?.?6?d`????-?????C?xqOv???Kr??(???SH+?'\? ?.Q? ????k9??/?_????on?w??|^??H????????6?6?5????y|0?_?? ???|?i?????;?7y???x???r??y???x?td^???x?uSo|???????o?w???sr?_???>??????;6?@a-s?????????-6????jku\ ???OA???F??6??z>???}??????>??1?]????5(o?/???????7?_? ??+w?h4??kg???U??'??%?????q??2????|?f~??u$?o>??y%?????e??/??????X?wt??/f?GK4????~???<.??s????gJC??L?}v?'3??%??)yX???H??????!?7??R????\?mQ~??f~?~????+????E?d??????re?? +w??V??%?N7+/??|????O?G?????1???|?O?_??;??~S?XX?????????o,?KOs?:??8?w?x?7???o?????????d??g?y??????)??O?????X?_b?'?y????5?????3??p;???fI?V??|Q????+\???????b{?????a??^?O;Y???????????? +ov?x????????????K??????=?On/?d'??}??}???_r{?kr{??~??'g{5q?'?Y????a???+??NV?p??????Y??8y????????xx?Adx??'?u??_||???1??{>??.?u< ^'{??z???~?w=?+????????O??v????????b??w?G?s>??l'???}?.?G????O??d???????n/^'??????gy????M?G}?O{???g??????~???~?W?/????Y????>twv?+~?^?z???o???+~?/^/~=?^??????{??W???r_O??O^?o????h???????_????????x?z??|??[????_??????x????|$??????=??r??????????7???????g?^??W????|?}?????h????????/m???6??^????h'?O?z/y???G?v?o????f?|??9?ov?????~??>6;??6_??????9?y?????{??>\??m?+??s~??9?m??_???[ Author: stamats Date: 2013-03-22 18:01:22 +0100 (Fri, 22 Mar 2013) New Revision: 641 Modified: branches/robast-0.9/pkg/ROptRegTS/DESCRIPTION branches/robast-0.9/pkg/ROptRegTS/man/Av1CondTotalVarIC.Rd branches/robast-0.9/pkg/ROptRegTS/man/CondIC.Rd branches/robast-0.9/pkg/ROptRegTS/man/CondTotalVarIC.Rd branches/robast-0.9/pkg/ROptRegTS/tests/Examples/ROptRegTS-Ex.Rout.save Log: some minor corrections, preparation for release on CRAN as current version gives warnings Modified: branches/robast-0.9/pkg/ROptRegTS/DESCRIPTION =================================================================== --- branches/robast-0.9/pkg/ROptRegTS/DESCRIPTION 2013-03-18 18:16:47 UTC (rev 640) +++ branches/robast-0.9/pkg/ROptRegTS/DESCRIPTION 2013-03-22 17:01:22 UTC (rev 641) @@ -1,6 +1,6 @@ Package: ROptRegTS Version: 0.9 -Date: 2010-12-03 +Date: 2013-03-22 Title: Optimally robust estimation for regression-type models Description: Optimally robust estimation for regression-type models using S4 classes and methods Modified: branches/robast-0.9/pkg/ROptRegTS/man/Av1CondTotalVarIC.Rd =================================================================== --- branches/robast-0.9/pkg/ROptRegTS/man/Av1CondTotalVarIC.Rd 2013-03-18 18:16:47 UTC (rev 640) +++ branches/robast-0.9/pkg/ROptRegTS/man/Av1CondTotalVarIC.Rd 2013-03-22 17:01:22 UTC (rev 641) @@ -14,11 +14,11 @@ \usage{ Av1CondTotalVarIC(name, CallL2Fam = call("L2RegTypeFamily"), Curve = EuclRandVarList(RealRandVariable(Map = list(function(x) {x[1] * x[2]}), - Domain = EuclideanSpace(dimension = 1))), + Domain = EuclideanSpace(dimension = 2))), Risks, Infos, clipUp = Inf, stand = as.matrix(1), - clipLo = RealRandVariable(Map = list(function(x) {-Inf}, + clipLo = RealRandVariable(Map = list(function(x) {-Inf}), Domain = EuclideanSpace(dimension = 1)), - Domain = EuclideanSpace(dimension = 2)), lowerCase = NULL, neighborRadius = 0) + lowerCase = NULL, neighborRadius = 0) } \arguments{ \item{name}{ object of class \code{"character"}. } Modified: branches/robast-0.9/pkg/ROptRegTS/man/CondIC.Rd =================================================================== --- branches/robast-0.9/pkg/ROptRegTS/man/CondIC.Rd 2013-03-18 18:16:47 UTC (rev 640) +++ branches/robast-0.9/pkg/ROptRegTS/man/CondIC.Rd 2013-03-22 17:01:22 UTC (rev 641) @@ -7,7 +7,8 @@ } \usage{ CondIC(name, Curve = EuclRandVarList(EuclRandVariable(Map = list(function(x){x[1] * x[2]}), - Domain = EuclideanSpace(dimension = 2))), + Domain = EuclideanSpace(dimension = 2), + Range = Reals())), Risks, Infos, CallL2Fam = call("L2RegTypeFamily")) } \arguments{ Modified: branches/robast-0.9/pkg/ROptRegTS/man/CondTotalVarIC.Rd =================================================================== --- branches/robast-0.9/pkg/ROptRegTS/man/CondTotalVarIC.Rd 2013-03-18 18:16:47 UTC (rev 640) +++ branches/robast-0.9/pkg/ROptRegTS/man/CondTotalVarIC.Rd 2013-03-22 17:01:22 UTC (rev 641) @@ -14,7 +14,7 @@ \usage{ CondTotalVarIC(name, CallL2Fam = call("L2RegTypeFamily"), Curve = EuclRandVarList(RealRandVariable(Map = list(function(x) {x[1] * x[2]}), - Domain = EuclideanSpace(dimension = 1))), + Domain = EuclideanSpace(dimension = 2))), Risks, Infos, clipUp = RealRandVariable(Map = list(function(x) {Inf}), Domain = Reals()), stand = as.matrix(1), Modified: branches/robast-0.9/pkg/ROptRegTS/tests/Examples/ROptRegTS-Ex.Rout.save =================================================================== --- branches/robast-0.9/pkg/ROptRegTS/tests/Examples/ROptRegTS-Ex.Rout.save 2013-03-18 18:16:47 UTC (rev 640) +++ branches/robast-0.9/pkg/ROptRegTS/tests/Examples/ROptRegTS-Ex.Rout.save 2013-03-22 17:01:22 UTC (rev 641) @@ -1,7 +1,8 @@ -R version 2.10.0 beta (2009-10-15 r50107) -Copyright (C) 2009 The R Foundation for Statistical Computing +R Under development (unstable) (2013-03-13 r62247) -- "Unsuffered Consequences" +Copyright (C) 2013 The R Foundation for Statistical Computing ISBN 3-900051-07-0 +Platform: x86_64-unknown-linux-gnu (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. @@ -17,78 +18,13 @@ 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. -> ### *
-> ### -> attach(NULL, name = "CheckExEnv") -> assign("nameEx", -+ local({ -+ s <- "__{must remake R-ex/*.R}__" -+ function(new) { -+ if(!missing(new)) s <<- new else s -+ } -+ }), -+ pos = "CheckExEnv") -> ## Add some hooks to label plot pages for base and grid graphics -> assign("base_plot_hook", -+ function() { -+ pp <- par(c("mfg","mfcol","oma","mar")) -+ if(all(pp$mfg[1:2] == c(1, pp$mfcol[2]))) { -+ outer <- (oma4 <- pp$oma[4]) > 0; mar4 <- pp$mar[4] -+ mtext(sprintf("help(\"%s\")", nameEx()), side = 4, -+ line = if(outer)max(1, oma4 - 1) else min(1, mar4 - 1), -+ outer = outer, adj = 1, cex = .8, col = "orchid", las=3) -+ } -+ }, -+ pos = "CheckExEnv") -> assign("grid_plot_hook", -+ function() { -+ grid::pushViewport(grid::viewport(width=grid::unit(1, "npc") - -+ grid::unit(1, "lines"), x=0, just="left")) -+ grid::grid.text(sprintf("help(\"%s\")", nameEx()), -+ x=grid::unit(1, "npc") + grid::unit(0.5, "lines"), -+ y=grid::unit(0.8, "npc"), rot=90, -+ gp=grid::gpar(col="orchid")) -+ }, -+ pos = "CheckExEnv") -> setHook("plot.new", get("base_plot_hook", pos = "CheckExEnv")) -> setHook("persp", get("base_plot_hook", pos = "CheckExEnv")) -> setHook("grid.newpage", get("grid_plot_hook", pos = "CheckExEnv")) -> assign("cleanEx", -+ function(env = .GlobalEnv) { -+ rm(list = ls(envir = env, all.names = TRUE), envir = env) -+ RNGkind("default", "default") -+ set.seed(1) -+ options(warn = 1) -+ .CheckExEnv <- as.environment("CheckExEnv") -+ delayedAssign("T", stop("T used instead of TRUE"), -+ assign.env = .CheckExEnv) -+ delayedAssign("F", stop("F used instead of FALSE"), -+ assign.env = .CheckExEnv) -+ sch <- search() -+ newitems <- sch[! sch %in% .oldSearch] -+ for(item in rev(newitems)) -+ eval(substitute(detach(item), list(item=item))) -+ missitems <- .oldSearch[! .oldSearch %in% sch] -+ if(length(missitems)) -+ warning("items ", paste(missitems, collapse=", "), -+ " have been removed from the search path") -+ }, -+ pos = "CheckExEnv") -> assign("ptime", proc.time(), pos = "CheckExEnv") -> ## at least one package changes these via ps.options(), so do this -> ## before loading the package. -> ## Use postscript as incomplete files may be viewable, unlike PDF. -> ## Choose a size that is close to on-screen devices, fix paper -> grDevices::ps.options(width = 7, height = 7, paper = "a4", reset = TRUE) -> grDevices::postscript("ROptRegTS-Ex.ps") -> -> assign("par.postscript", graphics::par(no.readonly = TRUE), pos = "CheckExEnv") -> options(contrasts = c(unordered = "contr.treatment", ordered = "contr.poly")) +> pkgname <- "ROptRegTS" +> source(file.path(R.home("share"), "R", "examples-header.R")) > options(warn = 1) > library('ROptRegTS') Loading required package: distr Loading required package: startupmsg -:startupmsg> Utilities for start-up messages (version 0.7) +:startupmsg> Utilities for start-up messages (version 0.8) :startupmsg> :startupmsg> For more information see ?"startupmsg", :startupmsg> NEWS("startupmsg") @@ -96,8 +32,16 @@ Loading required package: sfsmisc Loading required package: SweaveListingUtils :SweaveListingUtils> Utilities for Sweave together with -:SweaveListingUtils> TeX listings package (version 0.4) +:SweaveListingUtils> TeX listings package (version +:SweaveListingUtils> 0.6.1) :SweaveListingUtils> +:SweaveListingUtils> NOTE: Support for this package +:SweaveListingUtils> will stop soon. +:SweaveListingUtils> +:SweaveListingUtils> Package 'knitr' is providing the +:SweaveListingUtils> same functionality in a better +:SweaveListingUtils> way. +:SweaveListingUtils> :SweaveListingUtils> Some functions from package 'base' :SweaveListingUtils> are intentionally masked ---see :SweaveListingUtils> SweaveListingMASK(). @@ -115,16 +59,14 @@ :SweaveListingUtils> vignette("ExampleSweaveListingUtils"). -Attaching package: 'SweaveListingUtils' +Attaching package: ?SweaveListingUtils? +The following object is masked from ?package:base?: - The following object(s) are masked from package:base : + library, require - library, - require - -:distr> Object orientated implementation of distributions (version -:distr> 2.2) +:distr> Object oriented implementation of distributions (version +:distr> 2.4) :distr> :distr> Attention: Arithmetics on distribution objects are :distr> understood as operations on corresponding random variables @@ -143,31 +85,22 @@ :distr> vignette("distr"). -Attaching package: 'distr' +Attaching package: ?distr? +The following object is masked from ?package:stats?: - The following object(s) are masked from package:stats : + df, qqplot, sd - df, - qqplot, - sd - Loading required package: distrEx -Loading required package: evd -Loading required package: actuar - -Attaching package: 'actuar' - - - The following object(s) are masked from package:grDevices : - - cm - -:distrEx> Extensions of package distr (version 2.2) +:distrEx> Extensions of package distr (version 2.4) :distrEx> :distrEx> Note: Packages "e1071", "moments", "fBasics" should be -:distrEx> attached /before/ package "distrEx". See distrExMASK(). +:distrEx> attached /before/ package "distrEx". See +:distrEx> distrExMASK().Note: Extreme value distribution +:distrEx> functionality has been moved to :distrEx> +:distrEx> package "RobExtremes". See distrExMOVED(). +:distrEx> :distrEx> For more information see ?"distrEx", NEWS("distrEx"), as :distrEx> well as :distrEx> http://distr.r-forge.r-project.org/ @@ -176,18 +109,14 @@ :distrEx> vignette("distr"). -Attaching package: 'distrEx' +Attaching package: ?distrEx? +The following object is masked from ?package:stats?: - The following object(s) are masked from package:stats : + IQR, mad, median, var - IQR, - mad, - median, - var - Loading required package: RandVar -:RandVar> Implementation of random variables (version 0.7) +:RandVar> Implementation of random variables (version 0.9) :RandVar> :RandVar> For more information see ?"RandVar", NEWS("RandVar"), as :RandVar> well as @@ -196,18 +125,18 @@ :RandVar> vignette("RandVar"). Loading required package: ROptEstOld +Loading required package: evd -Attaching package: 'ROptEstOld' +Attaching package: ?ROptEstOld? +The following object is masked from ?package:graphics?: - The following object(s) are masked from package:graphics : + clip - clip - > -> assign(".oldSearch", search(), pos = 'CheckExEnv') -> assign(".oldNS", loadedNamespaces(), pos = 'CheckExEnv') -> cleanEx(); nameEx("Av1CondContIC-class") +> base::assign(".oldSearch", base::search(), pos = 'CheckExEnv') +> cleanEx() +> nameEx("Av1CondContIC-class") > ### * Av1CondContIC-class > > flush(stderr()); flush(stdout()) @@ -255,7 +184,8 @@ > > > -> cleanEx(); nameEx("Av1CondContIC") +> cleanEx() +> nameEx("Av1CondContIC") > ### * Av1CondContIC > > flush(stderr()); flush(stdout()) @@ -295,7 +225,8 @@ > > > -> cleanEx(); nameEx("Av1CondContNeighborhood-class") +> cleanEx() +> nameEx("Av1CondContNeighborhood-class") > ### * Av1CondContNeighborhood-class > > flush(stderr()); flush(stdout()) @@ -314,7 +245,8 @@ > > > -> cleanEx(); nameEx("Av1CondContNeighborhood") +> cleanEx() +> nameEx("Av1CondContNeighborhood") > ### * Av1CondContNeighborhood > > flush(stderr()); flush(stdout()) @@ -344,7 +276,8 @@ > > > -> cleanEx(); nameEx("Av1CondTotalVarIC-class") +> cleanEx() +> nameEx("Av1CondTotalVarIC-class") > ### * Av1CondTotalVarIC-class > > flush(stderr()); flush(stdout()) @@ -392,7 +325,8 @@ > > > -> cleanEx(); nameEx("Av1CondTotalVarIC") +> cleanEx() +> nameEx("Av1CondTotalVarIC") > ### * Av1CondTotalVarIC > > flush(stderr()); flush(stdout()) @@ -431,7 +365,8 @@ > > > -> cleanEx(); nameEx("Av1CondTotalVarNeighborhood-class") +> cleanEx() +> nameEx("Av1CondTotalVarNeighborhood-class") > ### * Av1CondTotalVarNeighborhood-class > > flush(stderr()); flush(stdout()) @@ -450,7 +385,8 @@ > > > -> cleanEx(); nameEx("Av1CondTotalVarNeighborhood") +> cleanEx() +> nameEx("Av1CondTotalVarNeighborhood") > ### * Av1CondTotalVarNeighborhood > > flush(stderr()); flush(stdout()) @@ -480,7 +416,8 @@ > > > -> cleanEx(); nameEx("Av2CondContIC-class") +> cleanEx() +> nameEx("Av2CondContIC-class") > ### * Av2CondContIC-class > > flush(stderr()); flush(stdout()) @@ -522,7 +459,8 @@ > > > -> cleanEx(); nameEx("Av2CondContIC") +> cleanEx() +> nameEx("Av2CondContIC") > ### * Av2CondContIC > > flush(stderr()); flush(stdout()) @@ -556,7 +494,8 @@ > > > -> cleanEx(); nameEx("Av2CondContNeighborhood-class") +> cleanEx() +> nameEx("Av2CondContNeighborhood-class") > ### * Av2CondContNeighborhood-class > > flush(stderr()); flush(stdout()) @@ -575,7 +514,8 @@ > > > -> cleanEx(); nameEx("Av2CondContNeighborhood") +> cleanEx() +> nameEx("Av2CondContNeighborhood") > ### * Av2CondContNeighborhood > > flush(stderr()); flush(stdout()) @@ -605,7 +545,8 @@ > > > -> cleanEx(); nameEx("CondContIC-class") +> cleanEx() +> nameEx("CondContIC-class") > ### * CondContIC-class > > flush(stderr()); flush(stdout()) @@ -657,7 +598,8 @@ > > > -> cleanEx(); nameEx("CondContIC") +> cleanEx() +> nameEx("CondContIC") > ### * CondContIC > > flush(stderr()); flush(stdout()) @@ -700,7 +642,8 @@ > > > -> cleanEx(); nameEx("CondContNeighborhood-class") +> cleanEx() +> nameEx("CondContNeighborhood-class") > ### * CondContNeighborhood-class > > flush(stderr()); flush(stdout()) @@ -719,7 +662,8 @@ > > > -> cleanEx(); nameEx("CondContNeighborhood") +> cleanEx() +> nameEx("CondContNeighborhood") > ### * CondContNeighborhood > > flush(stderr()); flush(stdout()) @@ -749,7 +693,8 @@ > > > -> cleanEx(); nameEx("CondIC-class") +> cleanEx() +> nameEx("CondIC-class") > ### * CondIC-class > > flush(stderr()); flush(stdout()) @@ -779,7 +724,8 @@ > > > -> cleanEx(); nameEx("CondIC") +> cleanEx() +> nameEx("CondIC") > ### * CondIC > > flush(stderr()); flush(stdout()) @@ -836,7 +782,8 @@ > > > -> cleanEx(); nameEx("CondTotalVarIC-class") +> cleanEx() +> nameEx("CondTotalVarIC-class") > ### * CondTotalVarIC-class > > flush(stderr()); flush(stdout()) @@ -888,7 +835,8 @@ > > > -> cleanEx(); nameEx("CondTotalVarIC") +> cleanEx() +> nameEx("CondTotalVarIC") > ### * CondTotalVarIC > > flush(stderr()); flush(stdout()) @@ -930,7 +878,8 @@ > > > -> cleanEx(); nameEx("CondTotalVarNeighborhood-class") +> cleanEx() +> nameEx("CondTotalVarNeighborhood-class") > ### * CondTotalVarNeighborhood-class > > flush(stderr()); flush(stdout()) @@ -949,7 +898,8 @@ > > > -> cleanEx(); nameEx("CondTotalVarNeighborhood") +> cleanEx() +> nameEx("CondTotalVarNeighborhood") > ### * CondTotalVarNeighborhood > > flush(stderr()); flush(stdout()) @@ -979,7 +929,8 @@ > > > -> cleanEx(); nameEx("FixRobRegTypeModel-class") +> cleanEx() +> nameEx("FixRobRegTypeModel-class") > ### * FixRobRegTypeModel-class > > flush(stderr()); flush(stdout()) @@ -1015,7 +966,8 @@ > > > -> cleanEx(); nameEx("FixRobRegTypeModel") +> cleanEx() +> nameEx("FixRobRegTypeModel") > ### * FixRobRegTypeModel > > flush(stderr()); flush(stdout()) @@ -1059,7 +1011,8 @@ > > > -> cleanEx(); nameEx("InfRobRegTypeModel-class") +> cleanEx() +> nameEx("InfRobRegTypeModel-class") > ### * InfRobRegTypeModel-class > > flush(stderr()); flush(stdout()) @@ -1095,7 +1048,8 @@ > > > -> cleanEx(); nameEx("InfRobRegTypeModel") +> cleanEx() +> nameEx("InfRobRegTypeModel") > ### * InfRobRegTypeModel > > flush(stderr()); flush(stdout()) @@ -1139,7 +1093,8 @@ > > > -> cleanEx(); nameEx("L2RegTypeFamily-class") +> cleanEx() +> nameEx("L2RegTypeFamily-class") > ### * L2RegTypeFamily-class > > flush(stderr()); flush(stdout()) @@ -1180,7 +1135,8 @@ > > > -> cleanEx(); nameEx("L2RegTypeFamily") +> cleanEx() +> nameEx("L2RegTypeFamily") > ### * L2RegTypeFamily > > flush(stderr()); flush(stdout()) @@ -1210,7 +1166,8 @@ > > > -> cleanEx(); nameEx("NormLinRegFamily") +> cleanEx() +> nameEx("NormLinRegFamily") > ### * NormLinRegFamily > > flush(stderr()); flush(stdout()) @@ -1248,10 +1205,10 @@ { as.vector(x[1:1L] * (x[1L + 1] - x[1:1L] %*% 0)) } - + > FisherInfo(LM1) -An object of class ?PosDefSymmMatrix? +An object of class "PosDefSymmMatrix" [,1] [1,] 1 > checkL2deriv(LM1) @@ -1264,7 +1221,8 @@ > > > -> cleanEx(); nameEx("NormLinRegInterceptFamily") +> cleanEx() +> nameEx("NormLinRegInterceptFamily") > ### * NormLinRegInterceptFamily > > flush(stderr()); flush(stdout()) @@ -1303,10 +1261,10 @@ { as.vector(x[1:1L] * (x[1L + 1] - x[1:1L] %*% 0 - 0)) } - + > FisherInfo(LM1) -An object of class ?PosDefSymmMatrix? +An object of class "PosDefSymmMatrix" [,1] [,2] [1,] 1 0 [2,] 0 1 @@ -1321,7 +1279,8 @@ > > > -> cleanEx(); nameEx("NormLinRegScaleFamily") +> cleanEx() +> nameEx("NormLinRegScaleFamily") > ### * NormLinRegScaleFamily > > flush(stderr()); flush(stdout()) @@ -1360,10 +1319,10 @@ { as.vector(x[1:1L] * (x[1L + 1] - x[1:1L] %*% 0)/1^2) } - + > FisherInfo(LM1) -An object of class ?PosDefSymmMatrix? +An object of class "PosDefSymmMatrix" [,1] [,2] [1,] 1 0 [2,] 0 2 @@ -1378,7 +1337,8 @@ > > > -> cleanEx(); nameEx("RegTypeFamily-class") +> cleanEx() +> nameEx("RegTypeFamily-class") > ### * RegTypeFamily-class > > flush(stderr()); flush(stdout()) @@ -1412,7 +1372,8 @@ > > > -> cleanEx(); nameEx("RegTypeFamily") +> cleanEx() +> nameEx("RegTypeFamily") > ### * RegTypeFamily > > flush(stderr()); flush(stdout()) @@ -1444,8 +1405,8 @@ > > ### *