[Distr-commits] r680 - branches/distr-2.3/pkg/distrEx/R

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

Author: horbenko
Date: 2010-09-24 20:34:02 +0200 (Fri, 24 Sep 2010)
New Revision: 680

Modified:
   branches/distr-2.3/pkg/distrEx/R/AllInitialize.R
Log:
Bug in GEV implementation

Modified: branches/distr-2.3/pkg/distrEx/R/AllInitialize.R
===================================================================
--- branches/distr-2.3/pkg/distrEx/R/AllInitialize.R	2010-09-24 15:17:26 UTC (rev 679)
+++ branches/distr-2.3/pkg/distrEx/R/AllInitialize.R	2010-09-24 18:34:02 UTC (rev 680)
@@ -184,7 +184,9 @@
             body(.Object at p) <- substitute(
                            { if(lower.tail && log.p){
                              q0 <- (q-locSub)/scaleSub
-                             return(-(1+shapeSub*q0)^(-1/shapeSub))
+                             p0 <- -(1+shapeSub*q0)^(-1/shapeSub)
+                             p0[q0<(-1)] <- -Inf 
+                             return(p0)
                              }else{
                              p0 <- pgev(q, loc = locSub, scale = scaleSub, 
                                         shape = shapeSub)
@@ -197,8 +199,9 @@
             body(.Object at q) <- substitute({
                         if(lower.tail && log.p){
                              q0 <-((-p)^(-shapeSub)-1)/shapeSub*scaleSub+locSub  
-                             q0[.isEqual01(exp(p)) & p<0.5] <- NaN
-                             q0[1-p<0.5 & .isEqual01(exp(p))] <- NaN
+                             q0[p>0|p<-Inf] <- NaN
+                             q0[.isEqual01(p)& p<1] <- Inf
+                             q0[!is.finite(p)& p<0] <- locSub-scaleSub/shapeSub                             
                              return(q0)
                         }else{
                              
@@ -217,8 +220,8 @@
                                       
                            q1 <- qgev(p0, loc = locSub, scale = scaleSub, 
                                       shape = shapeSub) 
-                           q1[i0] <- if(lower.tail)  locSub else Inf
-                           q1[i1] <- if(!lower.tail) locSub else Inf
+                           q1[i0] <- if(lower.tail)  locSub-scaleSub/shapeSub else Inf
+                           q1[i1] <- if(!lower.tail) locSub-scaleSub/shapeSub else Inf
                            q1[in01] <- NaN
                         
                            return(q1)