[Robast-commits] r558 - branches/robast-0.9/pkg/RobExtremes/R

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Fri Jan 25 05:20:20 CET 2013


Author: ruckdeschel
Date: 2013-01-25 05:20:20 +0100 (Fri, 25 Jan 2013)
New Revision: 558

Modified:
   branches/robast-0.9/pkg/RobExtremes/R/SnQn.R
   branches/robast-0.9/pkg/RobExtremes/R/recomputeInterpolators.R
Log:
RobExtremes: argh: bug in new S4 methods for Sn / fixed

Modified: branches/robast-0.9/pkg/RobExtremes/R/SnQn.R
===================================================================
--- branches/robast-0.9/pkg/RobExtremes/R/SnQn.R	2013-01-25 04:05:08 UTC (rev 557)
+++ branches/robast-0.9/pkg/RobExtremes/R/SnQn.R	2013-01-25 04:20:20 UTC (rev 558)
@@ -111,7 +111,9 @@
               sng <- try(getFromNamespace(.versionSuff(".SnGrids"),
                           ns = "RobExtremes"), silent =TRUE)
               if(is(sng,"try-error")) return(Sn(as(x,"AbscontDistribution")))
-              snf <- sng[["Generalized Pareto Family"]][["fct"]]
+              nam <- "Generalized Pareto Family"
+              if(!nam %in% names(sng)) return(Sn(as(x,"AbscontDistribution")))
+              snf <- sng[[nam]][["fct"]]
               ret <- snf(shape(x))
            }else ret <- scale(x)*Sn(x=x/scale(x))
            return(ret)
@@ -124,7 +126,9 @@
               sng <- try(getFromNamespace(.versionSuff(".SnGrids"),
                           ns = "RobExtremes"), silent =TRUE)
               if(is(sng,"try-error")) return(Sn(as(x,"AbscontDistribution")))
-              snf <- sng[["Generalized Extreme Value Family with positive shape parameter: Frechet Family"]][["fct"]]
+              nam <- "Generalized Extreme Value Family with positive shape parameter: Frechet Family"
+              if(!nam %in% names(sng)) return(Sn(as(x,"AbscontDistribution")))
+              snf <- sng[[nam]][["fct"]]
               ret <- snf(shape(x))
            }else ret <- scale(x)*Sn(x=x/scale(x))
            return(ret)
@@ -137,7 +141,9 @@
               sng <- try(getFromNamespace(.versionSuff(".SnGrids"),
                           ns = "RobExtremes"), silent =TRUE)
               if(is(sng,"try-error")) return(Sn(as(x,"AbscontDistribution")))
-              snf <- sng[["Gamma family"]][["fct"]]
+              nam <- "Gamma family"
+              if(!nam %in% names(sng)) return(Sn(as(x,"AbscontDistribution")))
+              snf <- sng[[nam]][["fct"]]
               ret <- snf(shape(x))
            }else ret <- scale(x)*Sn(x=x/scale(x))
            return(ret)
@@ -150,7 +156,9 @@
               sng <- try(getFromNamespace(.versionSuff(".SnGrids"),
                           ns = "RobExtremes"), silent =TRUE)
               if(is(sng,"try-error")) return(Sn(as(x,"AbscontDistribution")))
-              snf <- sng[["Weibull Family"]][["fct"]]
+              nam <- "Weibull Family"
+              if(!nam %in% names(sng)) return(Sn(as(x,"AbscontDistribution")))
+              snf <- sng[[nam]][["fct"]]
               ret <- snf(shape(x))
            }else ret <- scale(x)*Sn(x=x/scale(x))
            return(ret)

Modified: branches/robast-0.9/pkg/RobExtremes/R/recomputeInterpolators.R
===================================================================
--- branches/robast-0.9/pkg/RobExtremes/R/recomputeInterpolators.R	2013-01-25 04:05:08 UTC (rev 557)
+++ branches/robast-0.9/pkg/RobExtremes/R/recomputeInterpolators.R	2013-01-25 04:20:20 UTC (rev 558)
@@ -192,13 +192,13 @@
 
 .copyGrid <- function(grid,  gridnam, namOld, namNew, rdafileOld, rdafileNew){
   nE <- new.env()
-  load(fileOld,envir=nE)
+  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= fileNew, envir=nE)
+  save(list=what, file= rdafileNew, envir=nE)
 }
 
 if(FALSE){



More information about the Robast-commits mailing list