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

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Fri Sep 24 17:17:27 CEST 2010


Author: horbenko
Date: 2010-09-24 17:17:26 +0200 (Fri, 24 Sep 2010)
New Revision: 679

Modified:
   branches/distr-2.3/pkg/distrEx/R/AllInitialize.R
Log:
buglet in GEV distribution found

Modified: branches/distr-2.3/pkg/distrEx/R/AllInitialize.R
===================================================================
--- branches/distr-2.3/pkg/distrEx/R/AllInitialize.R	2010-09-24 09:22:13 UTC (rev 678)
+++ branches/distr-2.3/pkg/distrEx/R/AllInitialize.R	2010-09-24 15:17:26 UTC (rev 679)
@@ -182,9 +182,9 @@
                              list(locSub = loc, scaleSub = scale, shapeSub = shape)
                                          )
             body(.Object at p) <- substitute(
-                           { if(!lower.tail && log.p){
+                           { if(lower.tail && log.p){
                              q0 <- (q-locSub)/scaleSub
-                             return(-log(1+shapeSub*q0)/shapeSub)
+                             return(-(1+shapeSub*q0)^(-1/shapeSub))
                              }else{
                              p0 <- pgev(q, loc = locSub, scale = scaleSub, 
                                         shape = shapeSub)
@@ -195,11 +195,10 @@
                                    shapeSub = shape)
                                          )
             body(.Object at q) <- substitute({
-                        if(!lower.tail && log.p){
-                             p1 <- p
-                             p1[p<.Machine$double.eps] <- 0.5
-                             q0 <- (exp(-shapeSub*p1)-1)/shapeSub*scaleSub + locSub
-                             q0[p<.Machine$double.eps] <- NaN
+                        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
                              return(q0)
                         }else{
                              



More information about the Distr-commits mailing list