[Robast-commits] r910 - in branches/robast-1.1/pkg: RobAStRDA RobAStRDA/R RobExtremes/R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sun Sep 4 22:35:52 CEST 2016
Author: ruckdeschel
Date: 2016-09-04 22:35:51 +0200 (Sun, 04 Sep 2016)
New Revision: 910
Modified:
branches/robast-1.1/pkg/RobAStRDA/DESCRIPTION
branches/robast-1.1/pkg/RobAStRDA/NAMESPACE
branches/robast-1.1/pkg/RobAStRDA/R/sysdata.rda
branches/robast-1.1/pkg/RobExtremes/R/SnQn.R
branches/robast-1.1/pkg/RobExtremes/R/getStartIC.R
Log:
backport to branch 1.1
Modified: branches/robast-1.1/pkg/RobAStRDA/DESCRIPTION
===================================================================
--- branches/robast-1.1/pkg/RobAStRDA/DESCRIPTION 2016-09-04 20:34:41 UTC (rev 909)
+++ branches/robast-1.1/pkg/RobAStRDA/DESCRIPTION 2016-09-04 20:35:51 UTC (rev 910)
@@ -4,7 +4,7 @@
Title: Interpolation Grids for Packages of RobASt - Family of Pkgs
Description: Includes sysdata.rda file for packages of RobASt - family of packages;
is currently used by package RobExtremes only.
-Depends: R (>= 2.14.0)
+Depends: R (>= 3.3.0)
Authors at R: c(person("Matthias", "Kohl", role=c("aut", "cph")),
person("Bernhard", "Spangl", role="ctb", comment="contributed smoothed grid values of the Lagrange multipliers"),
person("Sascha", "Desmettre", role="ctb", comment="contributed smoothed grid values of the Lagrange multipliers"),
Modified: branches/robast-1.1/pkg/RobAStRDA/NAMESPACE
===================================================================
--- branches/robast-1.1/pkg/RobAStRDA/NAMESPACE 2016-09-04 20:34:41 UTC (rev 909)
+++ branches/robast-1.1/pkg/RobAStRDA/NAMESPACE 2016-09-04 20:35:51 UTC (rev 910)
@@ -1,2 +1,3 @@
-
-
+importFrom("stats", "splinefun", "approxfun")
+importFrom("stats", "predict", "smooth.spline")
+importFrom("utils", "head", "read.csv", "read.table")
Modified: branches/robast-1.1/pkg/RobAStRDA/R/sysdata.rda
===================================================================
(Binary files differ)
Modified: branches/robast-1.1/pkg/RobExtremes/R/SnQn.R
===================================================================
--- branches/robast-1.1/pkg/RobExtremes/R/SnQn.R 2016-09-04 20:34:41 UTC (rev 909)
+++ branches/robast-1.1/pkg/RobExtremes/R/SnQn.R 2016-09-04 20:35:51 UTC (rev 910)
@@ -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: branches/robast-1.1/pkg/RobExtremes/R/getStartIC.R
===================================================================
--- branches/robast-1.1/pkg/RobExtremes/R/getStartIC.R 2016-09-04 20:34:41 UTC (rev 909)
+++ branches/robast-1.1/pkg/RobExtremes/R/getStartIC.R 2016-09-04 20:35:51 UTC (rev 910)
@@ -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))
More information about the Robast-commits
mailing list