Question

我有以下数据集：

df <- data.frame(dens = rnorm(5000),
             split = as.factor(sample(1:2, 5000, replace = T)),
             method = as.factor(sample(c("A","B"), 5000, replace = T)),
             counts = sample(c(1, 10, 100, 1000, 10000), 5000, replace = T))

我想要做的是为每个计数在A组和B组中进行分裂1和2的分裂小提琴图（这将是在logscale中，但这对于这个例子并不重要）。每个设置我们有四个组，但它有一个嵌套的方面。

所以，我可以做到以下几点：

df$key <- factor(paste(df$split, df$method))

然后：

library(ggplot2)
ggplot(df, aes(x = factor(counts), y = dens, fill = split)) +
geom_violin(aes(fill = key), scale = "width", draw_quantiles = c(0.25, 0.5, 0.75)) + scale_fill_manual(values = cbPalette) + theme_bw()

给出了以下情节：

但我想要的是浅蓝色和深蓝色是分裂小提琴情节的两半，浅绿色和深绿色是另一个分裂小提琴情节的两半，这些情节应该是成束的一起。我也希望不同的计数彼此更加分离，但我觉得我可以解决这个问题。

请注意，这个问题与我列出的问题或Split violin plot with ggplot2不同，因为我们正在为每个“Counts”聚集两个不同级别的嵌套分裂小提琴图。

我试图关注enter link description here但是我不知道如何将这样的嵌套组设置添加到那里的代码，我正在寻找一些建议。

以下是我的尝试：

GeomSplitViolin <- ggproto("GeomSplitViolin", GeomViolin, 
  draw_group = function(self, data, ..., draw_quantiles = NULL){
    # By @YAK: https://stackoverflow.com/questions/35717353/split-violin-plot-with-ggplot2
    data <- transform(data, xminv = x - violinwidth * (x - xmin), xmaxv = x + violinwidth * (xmax - x))
    grp <- data[1,'group']
    newdata <- plyr::arrange(transform(data, x = if(grp%%2==1) xminv else xmaxv), if(grp%%2==1) y else -y)
    newdata <- rbind(newdata[1, ], newdata, newdata[nrow(newdata), ], newdata[1, ])
    newdata[c(1,nrow(newdata)-1,nrow(newdata)), 'x'] <- round(newdata[1, 'x']) 
    if (length(draw_quantiles) > 0 & !scales::zero_range(range(data$y))) {
      stopifnot(all(draw_quantiles >= 0), all(draw_quantiles <= 1))
      quantiles <- create_quantile_segment_frame(data, draw_quantiles, split = TRUE, grp = grp)
      aesthetics <- data[rep(1, nrow(quantiles)), setdiff(names(data), c("x", "y")), drop = FALSE]
      aesthetics$alpha <- rep(1, nrow(quantiles))
      both <- cbind(quantiles, aesthetics)
      quantile_grob <- GeomPath$draw_panel(both, ...)
      ggplot2:::ggname("geom_split_violin", grid::grobTree(GeomPolygon$draw_panel(newdata, ...), quantile_grob))
    }
    else {
      ggplot2:::ggname("geom_split_violin", GeomPolygon$draw_panel(newdata, ...))
    }
  }
)

create_quantile_segment_frame <- function (data, draw_quantiles, split = FALSE, grp = NULL) {
  dens <- cumsum(data$density)/sum(data$density)
  ecdf <- stats::approxfun(dens, data$y)
  ys <- ecdf(draw_quantiles)
  violin.xminvs <- (stats::approxfun(data$y, data$xminv))(ys)
  violin.xmaxvs <- (stats::approxfun(data$y, data$xmaxv))(ys)
  violin.xs <- (stats::approxfun(data$y, data$x))(ys)
  if (grp %% 2 == 0) {
    data.frame(x = ggplot2:::interleave(violin.xs, violin.xmaxvs), 
               y = rep(ys, each = 2), group = rep(ys, each = 2)) 
  } else {
    data.frame(x = ggplot2:::interleave(violin.xminvs, violin.xs), 
               y = rep(ys, each = 2), group = rep(ys, each = 2)) 
  }
}



geom_split_violin <- function (mapping = NULL, data = NULL, stat = "ydensity", position = "identity", ..., draw_quantiles = NULL, trim = TRUE, scale = "area", na.rm = FALSE, show.legend = NA, inherit.aes = TRUE) {
  layer(data = data, mapping = mapping, stat = stat, geom = GeomSplitViolin, position = position, show.legend = show.legend, inherit.aes = inherit.aes, params = list(trim = trim, scale = scale, draw_quantiles = draw_quantiles, na.rm = na.rm, ...))
}

library(ggplot2)
ggplot(df, aes(x = factor(counts), y = dens, fill = interaction(split,method))) +
           geom_split_violin(draw_quantiles = c(0.25, 0.5, 0.75)) + scale_fill_manual(values=RColorBrewer::brewer.pal(name="Paired",n=4)) + theme_light() + theme(legend.position="bottom")

这就是我得到的：

可以看出，绿色图像位于蓝色之上。我该如何解决这个问题？谢谢！

编辑：听到Axeman的建议，我几乎就在那里：

   levels(df$split) <- factor(0:3)

   library(ggplot2)
   ggplot(df, aes(x = interaction(split, counts), y = dens, fill = key)) + geom_split_violin(draw_quantiles = c(0.25, 0.5, 0.75)) + scale_fill_manual(values=RColorBrewer::brewer.pal(name="Paired",n=4)) + theme_light() + theme(legend.position="bottom") + scale_x_discrete(interaction(df$split,df$counts)[-length(interaction(df$split,df$counts))], drop = FALSE)

几乎就在那里！

想要两个修复：分割和计数之间的最后一次交互产生的空白区域，以及每个区域只有计数的比例。不知道这些应该是Stackoverflow上的单独问题。

几乎就在那里！

library(ggplot2)
ggplot(df, aes(x = interaction(split, counts), y = dens, fill = key)) + geom_split_violin(draw_quantiles = c(0.25, 0.5, 0.75)) +scale_fill_manual(values=RColorBrewer::brewer.pal(name="Paired",n=4)) + theme_light() + theme(legend.position="bottom") + scale_x_discrete(limits=levels(interaction(df$split,df$counts))[-length(levels(interaction(df$split,df$counts)))],drop = FALSE)

这会产生：

我仍然需要在两个图之间的x轴上放置计数值。

Answer 1

我认为这个问题已经太长了，这个问题的基本部分已经得到了回答。我提出了一个关于如何改变离散尺度的新问题。希望有人知道！无论如何，这是这个问题的答案（谢谢，Ax！）。它是我的问题的编辑版本。

set_value

ggplot2：显示嵌套分裂小提琴的块

1 个答案: