определить разрывы для hist2d в R

Question

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

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

Мой пример:

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

Спасибо за вашу помощь

Answer 1

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


    } 

Answer 2

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