[R-gregmisc-users] SF.net SVN: r-gregmisc:[1471] trunk/gplots

[<wa...@us...>]

Revision: 1471
          http://r-gregmisc.svn.sourceforge.net/r-gregmisc/?rev=1471&view=rev
Author:   warnes
Date:     2011-08-16 01:03:31 +0000 (Tue, 16 Aug 2011)

Log Message:
-----------
Accellerate hist2d by replacing for() loop with tapply(), and allow user to specify summary function applied, per suggestion by Peter Hagedorn (PHA -at- santaris -dot- com).

Modified Paths:
--------------
    trunk/gplots/R/hist2d.R
    trunk/gplots/man/hist2d.Rd

Modified: trunk/gplots/R/hist2d.R
===================================================================
--- trunk/gplots/R/hist2d.R	2011-05-02 14:02:34 UTC (rev 1470)
+++ trunk/gplots/R/hist2d.R	2011-08-16 01:03:31 UTC (rev 1471)
@@ -1,7 +1,16 @@
 # $Id$
 
 if(is.R())
-hist2d <- function( x,y=NULL, nbins=200, same.scale=FALSE, na.rm=TRUE, show=TRUE, col=c("black", heat.colors(12)), ... )
+
+  hist2d <- function(x,
+                     y=NULL,
+                     nbins=200,
+                     same.scale=FALSE,
+                     na.rm=TRUE,
+                     show=TRUE,
+                     col=c("black", heat.colors(12)),
+                     FUN=base::length,
+                     ... )
   {
     if(is.null(y))
       {
@@ -34,18 +43,17 @@
         y.cuts <- seq( from=min(y), to=max(y), length=nbins[2]+1, labels=FALSE)
       }
 
-
-
     index.x <- cut( x, x.cuts, include.lowest=TRUE)
     index.y <- cut( y, y.cuts, include.lowest=TRUE)
 
-    m <- matrix( 0, nrow=nbins[1], ncol=nbins[2],
-                dimnames=list( levels(index.x),
-                               levels(index.y) ) )
+    ## tapply is faster than old for() loop, and allows
+    ## use of any user-specified summary function 
+    m <- tapply(x,list(index.x,index.y),FUN)
 
-    for( i in 1:length(index.x) )
-      m[ index.x[i], index.y[i] ] <-  m[ index.x[i], index.y[i] ] + 1
-
+    ## If we're using length, set empty cells to 0 instead of NA
+    if(identical(FUN,base::length))
+      m[is.na(m)] <- 0
+        
     xvals <- x.cuts[1:nbins[1]]
     yvals <- y.cuts[1:nbins[2]]
 
@@ -54,9 +62,3 @@
 
     invisible(list(counts=m,x=xvals,y=yvals))
   }
-
-
-
-
-
-

Modified: trunk/gplots/man/hist2d.Rd
===================================================================
--- trunk/gplots/man/hist2d.Rd	2011-05-02 14:02:34 UTC (rev 1470)
+++ trunk/gplots/man/hist2d.Rd	2011-08-16 01:03:31 UTC (rev 1471)
@@ -27,9 +27,8 @@
 }
 \usage{
 hist2d(x,y=NULL, nbins=200, same.scale=FALSE, na.rm=TRUE, show=TRUE,
-       col=c("black", heat.colors(12)), ... )
+       col=c("black", heat.colors(12)), FUN=base::length, ... )
 }
-%- maybe also `usage' for other objects documented here.
 \arguments{
   \item{x}{either a vector containing the x coordinates
     or a matrix with 2 columns. }
@@ -45,6 +44,10 @@
     been computed. Defaults to TRUE.}
   \item{col}{ Colors for the histogram. Defaults to "black" for
     bins containing no elements, a set of 16 heat colors for other bins.}
+  \item{FUN}{Function used to summarize bin contents.  Defaults to
+    \code{base::length}. Use, e.g., \code{mean} to calculate means for each bin
+    instead of counts.
+    }
   \item{\dots}{ Parameters passed to the image function. }
 }
 \details{
@@ -61,10 +64,8 @@
     bin}
   \item{x}{lower x limit of each bin}
   \item{y}{lower y limit of each bin}
-}
-%\references{ ~put references to the literature/web site here ~ }
+  }
 \author{ Gregory R. Warnes \email{gr...@wa...}}
-%\note{ ~~further notes~~ }
 
 \seealso{ \code{\link{image}}, \code{\link{persp}}, \code{\link{hist}} }
 


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.