R语言 ggplot2根据数据分割颜色直方图:刻面栅格

s3fp2yjn  于 2023-03-20  发布在  其他
关注(0)|答案(2)|浏览(174)

基于this question构建:
有没有一种方法可以创建一个直方图网格,其中的柱在任意值之上和之下的颜色不同(没有重叠的柱),而不需要参考ggplot()之外的环境?我可以用一个直方图来实现这一点,如下所示(使用中值作为说明):

set.seed(123)

value = stats::rnorm(100, mean = 0, sd = 1)

df = data.frame(value)

df %>%
  {
    ggplot(data = ., aes(x = value, fill = ifelse(value > median(value), "0", "1"))) +
      geom_histogram(boundary = median(.$value), alpha = 0.5, position = "identity") +
      theme(legend.position = "none")
  }

根据分组变量,每个图使用不同的值,这可以对多面图进行吗?例如,这不起作用:

set.seed(456)

value = stats::rnorm(200, mean = 0, sd = 1)
group = c(rep(1,100), rep(2,100))
    
df = data.frame(value, group)

df %>%
  dplyr::mutate(value = ifelse(group == 2, value + 1, value)) %>%
  dplyr::group_by(group) %>%
  dplyr::mutate(above_median = value > median(value)) %>%
  {
    ggplot(data = ., aes(x = value, fill = above_median)) +
      facet_grid(rows = group) +
      geom_histogram(boundary = median(.$value), alpha = 0.5, position = "identity") +
      theme(legend.position = "none")
  }

f87krz0w

f87krz0w1#

一种选择是使用多个geom_histogram图层添加直方图,即按组拆分数据,然后使用lapply为每个组添加一个geom_histogram

library(dplyr, warn=FALSE)
library(ggplot2)

df %>%
  dplyr::mutate(value = ifelse(group == 2, value + 1, value)) %>%
  dplyr::group_by(group) %>%
  dplyr::mutate(above_median = value > median(value)) %>%
  {
    ggplot(data = ., aes(x = value, fill = above_median)) +
      facet_grid(rows = vars(group)) +
      lapply(split(., .$group), function(x) {
        geom_histogram(data = x, boundary = median(x$value), alpha = 0.5, position = "identity")
      }) +
      theme(legend.position = "none")
  }
#> `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
#> `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

yi0zb3m4

yi0zb3m42#

这就是我解决这个问题的方法,但是@stefan的答案更好(+1),

library(tidyverse)

set.seed(456)

value = stats::rnorm(200, mean = 0, sd = 1)
group = c(rep(1,100), rep(2,100))

df = data.frame(value, group)

df %>%
  dplyr::mutate(value = ifelse(group == 2, value + 1, value)) %>%
  dplyr::group_by(group) %>%
  dplyr::mutate(above_median = value > median(value)) %>%
  ungroup() %>%
  group_split(group) %>%
  map(~{
    ggplot(data = .x, aes(x = value, fill = above_median)) +
      facet_grid(rows = .x$group) +
      geom_histogram(boundary = median(.x$value), alpha = 0.5, position = "identity") +
      theme(legend.position = "none")
  })
#> [[1]]
#> `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

#> 
#> [[2]]
#> `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

创建于2023年3月16日,使用reprex v2.0.2

相关问题