Определить разрывы для Hist2D в R

Есть ли простой способ определить разрывы вместо nbins для 2-мерной гистограммы (hist2d) в R?

Я хочу определить диапазон для x- и yaxis для 2D-гистограммы и количество бинов для каждого измерения.

Мой пример:

# 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, который делит диапазон от минимального до максимального на данное количество бинов?

Спасибо за помощь

Источник

2 ответа

Я немного изменил код, и эта версия должна работать с явным определением разрывов для обеих осей. Сначала вы должны загрузить функцию. Тогда вы можете дать x.breaks а также y.breaks варианты с x.breaks=seq(0,10,0.1), Если same.scale это правда, вам нужно только x.breaksВозвращаемое значение addionaly содержит количество бинов и относительное количество. Кроме того, вы можете включить легенду, если хотите, установив 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)выводит следующий график 2D гистограммы с перерывами

Источник

Пересмотрите "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)


   }
Источник
Другие вопросы по тегам