3

有没有一种简单的方法来为 R 中的二维直方图（hist2d）定义中断而不是 nbins？

我想为二维直方图定义 x 轴和 y 轴的范围以及每个维度的 bin 数量。

我的例子：

# example data
x <- sample(-1:100, 2000, replace=T)
y <- sample(0:89, 2000, replace=T)

# create 2d histogram 
h2 <- hist2d(x,y,nbins=c(23,19),xlim=c(-1,110), ylim=c(0,95),xlab='x',ylab='y',main='hist2d')

这导致此 2D 直方图输出1 

----------------------------
2-D Histogram Object
----------------------------

Call: hist2d(x = x, y = y, nbins = c(23, 19), xlab = "x", ylab = "y", 
   xlim = c(-1, 110), ylim = c(0, 95), main = "hist2d")

Number of data points:  2000 
Number of grid bins:  23 x 19 
X range: ( -1 , 100 ) 
Y range: ( 0 , 89 )

我需要

X range: ( -1 , 110 ) 
Y range: ( 0 , 95 )

反而。

我尝试定义 xlim 和 ylim 只扩展了绘图，但没有定义直方图的轴范围。我知道额外的垃圾箱中不会有数据。

有没有办法定义

xbreaks = seq(-1,110,5)
ybreaks = seq(0,95,5)

而不是使用 nbins 将从最小值到最大值的范围划分为给定数量的 bin？

谢谢您的帮助

4

2 回答 2

1

我稍微更改了代码，这个版本应该可以明确定义两个轴的中断。首先，您必须加载该功能。然后你可以给x.breaks和y.breaks选项x.breaks=seq(0,10,0.1)。如果same.scale为真，则只需要x.breaks 返回值额外包含 bin 的数量和相对计数。此外，如果需要，您可以通过设置来包含图例legend=TRUE。为此，您需要有包裹Fields

hist2d_breaks = function (x, y = NULL, nbins = 200,same.scale = FALSE, na.rm = TRUE, 
                    show = TRUE, col = c("black", heat.colors(12)), FUN = base::length, 
                    xlab, ylab,x.breaks,y.breaks, ...) 
{
  if (is.null(y)) {
  if (ncol(x) != 2) 
      stop("If y is ommitted, x must be a 2 column matirx")
    y <- x[, 2]
    x <- x[, 1]
  }
  if (length(nbins) == 1) 
    nbins <- rep(nbins, 2)
  nas <- is.na(x) | is.na(y)
  if (na.rm) {
    x <- x[!nas]
    y <- y[!nas]
  }
  else stop("missinig values not permitted if na.rm=FALSE")
  if(same.scale){
    x.cuts = x.breaks;
    y.cuts = x.breaks;
  }else{
    x.cuts <- x.breaks
    y.cuts <- y.breaks   
  }


  index.x <- cut(x, x.cuts, include.lowest = TRUE)
  index.y <- cut(y, y.cuts, include.lowest = TRUE)
  m <- tapply(x, list(index.x, index.y), FUN)
  if (identical(FUN, base::length)) 
    m[is.na(m)] <- 0
  if (missing(xlab)) 
    xlab <- deparse(substitute(xlab))
  if (missing(ylab)) 
    ylab <- deparse(substitute(ylab))
  if (show){
    if(legend){
      image.plot(x.cuts, y.cuts, m, col = col, xlab = xlab, ylab = ylab, 
                 ...)
    }else{
      image(x.cuts, y.cuts, m, col = col, xlab = xlab, ylab = ylab, 
                 ...)
    }
  } 
  midpoints <- function(x) (x[-1] + x[-length(x)])/2
  retval <- list()
  retval$counts <- m
  retval$counts_rel <- m/max(m)  
  retval$x.breaks = x.cuts
  retval$y.breaks = y.cuts
  retval$x = midpoints(x.cuts)
  retval$y = midpoints(y.cuts)
  retval$nobs = length(x)
  retval$bins = c(length(x.cuts),length(y.cuts))
  retval$call <- match.call()
  class(retval) <- "hist2d"
  retval
}

（我的数据）的调用然后带来以下内容： hist2d_breaks(df,x.breaks=seq(0,10,1),y.breaks=seq(-10,10,1),legend=TRUE) 调出以下 带有中断的二维直方图

于 2016-02-02T08:01:51.040 回答
0

修改“hist2d”如下

hist2d_range<-function (x, y = NULL, nbins = 200, same.scale = TRUE, na.rm = TRUE,
show = TRUE, col = c("black", heat.colors(12)), FUN = base::length,
xlab, ylab,range=NULL, ...)
{
if (is.null(y)) {
if (ncol(x) != 2)
    stop("If y is ommitted, x must be a 2 column matirx")
y <- x[, 2]
x <- x[, 1]
}
if (length(nbins) == 1)
nbins <- rep(nbins, 2)
nas <- is.na(x) | is.na(y)
if (na.rm) {
x <- x[!nas]
y <- y[!nas]
}
else stop("missinig values not permitted if na.rm=FALSE")
if (same.scale) {
if(is.null(range))
   {
       x.cuts <- seq(from = min(x, y), to = max(x, y), length = nbins[1] +
             1)
       y.cuts <- seq(from = min(x, y), to = max(x, y), length = nbins[2] +
             1)
   }else{

       x.cuts <- seq(from = range[1], to = range[2], length = nbins[1] + 1)
           y.cuts <- seq(from = range[1], to = range[2], length = nbins[1] + 1)


   }

}
else {
x.cuts <- seq(from = min(x), to = max(x), length = nbins[1] +
    1)
y.cuts <- seq(from = min(y), to = max(y), length = nbins[2] +
    1)
}
index.x <- cut(x, x.cuts, include.lowest = TRUE)
index.y <- cut(y, y.cuts, include.lowest = TRUE)
m <- tapply(x, list(index.x, index.y), FUN)
if (identical(FUN, base::length))
m[is.na(m)] <- 0
if (missing(xlab))
xlab <- deparse(substitute(xlab))
if (missing(ylab))
ylab <- deparse(substitute(ylab))
if (show)
image(x.cuts, y.cuts, m, col = col, xlab = xlab, ylab = ylab,
    ...)
midpoints <- function(x) (x[-1] + x[-length(x)])/2
retval <- list()
retval$counts <- m
retval$x.breaks = x.cuts
retval$y.breaks = y.cuts
retval$x = midpoints(x.cuts)
retval$y = midpoints(y.cuts)
retval$nobs = length(x)
retval$call <- match.call()
class(retval) <- "hist2d"
retval
}

此函数有一个附加参数“范围”。修改点如下。

   if(is.null(range))
   {
       x.cuts <- seq(from = min(x, y), to = max(x, y), length = nbins[1] +
             1)
       y.cuts <- seq(from = min(x, y), to = max(x, y), length = nbins[2] +
             1)
   }else{

       x.cuts <- seq(from = range[1], to = range[2], length = nbins[1] + 1)
           y.cuts <- seq(from = range[1], to = range[2], length = nbins[1] + 1)


   }
于 2015-12-19T11:48:52.403 回答