重叠晶格直方图的公共中断和自由轴

Question

需要什么咒语才能实现重叠，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

上面，组之间的 bin 是一致的，但是 (1) x 轴限制在面板之间共享（当 x 轴范围在面板间变化很大时有问题 - 我真的希望为每个面板单独计算 30 个 bin）， (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

现在轴限制看起来不错，但箱宽度因组而异。

所以...

使用lattice，如何实现重叠的多面直方图，这些直方图在面板内的组之间具有恒定的 bin 宽度，但具有适合每个面板的数据的轴限制？

（我意识到 ggplot 是一个选项，但我希望图形样式与我的其他格子图一致。）

Answer 1

这可行，但恐怕相当平淡。至少它只需要网格对象本身；它将假设每个面板中所需的 bin 数量等于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)

并展示它可以与其他数量的垃圾箱一起使用......

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)