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

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

Author: ruckdeschel
Date: 2013-07-26 13:35:35 +0200 (Fri, 26 Jul 2013)
New Revision: 683

Modified:
   branches/robast-0.9/pkg/RobExtremes/R/GEVFamily.R
   branches/robast-0.9/pkg/RobExtremes/R/GEVFamilyMuUnknown.R
   branches/robast-0.9/pkg/RobExtremes/R/GParetoFamily.R
Log:
[RobExtremes] added warning for ES, EL in case GPD, GEV, GEV-muUnknown for xi>=1

Modified: branches/robast-0.9/pkg/RobExtremes/R/GEVFamily.R
===================================================================
--- branches/robast-0.9/pkg/RobExtremes/R/GEVFamily.R	2013-07-25 16:05:33 UTC (rev 682)
+++ branches/robast-0.9/pkg/RobExtremes/R/GEVFamily.R	2013-07-26 11:35:35 UTC (rev 683)
@@ -173,7 +173,10 @@
                         D <- t(c(D1, D2))
                         rownames(D) <- "quantile"; colnames(D) <- NULL
                         D }, list(p0 = p))
-       btes <- substitute({ if(theta[2]>=1L) es <- NA else {
+       btes <- substitute({ if(theta[2]>=1L){
+                            warning("Expected value is infinite for shape > 1")
+                            es <- NA
+                           }else{
                             pg <- pgamma(-log(p0),1-theta[2], lower.tail = TRUE)
                             es <- theta[1] * (gamma(1-theta[2]) * pg/ (1-p0) - 1 )/
                                    theta[2]  + loc0 }
@@ -194,7 +197,10 @@
                             D }, list(loc0 = loc, p0 = p))
     }
     if(!is.null(N)){
-       btel <- substitute({ if(theta[2]>=1L) el <- NA else{
+       btel <- substitute({ if(theta[2]>=1L){
+                            warning("Expected value is infinite for shape > 1")
+                            el <- NA
+                           }else{
                             el <- N0*(loc0+theta[1]*(gamma(1-theta[2])-1)/theta[2])}
                             names(el) <- "expected loss"
                             el }, list(loc0 = loc,N0 = N))

Modified: branches/robast-0.9/pkg/RobExtremes/R/GEVFamilyMuUnknown.R
===================================================================
--- branches/robast-0.9/pkg/RobExtremes/R/GEVFamilyMuUnknown.R	2013-07-25 16:05:33 UTC (rev 682)
+++ branches/robast-0.9/pkg/RobExtremes/R/GEVFamilyMuUnknown.R	2013-07-26 11:35:35 UTC (rev 683)
@@ -59,7 +59,10 @@
                         D <- t(c(1, D1, D2))
                         rownames(D) <- "quantile"; colnames(D) <- NULL
                         D }, list(p0 = p))
-       btes <- substitute({ if(theta[3]>=1L) es <- NA else {
+       btes <- substitute({ if(theta[3]>=1L){
+                            warning("Expected value is infinite for shape > 1")
+                            es <- NA
+                           }else{
                             pg <- pgamma(-log(p0),1-theta[3], lower.tail = TRUE)
                             es <- theta[2] * (gamma(1-theta[3]) * pg/ (1-p0) - 1 )/
                                    theta[3]  + theta[1] }
@@ -81,7 +84,10 @@
                             D }, list(p0 = p))
     }
     if(!is.null(N)){
-       btel <- substitute({ if(theta[3]>=1L) el <- NA else{
+       btel <- substitute({ if(theta[3]>=1L){
+                            warning("Expected value is infinite for shape > 1")
+                            el <- NA
+                           }else{
                             el <- N0*(theta[1]+theta[2]*(gamma(1-theta[3])-1)/theta[3])}
                             names(el) <- "expected loss"
                             el }, list(N0 = N))

Modified: branches/robast-0.9/pkg/RobExtremes/R/GParetoFamily.R
===================================================================
--- branches/robast-0.9/pkg/RobExtremes/R/GParetoFamily.R	2013-07-25 16:05:33 UTC (rev 682)
+++ branches/robast-0.9/pkg/RobExtremes/R/GParetoFamily.R	2013-07-26 11:35:35 UTC (rev 683)
@@ -67,7 +67,10 @@
                         D <- t(c(D1, D2))
                         rownames(D) <- "quantile"; colnames(D) <- NULL
                         D }, list(p0 = p))
-       btes <- substitute({ if(theta[2]>=1L) es <- NA else {
+       btes <- substitute({ if(theta[2]>=1L){
+                            warning("Expected value is infinite for shape > 1")
+                            es <- NA
+                           }else{
                             q <- loc0 + theta[1]*((1-p0)^(-theta[2])-1)/theta[2]
                             es <- (q + theta[1] - theta[2]*loc0)/(1-theta[2])}
                             names(es) <- "expected shortfall"
@@ -86,7 +89,10 @@
                             D }, list(loc0 = loc, p0 = p))
     }
     if(!is.null(N)){
-       btel <- substitute({ if(theta[2]>=1L) el <- NA else {
+       btel <- substitute({ if(theta[2]>=1L){
+                            warning("Expected value is infinite for shape > 1")
+                            el <- NA
+                           }else{
                             el <- N0*(loc0 + theta[1]/(1-theta[2]))}
                             names(el) <- "expected loss"
                             el }, list(loc0 = loc,N0 = N))