[Distr-commits] r488 - branches/distr-2.2/pkg/distrEx/R

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

Author: stamats
Date: 2009-06-30 06:05:59 +0200 (Tue, 30 Jun 2009)
New Revision: 488

Modified:
   branches/distr-2.2/pkg/distrEx/R/GPareto.R
Log:
shape parameter may be negative in generalized Pareto ...

Modified: branches/distr-2.2/pkg/distrEx/R/GPareto.R
===================================================================
--- branches/distr-2.2/pkg/distrEx/R/GPareto.R	2009-06-29 17:57:26 UTC (rev 487)
+++ branches/distr-2.2/pkg/distrEx/R/GPareto.R	2009-06-30 04:05:59 UTC (rev 488)
@@ -18,7 +18,10 @@
 setReplaceMethod("location", "GParetoParameter", 
     function(object, value){ object at loc <- value; object })
 setReplaceMethod("scale", "GParetoParameter", 
-    function(object, value){ object at scale <- value; object})
+    function(object, value){
+        if(length(value) != 1 || value <= 0)
+            stop("'value' has to be a single positive real number!")
+        object at scale <- value; object})
 setReplaceMethod("shape", "GParetoParameter", 
     function(object, value){ object at shape <- value; object})
 
@@ -50,8 +53,8 @@
     stop("scale has to be positive")
   if(length(shape(object)) != 1)
     stop("shape has to be a numeric of length 1")    
-  if(shape(object) < 0)
-    stop("shape has to be non-negative")
+#  if(shape(object) < 0)
+#    stop("shape has to be non-negative")
   else return(TRUE)
 })
 
@@ -61,7 +64,7 @@
               if(!isTRUE(all.equal(loc,location)))
                  stop("Only one of arguments 'loc' and 'location' may be used.")
            if(!missing(location)) loc <- location
-           if(shape < .Machine$double.eps) return(loc+Exp(rate=1/scale))
+           if(abs(shape) < .Machine$double.eps) return(loc+Exp(rate=1/scale))
            new("GPareto", loc = loc, scale = scale, shape = shape) }
 
 ## extra methods for GPareto distribution