重叠的格子直方图常见的间隔和自由轴

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

上面的内容中，不同组之间的箱子是一致的，但是（1）x轴的限制在面板之间是共享的（当x轴范围在面板之间有很大差异时会出现问题——我真的希望每个面板都可以单独计算30个箱子），并且（2）使用type='percent'时y轴会很挤（应该扩展更远）。

使用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，我如何实现重叠的面板直方图，在面板内部分组具有恒定的箱子宽度，但轴限制适合每个面板的数据？

（我知道ggplot是一个选项，但我希望图形风格与我的其他lattice图形保持一致。）

- jbaums

---

尝试使用 nint=30 而不是 breaks=30。这样做是否符合您的要求？ - MrFlick

感谢@MrFlick - 我认为我的帖子需要一个tl;dr，但我在上面展示了nint=30。问题是它似乎不尊重x轴的'relation ='free''，而且我想扩展y限制（虽然使用type ='count'可以解决后者，如果我这样做，我可以重新标记轴刻度）。 - jbaums

一个部分解决方案是https://gist.github.com/johnbaums/028106a8b82dc27937ec9bb6de01da8e，但是（根据我在那里的评论），如果值的范围（x轴）在面板之间变化很大，它将无法正常工作。 - jbaums

Answer 1

这个方案可行，但我担心它有点平凡。至少它只需要使用“trellis”对象本身；它会假设每个面板中所需的箱数等于“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=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)

- Allan Cameron

---

行人很好 - 这看起来很棒。我喜欢它更新现有的对象。 - jbaums