[Robast-commits] r578 - in branches/robast-0.9/pkg/RobExtremes: R inst/AddMaterial/interpolation
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Thu Jan 31 13:39:04 CET 2013
Author: ruckdeschel
Date: 2013-01-31 13:39:03 +0100 (Thu, 31 Jan 2013)
New Revision: 578
Modified:
branches/robast-0.9/pkg/RobExtremes/R/LDEstimator.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/R/sysdata.rda
branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/interpolationscripts.R
branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/interpolationsmanipulations.R
Log:
RobExtremes: finished interpolation grids (corrected a.o. Sn for GEV), and fixed yet some bugs -- .LDMatch produced names like scale.scale...
Modified: branches/robast-0.9/pkg/RobExtremes/R/LDEstimator.R
===================================================================
--- branches/robast-0.9/pkg/RobExtremes/R/LDEstimator.R 2013-01-29 08:28:41 UTC (rev 577)
+++ branches/robast-0.9/pkg/RobExtremes/R/LDEstimator.R 2013-01-31 12:39:03 UTC (rev 578)
@@ -29,7 +29,9 @@
disp.emp <- do.call(disp.est.0, args = .prepend(x.0,disp.est.ctrl.0, dots))
q.emp <- if(log.q.0) log(loc.emp)-log(disp.emp) else loc.emp/disp.emp
q.f <- function(xi){
- distr.new <- ParamFamily.0 at modifyParam(theta=c("scale"=1,"shape"=xi))
+ th0 <- c(1,xi)
+ names(th0) <- c("scale","shape")
+ distr.new <- ParamFamily.0 at modifyParam(theta=th0)
loc.th <- do.call(loc.fctal.0, args = .prepend(distr.new,loc.fctal.ctrl.0, dots))
sc.th <- do.call(disp.fctal.0, args = .prepend(distr.new,disp.fctal.ctrl.0, dots))
val <- if(log.q.0) log(loc.th)-log(sc.th) - q.emp else
@@ -38,9 +40,12 @@
return(val)
}
xi.0 <- uniroot(q.f,lower=q.lo.0,upper=q.up.0)$root
- distr.new.0 <- ParamFamily.0 at modifyParam(theta=c("scale"=1,"shape"=xi.0))
+ th0 <- c(1,xi.0)
+ names(th0) <- c("scale","shape")
+ distr.new.0 <- ParamFamily.0 at modifyParam(theta=th0)
m1xi <- do.call(loc.fctal.0, args = .prepend(distr.new.0,loc.fctal.ctrl.0, dots))
- val <- c("shape"=xi.0,"scale"=loc.emp/m1xi, "loc"=loc.emp,"disp"=disp.emp)
+ val <- c(loc.emp/m1xi, xi.0, loc.emp, disp.emp)
+ names(val) <- c("scale", "shape", "loc","disp")
return(val)
}
Modified: branches/robast-0.9/pkg/RobExtremes/R/interpolLM.R
===================================================================
--- branches/robast-0.9/pkg/RobExtremes/R/interpolLM.R 2013-01-29 08:28:41 UTC (rev 577)
+++ branches/robast-0.9/pkg/RobExtremes/R/interpolLM.R 2013-01-31 12:39:03 UTC (rev 578)
@@ -69,6 +69,8 @@
if(GridFileName!="") save(LMGrid, file=GridFileName)
res <- .MakeGridList(xiGrid, 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))
}
@@ -112,7 +114,7 @@
fctL[[i]] <- fctX
}
if(ncol(LMGrid)==1) fctL <- fctL[[1]]
-
+ rm(LMG,fct,fctX,iNA,ym,yM,dym,dyM)
return(list(grid = cbind(xi=xiGrid,LM=LMGrid),
fct = fctL))
}
Modified: branches/robast-0.9/pkg/RobExtremes/R/interpolSn.R
===================================================================
--- branches/robast-0.9/pkg/RobExtremes/R/interpolSn.R 2013-01-29 08:28:41 UTC (rev 577)
+++ branches/robast-0.9/pkg/RobExtremes/R/interpolSn.R 2013-01-31 12:39:03 UTC (rev 578)
@@ -66,7 +66,8 @@
itSn <<- itSn + 1
if(withPrint) cat("Evaluation Nr.", itSn," at xi = ",xi,"\n")
distr <- PFam at modifyParam(theta=c("scale"=1,"shape"=xi))
- return(Sn(x=distr, accuracy = accuracy, low=low, upp = upp))
+ return(Sn(x=as(distr,"AbscontDistribution"),
+ accuracy = accuracy, low=low, upp = upp))
}
SnGrid <- sapply(xiGrid,getSn)
if(GridFileName!="") save(SnGrid, file=GridFileName)
@@ -95,6 +96,12 @@
}
environment(fct) <- new.env()
assign("fct0",fct0, envir=environment(fct))
+ assign("yM",yM, envir=nE)
+ assign("ym",ym, envir=nE)
+ assign("dyM",dyM, envir=nE)
+ assign("dym",dym, envir=nE)
+ rm(itSn,getSn,iNA,fct0,ym,yM,dym,dyM)
+ if(withCall) rm(call)
return(list(grid = cbind(xi=xiGrid,Sn=SnGrid),
fct = fct, call = if(withCall) call else NULL))
}
Modified: branches/robast-0.9/pkg/RobExtremes/R/sysdata.rda
===================================================================
(Binary files differ)
Modified: branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/interpolationscripts.R
===================================================================
--- branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/interpolationscripts.R 2013-01-29 08:28:41 UTC (rev 577)
+++ branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/interpolationscripts.R 2013-01-31 12:39:03 UTC (rev 578)
@@ -66,7 +66,7 @@
sapply(c(.myFolder1,.myFolder2,.myFolder3), chkExist)
PF <- GEVFamily()
.saveInterpGrid(getShapeGrid(gridsize=500, cutoff.at.0=0.005),
- sysRdaFolder = .myFolder2, accuracy = 5000,upp=10,
+ sysRdaFolder = .myFolder1, accuracy = 5000,upp=10,
PFam = PF)
## to make this parallel, we write the results to different folders:
.svInt(.OMSE.xi, ".OMSE", PFam = PF, sysRdafolder = .myFolder1)
@@ -199,3 +199,21 @@
##---------------------------------------------------------------------
## R CMD install RobExtremes from source
###
+
+#### Fix Sn for GEV (which was wrong ...)
+require(RobExtremes)
+### -> change this according to where you checked out the svn repo:
+.basepath <- "C:/rtest/RobASt/branches/robast-0.9/pkg"
+## <-
+.saveInterpGrid <- RobExtremes:::.saveInterpGrid
+.svInt <- RobExtremes:::.svInt
+.OMSE.xi <- RobExtremes:::.OMSE.xi
+.MBRE.xi <- RobExtremes:::.MBRE.xi
+.RMXE.xi <- RobExtremes:::.RMXE.xi
+.modify.xi.PFam.call <- RobExtremes:::.modify.xi.PFam.call
+.myFolder <- file.path(.basepath,"RobExtremes/R")
+.myFolder1 <- file.path(.basepath,"RobExtremesBuffer/tmp1")
+PF <- GEVFamily()
+.saveInterpGrid(getShapeGrid(gridsize=500, cutoff.at.0=0.005),
+ sysRdaFolder = .myFolder1, accuracy = 5000,upp=10,
+ PFam = PF)
Modified: branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/interpolationsmanipulations.R
===================================================================
--- branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/interpolationsmanipulations.R 2013-01-29 08:28:41 UTC (rev 577)
+++ branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/interpolationsmanipulations.R 2013-01-31 12:39:03 UTC (rev 578)
@@ -106,6 +106,7 @@
.myFolder <- file.path(.basepath,"RobExtremesBuffer")
.myFolderA <- file.path(.basepath,"RobExtremesBuffer/all2")
.myFolderW <- file.path(.basepath,"RobExtremesBuffer/WTS2")
+fn1 <- file.path(.myFolder,"tmp1/sysdata.rda")
fn2 <- file.path(.myFolder,"tmp2/sysdata.rda")
fn3 <- file.path(.myFolder,"tmp3/sysdata.rda")
fn00=file.path(.myFolderW,"tmp0/sysdata.rda")
@@ -113,10 +114,11 @@
fn02=file.path(.myFolderW,"tmp2/sysdata.rda")
fn03=file.path(.myFolderW,"tmp3/sysdata.rda")
fnA <- file.path(.myFolderA,"sysdata.rda")
+fna <- file.path(.myFolderA,"sysdata-1.rda")
#fn2=file.path(.myFoldera,"sysdata-1.rda")
#RobExtremes:::.recomputeInterpolators(c(fn01,fn02, fn1), sysRdaFolder = .myFolderA, overwrite=TRUE, translate=FALSE)
-file.copy(fnA,fn1, overwrite=T)
-RobExtremes:::.recomputeInterpolators(c(fn3,fn1), sysRdaFolder = .myFolderA, overwrite=TRUE, translate=FALSE)
+file.copy(fnA,fna, overwrite=T)
+RobExtremes:::.recomputeInterpolators(c(fna,fn1), sysRdaFolder = .myFolderA, overwrite=TRUE, translate=FALSE)
nE= new.env()
load(fnA,envir=nE)
w = ls(all=T,envir=nE)
More information about the Robast-commits
mailing list