[R-gregmisc-users] SF.net SVN: r-gregmisc:[1501] trunk/gplots
Brought to you by:
warnes
Menu
▾
▴
[R-gregmisc-users] SF.net SVN: r-gregmisc:[1501] trunk/gplots
|
From: <wa...@us...> - 2011-09-02 18:14:45
|
Revision: 1501
http://r-gregmisc.svn.sourceforge.net/r-gregmisc/?rev=1501&view=rev
Author: warnes
Date: 2011-09-02 18:14:37 +0000 (Fri, 02 Sep 2011)
Log Message:
-----------
Provide print() methods for 'hist2d' and 'ci2d' objects.
Modified Paths:
--------------
trunk/gplots/NAMESPACE
trunk/gplots/R/ci2d.R
trunk/gplots/R/hist2d.R
trunk/gplots/man/ci2d.Rd
trunk/gplots/man/hist2d.Rd
Added Paths:
-----------
trunk/gplots/R/print.ci2d.R
trunk/gplots/R/print.hist2d
Modified: trunk/gplots/NAMESPACE
===================================================================
--- trunk/gplots/NAMESPACE 2011-09-02 17:25:11 UTC (rev 1500)
+++ trunk/gplots/NAMESPACE 2011-09-02 18:14:37 UTC (rev 1501)
@@ -62,3 +62,5 @@
S3method(textplot,default)
S3method(textplot,matrix)
+S3method(print,ci2d)
+S3method(print,hist2d)
Modified: trunk/gplots/R/ci2d.R
===================================================================
--- trunk/gplots/R/ci2d.R 2011-09-02 17:25:11 UTC (rev 1500)
+++ trunk/gplots/R/ci2d.R 2011-09-02 18:14:37 UTC (rev 1501)
@@ -1,4 +1,4 @@
-## $Id$
+# $Id: hist2d.R 1471 2011-08-16 01:03:31Z warnes $
## first(...) selects the first element of which(...)
first <- function(x,...)
@@ -87,8 +87,8 @@
h2d$x <- est$x1
h2d$y <- est$x2
h2d$counts <- est$fhat
+ h2d$nobs <- nrow(x)
h2d$density <- est$fhat / sum(est$fhat) # normalize
-
}
else
stop("Unknown method: '", method, "'")
@@ -124,7 +124,8 @@
xlab=xlab,
ylab=ylab,
plot.title=plot.title(),
- key.title=title("\nCI Level")
+ key.title=title("\nCI Level"),
+ key.axes=axis(4, at=breaks)
)
}
else if(show=="contour")
@@ -153,6 +154,8 @@
function(J) data.frame(x=J$x, y=J$y) )
h2d$call <- match.call()
+ class(h2d) <- "ci2d"
invisible(h2d)
}
+
Modified: trunk/gplots/R/hist2d.R
===================================================================
--- trunk/gplots/R/hist2d.R 2011-09-02 17:25:11 UTC (rev 1500)
+++ trunk/gplots/R/hist2d.R 2011-09-02 18:14:37 UTC (rev 1501)
@@ -1,16 +1,14 @@
# $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)),
- FUN=base::length,
- ... )
+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))
{
@@ -53,12 +51,19 @@
## 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]]
if(show)
image( xvals,yvals, m, col=col,...)
- invisible(list(counts=m,x=xvals,y=yvals))
+ retval <- list()
+ retval$counts <- m
+ retval$x=xvals
+ retval$y=yvals
+ retval$nobs=length(x)
+ retval$call <- match.call()
+ class(retval) <- "hist2d"
+ retval
}
Added: trunk/gplots/R/print.ci2d.R
===================================================================
--- trunk/gplots/R/print.ci2d.R (rev 0)
+++ trunk/gplots/R/print.ci2d.R 2011-09-02 18:14:37 UTC (rev 1501)
@@ -0,0 +1,34 @@
+## $Id$
+
+print.ci2d <- function(x, ...)
+ {
+ cat("\n")
+ cat("----------------------------\n")
+ cat("2-D Confidence Region Object\n")
+ cat("----------------------------\n")
+ cat("\n")
+ cat("Call: ")
+ print(x$call)
+ cat("\n")
+ cat("Number of data points: ", x$nobs, "\n")
+ cat("Number of grid points: ", length(x$x), "x", length(x$y), "\n")
+ cat("Number of confidence regions:", length(x$contours), "\n")
+ cat("\n")
+
+ tab <- data.frame(
+ "Region"=1:length(x$contours),
+ "CI Level"=as.numeric(names(x$contours)),
+ "X Min"=sapply(x$contours, function(XX) min(XX$x)),
+ "X Max"=sapply(x$contours, function(XX) max(XX$x)),
+ "Y Min"=sapply(x$contours, function(XX) min(XX$y)),
+ "Y Max"=sapply(x$contours, function(XX) max(XX$y))
+ )
+
+ print(tab, row.names=FALSE, ...)
+
+ x$summary <- tab
+
+ class(x) <- c("ci2d.summary", "ci2d")
+
+ return(x)
+ }
Added: trunk/gplots/R/print.hist2d
===================================================================
--- trunk/gplots/R/print.hist2d (rev 0)
+++ trunk/gplots/R/print.hist2d 2011-09-02 18:14:37 UTC (rev 1501)
@@ -0,0 +1,19 @@
+# $Id: hist2d.R 1471 2011-08-16 01:03:31Z warnes $
+
+print.hist2d <- function(x, ...)
+ {
+ cat("\n")
+ cat("----------------------------\n")
+ cat("2-D Histogram Object\n")
+ cat("----------------------------\n")
+ cat("\n")
+ cat("Call: ")
+ print(x$call)
+ cat("\n")
+ cat("Number of data points: ", x$nobs, "\n")
+ cat("Number of grid points: ", length(x$x), "x", length(x$y), "\n")
+ cat("X range: (", min(x$x), ",", max(x$x), ")\n")
+ cat("Y range: (", min(x$y), ",", max(x$y), ")\n")
+ cat("\n")
+
+ }
Modified: trunk/gplots/man/ci2d.Rd
===================================================================
--- trunk/gplots/man/ci2d.Rd 2011-09-02 17:25:11 UTC (rev 1500)
+++ trunk/gplots/man/ci2d.Rd 2011-09-02 18:14:37 UTC (rev 1501)
@@ -19,6 +19,7 @@
points.col="red",
xlab, ylab,
...)
+\method{print}{ci2d}(x, ...)
}
\arguments{
\item{x}{either a vector containing the x coordinates
@@ -65,7 +66,9 @@
kernel smoothing method, bin locations, bin sizes, and kernel bandwidth.
}
\value{
- A list containing (at least) the following elements:
+ A \code{ci2d} object consisting of a list containing (at least) the
+ following elements:
+ \item{nobs}{number of original data points}
\item{x}{x position of each density estimate bin}
\item{y}{y position of each density estimate bin}
\item{density}{Matrix containing the probability density of each bin
@@ -73,11 +76,9 @@
\item{cumDensity}{Matrix where each element contains the cumulative
probability density of all elements with the same density (used to
create the confidence region plots) }
- \item{contours}{Contours of each confidence region}.
+ \item{contours}{List of contours of each confidence region.}
\item{call}{Call used to create this object}
}
-%\references{
-%}
\author{ Gregory R. Warnes \email{gr...@wa...}}
\seealso{
\code{\link[KernSmooth]{bkde2D}}, \code{\link[KernSmooth]{dpik}},
@@ -251,12 +252,18 @@
lty=c(NA,1,1,1)
)
-
+ ####
+ ## Test with a large number of points
+ ####
+ x <- rnorm(60000, sd=1)
+ y <- c( rnorm(40000, mean=x, sd=1),
+ rnorm(20000, mean=x+4, sd=1) )
+ hist2d(x,y)
+ ci <- ci2d(x,y)
+ ci
}
-% Add one or more standard keywords, see file 'KEYWORDS' in the
-% R documentation directory.
\keyword{dplot}
\keyword{hplot}
\keyword{nonparametric}
Modified: trunk/gplots/man/hist2d.Rd
===================================================================
--- trunk/gplots/man/hist2d.Rd 2011-09-02 17:25:11 UTC (rev 1500)
+++ trunk/gplots/man/hist2d.Rd 2011-09-02 18:14:37 UTC (rev 1501)
@@ -8,6 +8,7 @@
\usage{
hist2d(x,y=NULL, nbins=200, same.scale=FALSE, na.rm=TRUE, show=TRUE,
col=c("black", heat.colors(12)), FUN=base::length, ... )
+\method{print}{hist2d}(x, ...)
}
\arguments{
\item{x}{either a vector containing the x coordinates
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
