使用 ggplot 固定填充密度图的不同部分

Question

给定来自rnorm, 和截止值的绘制c，我希望我的绘图使用以下颜色：

1. 红色表示左侧的部分-c
2. -c蓝色表示和之间的部分c
3. 绿色代表右侧的部分c

例如，如果我的数据是：

set.seed(9782)
mydata <- rnorm(1000, 0, 2)
c <- 1

我想绘制这样的东西：

但如果我的数据全部位于右侧，则c整个图应该是绿色的。同样，如果全部位于-c和 之间c或左侧，则-c绘图应全部为红色或蓝色。

这是我写的代码：

MinD <- min(mydata)
MaxD <- max(mydata)

df.plot <- data.frame(density = mydata)

if(c==0){
  case <- dplyr::case_when((MinD < 0 & MaxD >0) ~ "L_and_R",
                           (MinD > 0) ~ "R",
                           (MaxD < 0) ~ "L")
}else{
  case <- dplyr::case_when((MinD < -c & MaxD >c) ~ "ALL",
                           (MinD > -c & MaxD > c) ~ "Center_and_R",
                           (MinD > -c & MaxD <c) ~ "Center",
                           (MinD < -c & MaxD < c) ~ "Center_and_L",
                           MaxD < -c ~ "L",
                           MaxD > c ~ "R")
}

# Draw the Center

if(case %in% c("ALL", "Center_and_R", "Center", "Center_and_L")){
  ds <- density(df.plot$density, from = -c, to = c)
  ds_data_Center <- data.frame(x = ds$x, y = ds$y, section="Center")
} else{
  ds_data_Center <- data.frame(x = NA, y = NA, section="Center")
}

# Draw L

if(case %in% c("ALL", "Center_and_L", "L", "L_and_R")){
  ds <- density(df.plot$density, from = MinD, to = -c)
  ds_data_L <- data.frame(x = ds$x, y = ds$y, section="L")
} else{
  ds_data_L <- data.frame(x = NA, y = NA, section="L")
}

# Draw R

if(case %in% c("ALL", "Center_and_R", "R", "L_and_R")){
  ds <- density(df.plot$density, from = c, to = MaxD)
  ds_data_R <- data.frame(x = ds$x, y = ds$y, section="R")
} else{
  ds_data_R <- data.frame(x = NA, y = NA, section="R")
}

L_Pr <- round(mean(mydata < -c),2)
Center_Pr <- round(mean((mydata>-c & mydata<c)),2)
R_Pr <- round(mean(mydata > c),2)

filldf <- data.frame(section = c("L", "Center", "R"), 
                     Pr = c(L_Pr, Center_Pr, R_Pr), 
                     fill = c("red", "blue", "green")) %>% 
  dplyr::mutate(section = as.character(section))


if(c==0){
  ds_data <- suppressWarnings(dplyr::bind_rows(ds_data_L, ds_data_R)) %>% 
    dplyr::full_join(filldf, by = "section") %>% filter(Pr!=0) %>% 
    dplyr::full_join(filldf, by = "section") %>% mutate(section = ordered(section, levels=c("L","R"))) 
  ds_data <- ds_data[order(ds_data$section), ] %>%  
    filter(Pr!=0) %>% 
    mutate(Pr=scales::percent(Pr))
}else{
  ds_data <- suppressWarnings(dplyr::bind_rows(ds_data_Center, ds_data_L, ds_data_R)) %>% 
    dplyr::full_join(filldf, by = "section") %>% mutate(section = ordered(section, levels=c("L","Center","R"))) 
  ds_data <- ds_data[order(ds_data$section), ] %>%  
    filter(Pr!=0) %>% 
    mutate(Pr=scales::percent(Pr))
}

fillScale <- scale_fill_manual(name = paste0("c = ", c, ":"),
                               values = as.character(unique(ds_data$fill)))

p <- ggplot(data = ds_data, aes(x=x, y=y, fill=Pr)) + 
  geom_area() + fillScale 

唉，我无法弄清楚如何将颜色分配给不同的部分，同时保留百分比作为颜色的标签。

Answer 1

我们使用该density函数来创建我们将实际绘制的数据框。然后，我们使用该cut函数使用数据值的范围来创建组。最后，我们计算每个组的概率质量并将其用作实际的图例标签。

我们还创建一个带标签的颜色向量，以确保相同的颜色始终与给定的 x 值范围相匹配，无论数据是否包含给定的 x 值范围内的任何值。

下面的代码将所有这些打包到一个函数中。

library(tidyverse)
library(gridExtra)

fill_density = function(x, cc=1, adj=1, drop_levs=FALSE) {

  # Calculate density values for input data
  dens = data.frame(density(x, n=2^10, adjust=adj)[c("x","y")]) %>% 
    mutate(section = cut(x, breaks=c(-Inf, -1, cc, Inf))) %>% 
    group_by(section) %>% 
    mutate(prob = paste0(round(sum(y)*mean(diff(x))*100),"%"))

  # Get probability mass for each level of section
  # We'll use these as the label values in scale_fill_manual
  sp = dens %>% 
    group_by(section, prob) %>% 
    summarise %>% 
    ungroup

  if(!drop_levs) {
   sp = sp %>% complete(section, fill=list(prob="0%"))
  }

  # Assign colors to each level of section
  col = setNames(c("red","blue","green"), levels(dens$section))

  ggplot(dens, aes(x, y, fill=section)) +
    geom_area() +
    scale_fill_manual(labels=sp$prob, values=col, drop=drop_levs) +
    labs(fill="")
}

现在让我们在几个不同的数据分布上运行该函数：

set.seed(3)
dat2 = rnorm(1000)
grid.arrange(fill_density(mydata), fill_density(mydata[mydata>0]),
             fill_density(mydata[mydata>2], drop_levs=TRUE), 
              fill_density(mydata[mydata>2], drop_levs=FALSE),
             fill_density(mydata[mydata < -5 | mydata > 5], adj=0.3), fill_density(dat2),
             ncol=2)