我可以使用stat_density_ridges为不同的组使用不同的截断点吗?

uemypmqf  于 2023-04-03  发布在  其他
关注(0)|答案(1)|浏览(129)

我有一个数据框,其中包含不同的组(“label”列)。对于每个标签,我想绘制一个从bootstrapping获得的null分布(值在“null”列中),并在顶部绘制真实的统计量(值在“sc”列中)。理想情况下,我希望统计量后面的区域具有不同的颜色,以标记这是我的p值。这是否可以用stat_density_ridges来完成?
下面是一个R代码示例:

library(ggplot2)
library(tidyverse)
library(ggridges)

df <- data.frame()

for (label in LETTERS) {
  mean=rnorm(1,0.5,0.2)
  null = rnorm(1000,mean,0.1);
  sc = rnorm(1,0.5,0.2)
  df <- rbind(df, data.frame(label=label, null=null, sc=sc))
}

df <- df %>% 
  mutate(label=as.factor(label))

ggplot(df, aes(x = null, y = label))  +
  stat_density_ridges(scale=1.2,alpha = 1, size=1)+
  scale_x_continuous(limits=c(0,1),breaks=seq(0,1,0.2)) +
  geom_segment(aes(x=sc, xend=sc, y=as.numeric(label)-0.1, yend=as.numeric(label)+0.5), size=1) +
  coord_flip()

结果图如下:

但理想情况下,我希望每个脊更像这样:

随着sc值后颜色的变化。这是可能的吗?谢谢:)

6l7fqoea

6l7fqoea1#

您可以使用fill..x..在图的固定x值处创建不同的颜色。因此阴影区域在所有图中都是相同的。您可以通过使用ggplot_build和一个单独的 Dataframe 来修改这一点,该 Dataframe 具有作为阈值的p_values。因此,使用这些阈值,您可以有条件地更改图层中的color。下面是一些可复制的代码:

library(ggplot2)
library(tidyverse)
library(ggridges)

df <- data.frame()

set.seed(7) # for reproducibility
for (label in LETTERS) {
  mean=rnorm(1,0.5,0.2)
  null = rnorm(1000,mean,0.1);
  sc = rnorm(1,0.5,0.2)
  df <- rbind(df, data.frame(label=label, null=null, sc=sc))
}

df <- df %>% 
  mutate(label=as.factor(label))
# Create dataframe with p_values ranges per label
p_values = df %>% 
  group_by(label) %>% 
  summarise(p_value = unique(sc)) %>%
  mutate(label = as.integer(label)) # make sure label is the same as in ggplot_build

# plot
p <- ggplot(df, aes(x = null, y = label, fill = ifelse(..x.. < sc, "no sign", "sign"), group = factor(label)))  +
  stat_density_ridges(geom = "density_ridges_gradient",,
                      scale=1.2,alpha = 1, size=1,
                      calc_ecdf = TRUE) +
  scale_fill_manual(values = c("red", "blue"), name = "") +
  coord_flip()
p
#> Picking joint bandwidth of 0.0224

# Modify layer
q <- ggplot_build(p)
#> Picking joint bandwidth of 0.0224
q$data[[1]] = q$data[[1]] %>%
  left_join(., p_values,
            by = c("group" = "label")) %>%
  mutate(fill = case_when(x < p_value ~ fill,
                          TRUE ~ "blue")) %>%
  select(-p_value)
q <- ggplot_gtable(q)
plot(q)

创建于2023-03-28带有reprex v2.0.2
正如你在最新的图中看到的,阴影区域现在是根据每组 Dataframe 的sc值。

相关问题