如何在此示例图的右侧添加直方图或密度图以描述y值的分布?

时间:2019-01-28 11:02:14

标签: r ggplot2

为清楚起见,我正在寻找一种简单的方法来添加90度旋转的直方图或密度图,其x轴与下面给出的示例图的y轴对齐。

library(ggplot2)
library(tibble)

x <- seq(100)
y <- rnorm(100)

my_data <- tibble(x = x, y = y)
ggplot(data = my_data, mapping = aes(x = x, y = y)) +
  geom_line()

reprex package(v0.2.1)于2019-01-28创建

4 个答案:

答案 0 :(得分:3)

我会使用geom_histogram库中的geom_densitypatchwork尝试,并动态设置限制以匹配图。

不是手动设置限制,而是获取y值的范围,将其设置为scale_y_continuousscale_x_continuous中的限制,并使用expand_scale添加一些填充。第一个图是线图,第二个和第三个是分布图,其中轴已翻转。所有的比例尺都设置为匹配。

library(ggplot2)
library(tibble)
library(patchwork)

y_range <- range(my_data$y)

p1 <- ggplot(data = my_data, mapping = aes(x = x, y = y)) +
  geom_line() +
  scale_y_continuous(limits = y_range, expand = expand_scale(mult = 0.1))

p2_hist <- ggplot(my_data, aes(x = y)) +
  geom_histogram(binwidth = 0.2) +
  coord_flip() +
  scale_x_continuous(limits = y_range, expand = expand_scale(mult = 0.1))

p2_dens <- ggplot(my_data, aes(x = y)) +
  geom_density() +
  coord_flip() +
  scale_x_continuous(limits = y_range, expand = expand_scale(mult = 0.1))

patchwork允许您简单地相互添加图,然后添加plot_layout函数以自定义布局。

p1 + p2_hist + plot_layout(nrow = 1)

p1 + p2_dens + plot_layout(nrow = 1)

我通常看到这些类型的图,其中的分布以“边际”图显示-即,设置为次要于主图(在此例中为线图)。 ggExtra程序包有一个边际图,但是它似乎仅在主图是散点图的情况下才起作用。

要手动执行此样式设置,请在将每个图传递给plot_layout时内联地设置主题参数。我从直方图中删除了轴标记,因此它的左侧很干净,并且缩小了两个相交的图的边距。在plot_layout中,我正在缩放宽度,以使直方图在折线图的边缘出现得更多。密度图也可以这样做。

(p1 +
    theme(plot.margin = margin(r = 0, unit = "pt"))
) + 
  (p2_hist + 
     theme(axis.text.y = element_blank(), 
           axis.ticks.y = element_blank(),
           axis.title.y = element_blank(),
           plot.margin = margin(l = 0, unit = "pt"))
   ) + 
  plot_layout(nrow = 1, widths = c(1, 0.2))

reprex package(v0.2.1)于2019-01-28创建

答案 1 :(得分:2)

您可以尝试使用geom_histogramgeom_density,但这有点复杂,因为您必须旋转它们的轴(同时保持geom_line的原始方向)。我将使用geom_violin(这是一个密度图,但已镜像)。如果您只想获取一面小提琴图,则可以使用自定义geom_flat_violin geom。它最初由@David Robinson发布在他的gists上。

我在different answer中使用了此几何图形,但是我不认为它是重复的,因为您需要将其放置在绘图的末尾并与其他几何图形组合。

最终代码是:

library(ggplot2)
ggplot(data.frame(x = seq(100), y = rnorm(100))) +
    geom_flat_violin(aes(100, y), color = "red", fill = "red", alpha = 0.5, width = 10) +
    geom_line(aes(x, y))

enter image description here

geom_flat_violin代码:

library(dplyr)

"%||%" <- function(a, b) {
  if (!is.null(a)) a else b
}

geom_flat_violin <- function(mapping = NULL, data = NULL, stat = "ydensity",
                        position = "dodge", trim = TRUE, scale = "area",
                        show.legend = NA, inherit.aes = TRUE, ...) {
  layer(
    data = data,
    mapping = mapping,
    stat = stat,
    geom = GeomFlatViolin,
    position = position,
    show.legend = show.legend,
    inherit.aes = inherit.aes,
    params = list(
      trim = trim,
      scale = scale,
      ...
    )
  )
}


GeomFlatViolin <-
  ggproto(
    "GeomFlatViolin",
    Geom,
    setup_data = function(data, params) {
      data$width <- data$width %||%
        params$width %||% (resolution(data$x, FALSE) * 0.9)

      # ymin, ymax, xmin, and xmax define the bounding rectangle for each group
      data %>%
        dplyr::group_by(.data = ., group) %>%
        dplyr::mutate(
          .data = .,
          ymin = min(y),
          ymax = max(y),
          xmin = x,
          xmax = x + width / 2
        )
    },

    draw_group = function(data, panel_scales, coord)
    {
      # Find the points for the line to go all the way around
      data <- base::transform(data,
                              xminv = x,
                              xmaxv = x + violinwidth * (xmax - x))

      # Make sure it's sorted properly to draw the outline
      newdata <-
        base::rbind(
          dplyr::arrange(.data = base::transform(data, x = xminv), y),
          dplyr::arrange(.data = base::transform(data, x = xmaxv), -y)
        )

      # Close the polygon: set first and last point the same
      # Needed for coord_polar and such
      newdata <- rbind(newdata, newdata[1,])

      ggplot2:::ggname("geom_flat_violin",
                       GeomPolygon$draw_panel(newdata, panel_scales, coord))
    },

    draw_key = draw_key_polygon,

    default_aes = ggplot2::aes(
      weight = 1,
      colour = "grey20",
      fill = "white",
      size = 0.5,
      alpha = NA,
      linetype = "solid"
    ),

    required_aes = c("x", "y")
  )

答案 2 :(得分:2)

您可以使用egg::ggarrange()。所以基本上你想要的是这个

p <- ggplot(data=my_data, mapping=aes(x=x, y=y)) +
  geom_line() + ylim(c(-2, 2))
q <- ggplot(data=my_data, mapping=aes(x=y)) +
  geom_histogram(binwidth=.05) + coord_flip() + xlim(c(-2, 2))

egg::ggarrange(p, q, nrow=1)

结果

enter image description here

数据

set.seed(42)
my_data <- data.frame(x=seq(100), rnorm(100))

答案 3 :(得分:-3)

my_data1 <- count(my_data, vars=c("y"))
p1 <- ggplot(data = my_data, mapping = aes(x = x, y = y)) + geom_line()
p2 <- ggplot(my_data1,aes(x=freq,y=y))+geom_line()+theme(axis.title.y = element_blank(),axis.text.y = element_blank())
grid.draw(cbind(ggplotGrob(p1), ggplotGrob(p2), size = "last"))

enter image description here