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

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

Author: ruckdeschel
Date: 2013-07-01 15:53:49 +0200 (Mon, 01 Jul 2013)
New Revision: 670

Modified:
   branches/robast-0.9/pkg/RobExtremes/R/GEVFamily.R
   branches/robast-0.9/pkg/RobExtremes/R/WeibullFamily.R
Log:
[RobExtremes] added Gerald's corrections as to Weibull and as to ddigamma

Modified: branches/robast-0.9/pkg/RobExtremes/R/GEVFamily.R
===================================================================
--- branches/robast-0.9/pkg/RobExtremes/R/GEVFamily.R	2013-06-17 10:32:24 UTC (rev 669)
+++ branches/robast-0.9/pkg/RobExtremes/R/GEVFamily.R	2013-07-01 13:53:49 UTC (rev 670)
@@ -403,10 +403,10 @@
     return(L2Fam)
 }
 
-#ddigamma(t,s) is d/ds \int_t^\infty exp(-x) x^(-s) dx
+#ddigamma(t,s) is d/ds \int_0^t exp(-x) x^(s-1) dx
 
 ddigamma <- function(t,s){
-              int <- function(x) exp(-x)*(-log(x))*x^(-s)
+              int <- function(x) exp(-x)*(log(x))*x^(s-1)
               integrate(int, lower=0, upper=t)$value
               }
               
\ No newline at end of file

Modified: branches/robast-0.9/pkg/RobExtremes/R/WeibullFamily.R
===================================================================
--- branches/robast-0.9/pkg/RobExtremes/R/WeibullFamily.R	2013-06-17 10:32:24 UTC (rev 669)
+++ branches/robast-0.9/pkg/RobExtremes/R/WeibullFamily.R	2013-07-01 13:53:49 UTC (rev 670)
@@ -66,18 +66,18 @@
                         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)) es <- NA else {
                             s1 <- 1+1/theta[2]
-                            pg <- pgamma(-log(p0),s1, lower.tail = FALSE)
+                            pg <- pgamma(-log(1-p0),s1, lower.tail = FALSE)
                             g0 <- gamma(s1)
                             es <- theta[1] * g0 * pg /(1-p0)}
                             names(es) <- "expected shortfall"
                             es }, list(p0 = p))
-       bDes <- substitute({ if(theta[2]>=1L){ D1 <- D2 <- NA} else {
+       bDes <- substitute({ if(theta[2]<= (-1L)){ D1 <- D2 <- NA} else {
                             s1 <- 1+1/theta[2]
-                            pg <- pgamma(-log(p0), s1, lower.tail = FALSE)
+                            pg <- pgamma(-log(1-p0), s1, lower.tail = FALSE)
                             g0 <- gamma(s1)
-                            dd <- digamma(s1)*g0 - ddigamma(-log(p0),s1)
+                            dd <- digamma(s1)*g0 - ddigamma(-log(1-p0),s1)
                             D1 <-  g0 * pg / (1-p0)
                             D2 <- theta[1] * dd /(1-p0)}
                             D <- t(c(D1, D2))