[Robast-commits] r501 - in branches/robast-0.9/pkg/RobExtremes: . R man

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Tue Jul 3 11:36:51 CEST 2012


Author: stamats
Date: 2012-07-03 11:36:51 +0200 (Tue, 03 Jul 2012)
New Revision: 501

Modified:
   branches/robast-0.9/pkg/RobExtremes/NAMESPACE
   branches/robast-0.9/pkg/RobExtremes/R/AllInitialize.R
   branches/robast-0.9/pkg/RobExtremes/R/Pareto.R
   branches/robast-0.9/pkg/RobExtremes/man/GEV-class.Rd
   branches/robast-0.9/pkg/RobExtremes/man/GEV.Rd
   branches/robast-0.9/pkg/RobExtremes/man/GEVParameter-class.Rd
   branches/robast-0.9/pkg/RobExtremes/man/GPareto-class.Rd
   branches/robast-0.9/pkg/RobExtremes/man/GPareto.Rd
   branches/robast-0.9/pkg/RobExtremes/man/GParetoParameter-class.Rd
   branches/robast-0.9/pkg/RobExtremes/man/Pareto.Rd
   branches/robast-0.9/pkg/RobExtremes/man/ParetoParameter-class.Rd
Log:
added some example code, minor modification of replacement methods for Pareto distribution

Modified: branches/robast-0.9/pkg/RobExtremes/NAMESPACE
===================================================================
--- branches/robast-0.9/pkg/RobExtremes/NAMESPACE	2012-07-03 08:34:46 UTC (rev 500)
+++ branches/robast-0.9/pkg/RobExtremes/NAMESPACE	2012-07-03 09:36:51 UTC (rev 501)
@@ -21,8 +21,7 @@
               "shape", "shape<-",
               "+", "*",
               "Min", "Min<-",
-              "E", "var", "IQR", "skewness", "kurtosis", 
-              "sd", "median", "mad", "dispersion")
+              "E", "var", "IQR", "skewness", "kurtosis", "median", "dispersion")
 exportMethods("modifyModel")
 
 export("EULERMASCHERONICONSTANT","APERYCONSTANT")

Modified: branches/robast-0.9/pkg/RobExtremes/R/AllInitialize.R
===================================================================
--- branches/robast-0.9/pkg/RobExtremes/R/AllInitialize.R	2012-07-03 08:34:46 UTC (rev 500)
+++ branches/robast-0.9/pkg/RobExtremes/R/AllInitialize.R	2012-07-03 09:36:51 UTC (rev 501)
@@ -147,9 +147,14 @@
                            if(!lower.tail) p0 <- 1-p0
                                       
                            q1 <- qgpd(p0, loc = locSub, scale = scaleSub, 
-                                      shape = shapeSub) 
-                           q1[i0] <- if(lower.tail)  locSub else Inf
-                           q1[i1] <- if(!lower.tail) locSub else Inf
+                                      shape = shapeSub)
+                           if(shapeSub >= 0){
+                              q1[i0] <- if(lower.tail)  locSub else Inf
+                              q1[i1] <- if(!lower.tail) locSub else Inf
+                           }else{
+                              q1[i0] <- if(lower.tail)  locSub else locSub-scaleSub/shapeSub
+                              q1[i1] <- if(!lower.tail) locSub else locSub-scaleSub/shapeSub
+                           }
                            q1[in01] <- NaN
                         
                            return(q1) 
@@ -209,6 +214,8 @@
                         }else{
                            ##higher tolerance for .isEqual01
                            tol=1e-20
+                           otol <- getdistrOption("TruncQuantile")
+                           on.exit(distroptions(TruncQuantile=otol))
                            distroptions(TruncQuantile=tol)
                            p1 <- if(log.p) exp(p) else p
                            in01 <- (p1>1 | p1<0)
@@ -220,8 +227,18 @@
                            p0[ii01] <- if(log.p) log(0.5) else 0.5
                            #if(!lower.tail) p0 <- 1-p0
                            q1 <- qgev(p0, loc = locSub, scale = scaleSub, shape = shapeSub, lower.tail=lower.tail) 
-                           q1[i0] <- if(lower.tail)  locSub-scaleSub/shapeSub else Inf
-                           q1[i1] <- if(!lower.tail) locSub-scaleSub/shapeSub else Inf
+                           if(shapeSub > 0){
+                              q1[i0] <- if(lower.tail)  locSub-scaleSub/shapeSub else Inf
+                              q1[i1] <- if(!lower.tail) locSub-scaleSub/shapeSub else Inf
+                           }else{
+                              if(shapeSub == 0){
+                                q1[i0] <- if(lower.tail)  -Inf else Inf
+                                q1[i1] <- if(!lower.tail) -Inf else Inf
+                              }else{
+                                q1[i0] <- if(lower.tail)  -Inf else locSub-scaleSub/shapeSub
+                                q1[i1] <- if(!lower.tail) -Inf else locSub-scaleSub/shapeSub
+                              }
+                           }
                            q1[in01] <- NaN
                            return(q1) 
                          }   

Modified: branches/robast-0.9/pkg/RobExtremes/R/Pareto.R
===================================================================
--- branches/robast-0.9/pkg/RobExtremes/R/Pareto.R	2012-07-03 08:34:46 UTC (rev 500)
+++ branches/robast-0.9/pkg/RobExtremes/R/Pareto.R	2012-07-03 09:36:51 UTC (rev 501)
@@ -11,9 +11,15 @@
 
 ## Replace Methods
 setReplaceMethod("shape", "ParetoParameter", 
-                  function(object, value){ object at shape <- value; object})
+                  function(object, value){ 
+                    if(length(value) != 1 || value <= 0)
+                        stop("'value' has to be a single positive number")
+                    object at shape <- value; object})
 setReplaceMethod("Min", "ParetoParameter", 
-                  function(object, value){ object at Min <- value; object})
+                  function(object, value){ 
+                    if(length(value) != 1 || value <= 0)
+                        stop("'value' has to be a single positive number")
+                    object at Min <- value; object})
 
 setValidity("ParetoParameter", function(object){
   if(length(shape(object)) != 1)
@@ -42,7 +48,7 @@
 setMethod("Min", "Pareto", function(object) Min(param(object)))
 
 ## wrapped replace methods
-setMethod("shape<-", "Pareto", function(object, value) 
+setMethod("shape<-", "Pareto", function(object, value)
            new("Pareto", shape = value, Min = Min(object)))
 setMethod("Min<-", "Pareto", function(object, value) 
            new("Pareto", shape = shape(object), Min = value))

Modified: branches/robast-0.9/pkg/RobExtremes/man/GEV-class.Rd
===================================================================
--- branches/robast-0.9/pkg/RobExtremes/man/GEV-class.Rd	2012-07-03 08:34:46 UTC (rev 500)
+++ branches/robast-0.9/pkg/RobExtremes/man/GEV-class.Rd	2012-07-03 09:36:51 UTC (rev 501)
@@ -111,6 +111,7 @@
 loc(P1)
 scale(P1) <- 4
 loc(P1) <- 2
+shape(P1) <- -1 # may be negative!
 plot(P1)
 }
 \concept{GEV}

Modified: branches/robast-0.9/pkg/RobExtremes/man/GEV.Rd
===================================================================
--- branches/robast-0.9/pkg/RobExtremes/man/GEV.Rd	2012-07-03 08:34:46 UTC (rev 500)
+++ branches/robast-0.9/pkg/RobExtremes/man/GEV.Rd	2012-07-03 09:36:51 UTC (rev 501)
@@ -21,14 +21,20 @@
 %\references{}
 \author{Nataliya Horbenko \email{Nataliya.Horbenko at itwm.fraunhofer.de}}
 \note{The class \code{"GEV"} is based on the code provided 
-  by the package \pkg{evd} by  Alec Stephenson.}
+  by the package \pkg{evd} by Alec Stephenson.}
 \seealso{\code{\link{GEV-class}}, \code{\link[evd:gpd]{dgpd}}}
 \examples{
 (P1 <- GEV(loc = 0, scale = 1, shape = 0))
 plot(P1)
 
 E(GEV()) 
+E(P1)
 E(P1, function(x){x^2})
+var(P1)
+sd(P1)
+median(P1)
+IQR(P1)
+mad(P1)
 
 }
 

Modified: branches/robast-0.9/pkg/RobExtremes/man/GEVParameter-class.Rd
===================================================================
--- branches/robast-0.9/pkg/RobExtremes/man/GEVParameter-class.Rd	2012-07-03 08:34:46 UTC (rev 500)
+++ branches/robast-0.9/pkg/RobExtremes/man/GEVParameter-class.Rd	2012-07-03 09:36:51 UTC (rev 501)
@@ -57,7 +57,17 @@
 %\note{}
 \seealso{\code{\link{GEV-class}}, \code{\link[distr]{Parameter-class}}}
 \examples{
-new("GEVParameter")
+P <- new("GEVParameter")
+loc(P)
+## same as
+location(P)
+scale(P)
+shape(P)
+
+scale(P) <- 2
+location(P) <- 4
+shape(P) <- -1 # may be negative!
+P
 }
 \concept{GEV distribution}
 \keyword{distribution}

Modified: branches/robast-0.9/pkg/RobExtremes/man/GPareto-class.Rd
===================================================================
--- branches/robast-0.9/pkg/RobExtremes/man/GPareto-class.Rd	2012-07-03 08:34:46 UTC (rev 500)
+++ branches/robast-0.9/pkg/RobExtremes/man/GPareto-class.Rd	2012-07-03 09:36:51 UTC (rev 501)
@@ -107,7 +107,8 @@
 shape(P1)
 loc(P1)
 scale(P1) <- 4
-loc(P1) <- 2
+location(P1) <- 2 ## same as loc(P1) <- 2
+shape(P1) <- -2 # may be negative
 plot(P1)
 }
 \concept{GPareto}

Modified: branches/robast-0.9/pkg/RobExtremes/man/GPareto.Rd
===================================================================
--- branches/robast-0.9/pkg/RobExtremes/man/GPareto.Rd	2012-07-03 08:34:46 UTC (rev 500)
+++ branches/robast-0.9/pkg/RobExtremes/man/GPareto.Rd	2012-07-03 09:36:51 UTC (rev 501)
@@ -25,11 +25,17 @@
   by the package \pkg{evd} by  Alec Stephenson.}
 \seealso{\code{\link{GPareto-class}}, \code{\link[evd:gpd]{dgpd}}}
 \examples{
-(P1 <- GPareto(loc = 0, scale = 1, shape = 0))
+(P1 <- GPareto(loc = 1, scale = 1, shape = -0.5))
 plot(P1)
 
 E(GPareto()) 
+E(P1)
 E(P1, function(x){x^2})
+var(P1)
+sd(P1)
+median(P1)
+IQR(P1)
+mad(P1)
 
 }
 

Modified: branches/robast-0.9/pkg/RobExtremes/man/GParetoParameter-class.Rd
===================================================================
--- branches/robast-0.9/pkg/RobExtremes/man/GParetoParameter-class.Rd	2012-07-03 08:34:46 UTC (rev 500)
+++ branches/robast-0.9/pkg/RobExtremes/man/GParetoParameter-class.Rd	2012-07-03 09:36:51 UTC (rev 501)
@@ -57,7 +57,17 @@
 %\note{}
 \seealso{\code{\link{GPareto-class}}, \code{\link[distr]{Parameter-class}}}
 \examples{
-new("GParetoParameter")
+P <- new("GParetoParameter")
+loc(P)
+## same as
+location(P)
+scale(P)
+shape(P)
+
+scale(P) <- 2
+loc(P) <- -5
+shape(P) <- -1 # may be negative
+P
 }
 \concept{GPareto distribution}
 \keyword{distribution}

Modified: branches/robast-0.9/pkg/RobExtremes/man/Pareto.Rd
===================================================================
--- branches/robast-0.9/pkg/RobExtremes/man/Pareto.Rd	2012-07-03 08:34:46 UTC (rev 500)
+++ branches/robast-0.9/pkg/RobExtremes/man/Pareto.Rd	2012-07-03 09:36:51 UTC (rev 501)
@@ -24,11 +24,14 @@
 plot(P1)
 
 E(Pareto()) 
+E(P1)
 E(P1, function(x){x^2})
+var(P1)
+sd(P1)
+median(P1)
+IQR(P1)
+mad(P1)
 
-## The function is currently defined as
-function(shape = 1, Min = 1) 
-               new("Pareto", shape = shape, Min = Min)
 }
 
 \concept{Pareto}

Modified: branches/robast-0.9/pkg/RobExtremes/man/ParetoParameter-class.Rd
===================================================================
--- branches/robast-0.9/pkg/RobExtremes/man/ParetoParameter-class.Rd	2012-07-03 08:34:46 UTC (rev 500)
+++ branches/robast-0.9/pkg/RobExtremes/man/ParetoParameter-class.Rd	2012-07-03 09:36:51 UTC (rev 501)
@@ -44,7 +44,14 @@
 %\note{}
 \seealso{\code{\link{Pareto-class}}, \code{\link[distr]{Parameter-class}}}
 \examples{
-new("ParetoParameter")
+(P1 <- new("ParetoParameter"))
+Min(P1)
+shape(P1)
+
+Min(P1) <- 3
+shape(P1) <- 4
+P1
+
 }
 \concept{Pareto distribution}
 \keyword{distribution}



More information about the Robast-commits mailing list