Общие разрывы и свободные оси для перекрывающихся решеточных гистограмм - PullRequest
Новая
       65

Общие разрывы и свободные оси для перекрывающихся решеточных гистограмм

7 голосов
/ 22 января 2020

Какое требуется заклинание для достижения перекрытия, ограненного lattice::histogram с общими точками разрыва (для разных групп, но потенциально различного для разных панелей)?

Например, предположим, что мне нужен полный диапазон данных (группы объединены) для каждой панели, которая будет разделена на 30 ячеек.

Пример данных: 

library(lattice)
set.seed(1)
d <- data.frame(v1=rep(c('A', 'B'), each=1000), 
                v2=rep(c(0.5, 1), each=2000),
                mean=rep(c(0, 10, 2, 12), each=1000))
d$x <- rnorm(nrow(d), d$mean, d$v2)

Использование nint=30? 

p1 <- histogram(~x|v1, d, groups=v2, nint=30,
                scales=list(relation='free'), type='percent',
                panel = function(...) {
                  panel.superpose(..., panel.groups=panel.histogram, 
                                  col=c('red', 'blue'), alpha=0.3)
                })
p1

enter image description here

Выше, ячейки одинаковы для разных групп, но (1) пределы оси x являются общими для всех панелей (проблематично c, когда диапазон оси x существенно различается для разных панелей - я действительно хочу, чтобы 30 корзин были рассчитаны индивидуально для каждой панели), и (2) ось Y ограничена при использовании type='percent' (она должна расширяться дальше).

При использовании breaks=30? 

p2 <- histogram(~x|v1, d, groups=v2, breaks=30,
                scales=list(relation='free'), type='percent',
                panel = function(...) {
                  panel.superpose(..., panel.groups=panel.histogram, 
                                  col=c('red', 'blue'), alpha=0.3)
                })
p2

enter image description here

Теперь границы осей выглядят хорошо, но ширина ячеек варьируется в зависимости от группы.

Итак ...

Используя lattice, как я могу добиться перекрытия, граненый гистограммы, которые имеют постоянную ширину бина между группами внутри панелей, но имеют ограничения по осям, которые соответствуют данным для каждой панели?

(я понимаю, что ggplot - это вариант, но я хочу, чтобы стиль рисунка соответствовал моему другому решетчатые участки.)

1 Ответ

1 голос
/ 31 января 2020

Это работает, но, боюсь, это скорее пешеход. По крайней мере, для этого требуется только сам объект шпалеры; он будет считать, что количество бинов, которое вы хотите на каждой панели, равно параметру nint .

Это работает так: проверьте, перекрываются ли диапазоны панелей. Если они этого не делают, разбейте каждый (слегка расширенный) диапазон на nint корзин, затем объедините их с несколькими пустыми корзинами между ними. Нам также нужно определить диапазон y, который мы делаем путем масштабирования в соответствии с максимальным числом отсчетов. 

fix_facets <- function(p1)
{
  n_bins <- p1$panel.args.common$nint
  xvals1 <- p1$panel.args[[1]]$x
  xvals2 <- p1$panel.args[[2]]$x

  if(min(xvals2) > max(xvals1) | min(xvals1) > max(xvals2)){
    left_range  <- range(xvals1)
    left_range  <- left_range + (diff(left_range) * c(-0.1, 0.1))
    left_bins   <- seq(left_range[1], left_range[2], diff(left_range)/n_bins)
    right_range <- range(xvals2)
    right_range  <- right_range + (diff(right_range) * c(-0.1, 0.1))
    right_bins   <- seq(right_range[1], right_range[2], diff(right_range)/n_bins)

    if(max(left_range) < min(right_range)){
      mid_bins <- seq(max(left_bins), min(right_bins), diff(left_bins[1:2]))
      all_bins <- c(left_bins, mid_bins, right_bins)
    } else {
      mid_bins <- seq(max(right_bins), min(left_bins), diff(right_bins[1:2]))
      all_bins <- c(right_bins, mid_bins, left_bins)
    }
    p1$panel.args.common$breaks <- all_bins
    p1$x.limits[[1]] <- left_range
    p1$x.limits[[2]] <- right_range
    histleft  <- hist(xvals1, breaks = left_bins)
    histright <- hist(xvals2, breaks = right_bins)
    group_factor <- 100 * length(p1$condlevels[[1]])

    p1$y.limits[[1]][2] <- group_factor * max(histleft$counts) / length(xvals1)
    p1$y.limits[[2]][2] <- group_factor * max(histright$counts) / length(xvals2)
  }
  return(p1)
}

Итак, с вашим примером мы можем сделать это: 

p1 <- histogram(~x|v1, d, groups=v2, nint=30,
                scales=list(relation='free'), type='percent',
                panel = function(...) {
                  panel.superpose(..., panel.groups=panel.histogram, 
                                  col=c('red', 'blue'), alpha=0.3)
                })
fix_facets(p1)

enter image description here

и показать, что он работает с другими номерами бинов ... 

p1 <- histogram(~x|v1, d, groups=v2, nint=10,
                scales=list(relation='free'), type='percent',
                panel = function(...) {
                  panel.superpose(..., panel.groups=panel.histogram, 
                                  col=c('red', 'blue'), alpha=0.3)
                })
fix_facets(p1)

enter image description here

...