[Robast-commits] r909 - pkg/RobExtremes/R

[noreply at r-forge.r-project.org]

Author: ruckdeschel
Date: 2016-09-04 22:34:41 +0200 (Sun, 04 Sep 2016)
New Revision: 909

Modified:
   pkg/RobExtremes/R/SnQn.R
   pkg/RobExtremes/R/getStartIC.R
Log:
adjusted interpolator-using functions (now order: fam -> risktype -> interpolators instead of risktype -> family )

Modified: pkg/RobExtremes/R/SnQn.R
===================================================================
--- pkg/RobExtremes/R/SnQn.R	2016-09-04 20:33:13 UTC (rev 908)
+++ pkg/RobExtremes/R/SnQn.R	2016-09-04 20:34:41 UTC (rev 909)
@@ -106,10 +106,12 @@
 
 .Sn.intp <- function(x, nam){
     if(abs(scale(x)-1)< 1e-12){
-       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("fun")]]
+       famg <- try(getFromNamespace(nam, ns = "RobAStRDA"), silent =TRUE)
+#       sng <- try(getFromNamespace(".Sn", ns = "RobAStRDA"), silent =TRUE)
+       if(is(famg,"try-error")) return(Sn(as(x,"AbscontDistribution")))
+#       if(!nam %in% names(sng)) return(Sn(as(x,"AbscontDistribution")))
+       if(!.versionSuff("fun")=="fun.N") return(Sn(as(x,"AbscontDistribution")))
+       snf <- famg[["Sn"]][[.versionSuff("fun")]]
        ret <- snf(shape(x))
        if(is.na(ret)) return(Sn(as(x,"AbscontDistribution")))
     }else ret <- scale(x)*Sn(x=x/scale(x))
@@ -117,13 +119,13 @@
 }
 
 setMethod("Sn", signature(x = "GPareto"),
-    function(x, ...).Sn.intp(x,"GeneralizedParetoFamily") )
+    function(x, ...).Sn.intp(x,".GPareto") )
 
 setMethod("Sn", signature(x = "GEV"),
-    function(x, ...).Sn.intp(x,"GEVFamily") )
+    function(x, ...).Sn.intp(x,".GEV") )
 
 setMethod("Sn", signature(x = "Gammad"),
-    function(x, ...).Sn.intp(x,"Gammafamily") )
+    function(x, ...).Sn.intp(x,".Gamma") )
 
 setMethod("Sn", signature(x = "Weibull"),
-    function(x, ...).Sn.intp(x,"WeibullFamily") )
+    function(x, ...).Sn.intp(x,".Weibull") )

Modified: pkg/RobExtremes/R/getStartIC.R
===================================================================
--- pkg/RobExtremes/R/getStartIC.R	2016-09-04 20:33:13 UTC (rev 908)
+++ pkg/RobExtremes/R/getStartIC.R	2016-09-04 20:34:41 UTC (rev 909)
@@ -6,7 +6,10 @@
     mc$neighbor <- ContNeighborhood(radius=0.5)
 
     gridn <- type(risk)
-    nam <- gsub(" ","",name(model))
+
+    nam <- paste(".",gsub("[F,f]amily","",gsub(" ","",name(model))),sep="")
+    if(nam==".GeneralizedPareto") nam <- ".GPareto"
+
     param1 <- param(model)
 
     scshnm <- scaleshapename(model)
@@ -15,12 +18,12 @@
     ### check whether mc[-1] is a good strategy to delete risk parameter...!!!
 
     nsng <- character(0)
-    sng <- try(getFromNamespace(gridn, ns = "RobAStRDA"), silent=TRUE)
-    if(!is(sng,"try-error")) nsng <- names(sng)
-    if(length(nsng)){
-       if(nam %in% nsng){
-          fctN <- .versionSuff("fun")
-          interpolfct <- sng[[nam]][[fctN]]
+    famg <- try(getFromNamespace(nam, ns = "RobAStRDA"), silent=TRUE)
+    #sng <- try(getFromNamespace(gridn, ns = "RobAStRDA"), silent=TRUE)
+    if(!is(famg,"try-error")) nsng <- names(famg)
+    if(length(nsng)&&.versionSuff("fun")=="fun.N"){
+       if(gridn %in% nsng){
+          interpolfct <- famg[[gridn]][["fun.N"]]
           .modifyIC0 <- function(L2Fam, IC){
                     para <- param(L2Fam)
                     if(!.is.na.Psi(para, interpolfct, shnam))
@@ -52,19 +55,22 @@
     mc$neighbor <- ContNeighborhood(radius=0.5)
 
     gridn <- type(risk)
-    nam <- gsub(" ","",name(model))
+
+    nam <- paste(".",gsub("[F,f]amily","",gsub(" ","",name(model))),sep="")
+    if(nam==".GEV") nam <- ".GEVU" 
+
     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)
-    if(length(nsng)){
-       if(nam %in% nsng){
-          fctN <- .versionSuff("fun")
-          interpolfct <- sng[[nam]][[fctN]]
+    famg <- try(getFromNamespace(nam, ns = "RobAStRDA"), silent=TRUE)
+    #sng <- try(getFromNamespace(gridn, ns = "RobAStRDA"), silent=TRUE)
+    if(!is(famg,"try-error")) nsng <- names(famg)
+    if(length(nsng)&&.versionSuff("fun")=="fun.N"){
+       if(gridn %in% nsng){
+          interpolfct <- famg[[gridn]][["fun.N"]]
           .modifyIC <- function(L2Fam, IC){
                     para <- param(L2Fam)
                     if(!.is.na.Psi(para, interpolfct, shnam))