[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
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Mar 12 19:54:53 CET 2013
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 and >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[x<xm] <- ym+dym*(x[x<xm]-xm)
- y1[x>xM] <- 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 <peter.ruckdeschel at itwm.fraunhofer.de>
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[x<xm] <- ym+dym*(x[x<xm]-xm)
+ y1[x>xM] <- 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
More information about the Robast-commits
mailing list