[Distr-commits] r410 - branches/distr-2.1/pkg/distr/R branches/distr-2.1/pkg/distr/chm branches/distr-2.1/pkg/distrEx/R branches/distr-2.1/www www

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Tue Mar 17 16:04:16 CET 2009


Author: ruckdeschel
Date: 2009-03-17 16:04:15 +0100 (Tue, 17 Mar 2009)
New Revision: 410

Modified:
   branches/distr-2.1/pkg/distr/R/AllInitialize.R
   branches/distr-2.1/pkg/distr/chm/DiscreteDistribution.html
   branches/distr-2.1/pkg/distr/chm/Distr.chm
   branches/distr-2.1/pkg/distrEx/R/Functionals.R
   branches/distr-2.1/pkg/distrEx/R/Kurtosis.R
   branches/distr-2.1/pkg/distrEx/R/Skewness.R
   branches/distr-2.1/www/HOWTO-collaborate.txt
   www/HOWTO-collaborate.txt
Log:
distr: fixed a buglet in initialize for Cauchy Distribution
www: updated HOWTO-collaborate.txt, 
distrEx checked and fixed functionals (stirred up by mail by Jay Kerns, gkerns at ysu.edu)

Modified: branches/distr-2.1/pkg/distr/R/AllInitialize.R
===================================================================
--- branches/distr-2.1/pkg/distr/R/AllInitialize.R	2009-03-06 11:36:44 UTC (rev 409)
+++ branches/distr-2.1/pkg/distr/R/AllInitialize.R	2009-03-17 15:04:15 UTC (rev 410)
@@ -655,7 +655,8 @@
 setMethod("initialize", "Cauchy",
           function(.Object, location = 0, scale = 1) {
             .Object at img <- new("Reals")
-            .Object at param <- new("CauchyParameter", location = location)
+            .Object at param <- new("CauchyParameter", location = location, 
+                                  scale = scale)
             .Object at r <- function(n){}
             .Object at d <- function(x, log = FALSE){}
             .Object at p <- function(q, lower.tail = TRUE, log.p = FALSE){} 

Modified: branches/distr-2.1/pkg/distr/chm/DiscreteDistribution.html
===================================================================
--- branches/distr-2.1/pkg/distr/chm/DiscreteDistribution.html	2009-03-06 11:36:44 UTC (rev 409)
+++ branches/distr-2.1/pkg/distr/chm/DiscreteDistribution.html	2009-03-17 15:04:15 UTC (rev 410)
@@ -27,7 +27,7 @@
                        .lowerExact = TRUE, .logExact = FALSE,
              .DistrCollapse = getdistrOption("DistrCollapse"),
              .DistrCollapse.Unique.Warn = 
-                  getdistrOption(".DistrCollapse.Unique.Warn"),
+                  getdistrOption("DistrCollapse.Unique.Warn"),
              .DistrResolution = getdistrOption("DistrResolution"))
   DiscreteDistribution(supp)
 </pre>

Modified: branches/distr-2.1/pkg/distr/chm/Distr.chm
===================================================================
(Binary files differ)

Modified: branches/distr-2.1/pkg/distrEx/R/Functionals.R
===================================================================
--- branches/distr-2.1/pkg/distrEx/R/Functionals.R	2009-03-06 11:36:44 UTC (rev 409)
+++ branches/distr-2.1/pkg/distrEx/R/Functionals.R	2009-03-17 15:04:15 UTC (rev 410)
@@ -208,7 +208,7 @@
     if((hasArg(fun))||(hasArg(cond))) 
          return(var(as(x,"AbscontDistribution"),...))
     else
-        return(2/rate(x)^2)
+        return(2)
     })
 
 setMethod("var", signature(x = "Exp"),
@@ -306,9 +306,9 @@
         return(var(as(x,"AbscontDistribution"),...))
     else
         {n <- df(x); d<- ncp(x)
-        ## correction thanks to G.Jay Kerns
-        return(ifelse( n>2, n/(n-2)+
-               d^2*(n/(n-2)-n/2*exp(lgamma((n-1)/2)-lgamma(n/2))^2), NA))
+        ## correction thanks to G.Jay Kerns ### corrected again P.R.
+        return(ifelse( n>2, n/(n-2)*(1+d^2)
+                           -d^2*n/2*exp(2*(lgamma((n-1)/2)-lgamma(n/2))), NA))
        }
     })
 
@@ -386,13 +386,13 @@
     function(x) 2*qnorm(3/4)*sd(x))
 
 setMethod("IQR", signature(x = "Cauchy"),
-    function(x) 2*scale(x))
+    function(x) 2*scale(x)*qcauchy(3/4))
 
 setMethod("IQR", signature(x = "Dirac"),
     function(x) 0)
 
 setMethod("IQR", signature(x = "DExp"),
-    function(x) 2*log(2)/rate(DExp))
+    function(x) 2*log(2))
 
 setMethod("IQR", signature(x = "Exp"),
     function(x) (log(4)-log(4/3))/rate(x))
@@ -418,13 +418,13 @@
     function(x) qnorm(3/4)*sd(x))
 
 setMethod("mad", signature(x = "Cauchy"),
-    function(x)  scale(x))
+    function(x)  scale(x)*qcauchy(3/4))
 
 setMethod("mad", signature(x = "Dirac"),
     function(x) 0)
 
 setMethod("mad", signature(x = "DExp"),
-    function(x) log(2)/rate(DExp))
+    function(x) log(2))
 
 setMethod("mad", signature(x = "Exp"),
     function(x) log((1+sqrt(5))/2)/rate(x))

Modified: branches/distr-2.1/pkg/distrEx/R/Kurtosis.R
===================================================================
--- branches/distr-2.1/pkg/distrEx/R/Kurtosis.R	2009-03-06 11:36:44 UTC (rev 409)
+++ branches/distr-2.1/pkg/distrEx/R/Kurtosis.R	2009-03-17 15:04:15 UTC (rev 410)
@@ -129,15 +129,30 @@
           m <- df1(x)
           n <- df2(x)
           d <- ncp(x)
-          L <- d/m
-          m2 <- 2*n^2*(m+n-2)/m/(n-2)^2/(n-4)*(1+2*L+m*L^2/(m+n-2))
-          a <-  12*n^4*(m+n-2)/m^3/(n-2)^4/(n-4)/(n-6)/(n-8)
-          b <-  (1+4*L)*(2*(3*m+n-2)*(2*m+n-2)+(m+n-2)*(n-2)*(m+2))
-          c <-  2*m*(3*m+2*n-4)*(n+10)*L^2
-          d <-  4*m^2*(n+10)*L^3
-          e <-  m^3*(n+10)*L^4/(m+n-2)
-          m4 <- a*(b+c+d+e)
-          return(m4/m2^2-3)
+          m2 <- var(x)
+          m1 <- E(x)
+          m3 <- (n/m)^3/(n-2)/(n-4)/(n-6)*
+                  (m^3+6*m^2+8*m+3*d*(m^2+6*m+8)+3*d^2*(m+4)+d^3)
+          mm1 <- m-1
+          mm2 <- mm1 * (m+1)
+          mm3 <- mm2 * (m+3)
+          mm4 <- mm3 * (m+5)
+          mmd1 <- d+1
+          mmd2 <- 3 + 6*d + d^2
+          mmd3 <- 15 + 45*d + 15*d^2 + d^3
+          mmd4 <- 105 + 420*d + 210*d^2 + 28*d^3 + d^4
+          mm <- mm4 + 4*mm3*mmd1 + 6*mm2*mmd2 + 4*mm1*mmd3+ mmd4          
+          m4 <- (n/m)^4/(n-2)/(n-4)/(n-6)/(n-8)*mm
+          return((m4-4*m3*m1+6*m2*m1^2+3*m1^4)/m2^2-3)
+#          L <- d/m
+#          m2 <- 2*n^2*(m+n-2)/m/(n-2)^2/(n-4)*(1+2*L+m*L^2/(m+n-2))
+#          a <-  12*n^4*(m+n-2)/m^3/(n-2)^4/(n-4)/(n-6)/(n-8)
+#          b <-  (1+4*L)*(2*(3*m+n-2)*(2*m+n-2)+(m+n-2)*(n-2)*(m+2))
+#          c <-  2*m*(3*m+2*n-4)*(n+10)*L^2
+#          d <-  4*m^2*(n+10)*L^3
+#          e <-  m^3*(n+10)*L^4/(m+n-2)
+#          m4 <- a*(b+c+d+e)
+#          return(m4/m2^2-3)
         } else {
           return(NA)
         }
@@ -174,7 +189,7 @@
         a <- (m+n)^2*(m+n-1)/(k*m*n*(m+n-k)*(m+n-2)*(m+n-3));
         return(
                 a*((m+n)*(m+n+1-6*k)+3*m*n*(k-2)+6*k^2+3*m*n*k*(6-k)/(m+n)
-                -18*m*n*k^2/(m+n)^2)
+                -18*m*n*k^2/(m+n)^2)-3
               )
         }
     })
@@ -195,7 +210,7 @@
         return(kurtosis(as(x,"AbscontDistribution"),...))
     } else {
         w <- exp(sdlog(x)^2)
-        return( w^4+2*w^3+3*w^2-3 )
+        return( w^4+2*w^3+3*w^2-6)
     }
     })
 #
@@ -224,12 +239,13 @@
         return(kurtosis(as(x,"AbscontDistribution"),...))
     } else {
         if (df(x)>4){
-          n <- df(x); d<- ncp(x)
-          m1 <- sqrt(0.5*n)*gamma(0.5*(n-1))*d/gamma(0.5*n)
-          m2 <- n*(1+d^2)/(n-2)-m1^2
-          m3 <- m1*(n*(2*n-3+d^2)/(n-2)/(n-3)-2*m2)
-          m4 <- n^2*(3+6*d^2+d^4)/(n-2)/(n-4)-m1^2*(n*((n+1)*d^2+3*(3*n-5))/(n-2)/(n-3)-3*m2)
-          return(m4/m2^2-3)
+          n <- df(x)
+          d <- ncp(x)
+          m2 <- var(x)
+          m1 <- E(x)
+          m3 <- (n/2)^1.5*(3*d+d^3)*exp(lgamma((n-3)/2)-lgamma(n/2))
+          m4 <- n^2*(3+6*d^2+d^4)/(n-2)/(n-4)
+          return((m4-4*m3*m1+6*m2*m1^2+3*m1^4)/m2^2-3)
         } else {
           return(NA)
         }

Modified: branches/distr-2.1/pkg/distrEx/R/Skewness.R
===================================================================
--- branches/distr-2.1/pkg/distrEx/R/Skewness.R	2009-03-06 11:36:44 UTC (rev 409)
+++ branches/distr-2.1/pkg/distrEx/R/Skewness.R	2009-03-17 15:04:15 UTC (rev 410)
@@ -119,12 +119,15 @@
           m <- df1(x)
           n <- df2(x)
           d <- ncp(x)
-          L <- d/m
-          m2 <- 2*n^2*(m+n-2)/m/(n-2)^2/(n-4)*(1+2*L+m*L^2/(m+n-2))
-          a <-  8*n^3*(m+n-2)*(2*m+n-2)/m^2/(n-2)^3/(n-4)/(n-6)
-          b <-  1+3*L+6*m*L^2/(2*m+n-2)+2*m^2*L^3/(m+n-2)/(2*m+n-2)
-          m3 <- a*b
-          return(m3/m2^1.5)
+          #L <- d/m
+          #m2 <- 2*n^2*(m+n-2)/m/(n-2)^2/(n-4)*(1+2*L+m*L^2/(m+n-2))
+          m2 <- var(x)
+          m1 <- E(x)
+          m3 <- (n/m)^3/(n-2)/(n-4)/(n-6)*
+                  (m^3+6*m^2+8*m+3*d*(m^2+6*m+8)+3*d^2*(m+4)+d^3)
+#          a <-  8*n^3*(m+n-2)*(2*m+n-2)/m^2/(n-2)^3/(n-4)/(n-6)
+#          b <-  1+3*L+6*m*L^2/(2*m+n-2)+2*m^2*L^3/(m+n-2)/(2*m+n-2)
+          return((m3-3*m2*m1-m1^3)/m2^1.5)
         } else {
           return(NA)
         }
@@ -145,8 +148,10 @@
     fun <- NULL; cond <- NULL
     if((hasArg(fun))||(hasArg(cond))) 
          return(skewness(as(x,"DiscreteDistribution"),...))
-    else
-        return((2-prob(x))/sqrt(1-prob(x)))
+    else{
+        p <- prob(x)
+        return((2-p)/sqrt(1-p))
+    }
     })
 #
 setMethod("skewness", signature(x = "Hyper"),
@@ -188,7 +193,10 @@
     if((hasArg(fun))||(hasArg(cond))) 
          return(skewness(as(x,"DiscreteDistribution"),...))
     else
-        return((2-prob(x))/sqrt(size(x)*(1-prob(x))))
+        {
+        p <- prob(x)
+        return((2-p)/sqrt((1-p)*size(x)))
+    }
     })
 #
 setMethod("skewness", signature(x = "Pois"),
@@ -208,10 +216,10 @@
     } else {
         if (df(x)>3){
         n <- df(x); d<- ncp(x)
-        m1 <- sqrt(0.5*n)*gamma(0.5*(n-1))*d/gamma(0.5*n)
-        m2 <- n*(1+d^2)/(n-2)-m1^2
-        m3 <- m1*(n*(2*n-3+d^2)/(n-2)/(n-3)-2*m2)
-         return(m3/m2^1.5)
+        m1 <- E(x)
+        m2 <- var(x)
+        m3 <- (n/2)^1.5*(3*d+d^3)*exp(lgamma((n-3)/2)-lgamma(n/2))
+         return((m3-3*m2*m1-m1^3)/m2^1.5)
         } else {
          return(NA)
         }

Modified: branches/distr-2.1/www/HOWTO-collaborate.txt
===================================================================
--- branches/distr-2.1/www/HOWTO-collaborate.txt	2009-03-06 11:36:44 UTC (rev 409)
+++ branches/distr-2.1/www/HOWTO-collaborate.txt	2009-03-17 15:04:15 UTC (rev 410)
@@ -1,5 +1,5 @@
 ------------------------------------------------------------------------
-"HOWTO": What you have to do to collaborate in 10 steps:
+"HOWTO": What you have to do to collaborate in 11 steps:
 ------------------------------------------------------------------------
 
 
@@ -94,9 +94,34 @@
                     http://svnbook.red-bean.com/
 
 %%%%%%%%%%%%%
-(7) read the package guidelines
+(7) subscribe to the "commit list"
 %%%%%%%%%%%%%
 
+     in order to keep track with development done by others in the package
+     subscribe to the corresponding "commit" mailing list; don't be afraid
+     it is not a "high frequency" list...
+     
+     to do so follow the following steps:
+         ->  go to the distr page 
+             http://r-forge.r-project.org/mail/?group_id=87
+         ->  on the right bottom side go to item "mailing lists"
+             and follow the link
+         ->  click the corresponding subscribe/unsubscribe link
+             http://lists.r-forge.r-project.org/cgi-bin/mailman/listinfo/distr-commits
+         ->  subscribe
+         ->  you will get an automatic mail asking you to confirm the subscription
+         ->  follow the link given in this mail to confirm the subscription 
+
+     After subscription you will get a mail after each commit to the
+     svn archive giving you the comment tag of the committer and a
+     (possibly truncated) diff file.
+
+     http://robust-ts.r-forge.r-project.org/
+
+%%%%%%%%%%%%%
+(8) read the package guidelines
+%%%%%%%%%%%%%
+
      in Dortmund UseR!2008,  we have worked out some
      programming guidelines for this package to provide
      a certain level of consistency within this package
@@ -105,7 +130,7 @@
      http://distr.r-forge.r-project.org/
 
 %%%%%%%%%%%%%
-(8) inscribe/ get inscribed into the target list
+(9) inscribe/ get inscribed into the target list
 %%%%%%%%%%%%%
 
     To avoid double work, you should signal other collaborators that you are about to
@@ -115,7 +140,7 @@
   
 
 %%%%%%%%%%%%%
-(9) Collaborate
+(10) Collaborate
 %%%%%%%%%%%%%
 
      under <your checkout-folder>/pkg    and
@@ -126,13 +151,13 @@
       any contributions are welcome
 
 %%%%%%%%%%%%%
-(10) HAPPY r-forging...
+(11) HAPPY r-forging...
 %%%%%%%%%%%%%
 ------------------------------------------------------------------------
    
 
 %%%%%%%%%%%%%
-(11) not so important to begin with: branches
+(12) not so important to begin with: branches
 %%%%%%%%%%%%%
 
      as the R-forge repository also is used to provide a source for installation

Modified: www/HOWTO-collaborate.txt
===================================================================
--- www/HOWTO-collaborate.txt	2009-03-06 11:36:44 UTC (rev 409)
+++ www/HOWTO-collaborate.txt	2009-03-17 15:04:15 UTC (rev 410)
@@ -1,5 +1,5 @@
 ------------------------------------------------------------------------
-"HOWTO": What you have to do to collaborate in 10 steps:
+"HOWTO": What you have to do to collaborate in 11 steps:
 ------------------------------------------------------------------------
 
 
@@ -94,9 +94,34 @@
                     http://svnbook.red-bean.com/
 
 %%%%%%%%%%%%%
-(7) read the package guidelines
+(7) subscribe to the "commit list"
 %%%%%%%%%%%%%
 
+     in order to keep track with development done by others in the package
+     subscribe to the corresponding "commit" mailing list; don't be afraid
+     it is not a "high frequency" list...
+     
+     to do so follow the following steps:
+         ->  go to the distr page 
+             http://r-forge.r-project.org/mail/?group_id=87
+         ->  on the right bottom side go to item "mailing lists"
+             and follow the link
+         ->  click the corresponding subscribe/unsubscribe link
+             http://lists.r-forge.r-project.org/cgi-bin/mailman/listinfo/distr-commits
+         ->  subscribe
+         ->  you will get an automatic mail asking you to confirm the subscription
+         ->  follow the link given in this mail to confirm the subscription 
+
+     After subscription you will get a mail after each commit to the
+     svn archive giving you the comment tag of the committer and a
+     (possibly truncated) diff file.
+
+     http://robust-ts.r-forge.r-project.org/
+
+%%%%%%%%%%%%%
+(8) read the package guidelines
+%%%%%%%%%%%%%
+
      in Dortmund UseR!2008,  we have worked out some
      programming guidelines for this package to provide
      a certain level of consistency within this package
@@ -105,7 +130,7 @@
      http://distr.r-forge.r-project.org/
 
 %%%%%%%%%%%%%
-(8) inscribe/ get inscribed into the target list
+(9) inscribe/ get inscribed into the target list
 %%%%%%%%%%%%%
 
     To avoid double work, you should signal other collaborators that you are about to
@@ -115,7 +140,7 @@
   
 
 %%%%%%%%%%%%%
-(9) Collaborate
+(10) Collaborate
 %%%%%%%%%%%%%
 
      under <your checkout-folder>/pkg    and
@@ -126,13 +151,13 @@
       any contributions are welcome
 
 %%%%%%%%%%%%%
-(10) HAPPY r-forging...
+(11) HAPPY r-forging...
 %%%%%%%%%%%%%
 ------------------------------------------------------------------------
    
 
 %%%%%%%%%%%%%
-(11) not so important to begin with: branches
+(12) not so important to begin with: branches
 %%%%%%%%%%%%%
 
      as the R-forge repository also is used to provide a source for installation



More information about the Distr-commits mailing list