平滑曲线图和颜色区域在两条曲线之间（使用ggplot？）

Question

I have a question for you please :

My data :

    Nb_obs <- as.vector(c( 2,  0,  6,  2,  7,  1,  8,  0,  2,  1,  1,  3, 11,  5,  9,  6,  4,  0,  7,  9))
    Nb_obst <- as.vector(c(31, 35, 35, 35, 39, 39, 39, 39, 39, 41, 41, 42, 43, 43, 45, 45, 47, 48, 51, 51))
    inf20 <- as.vector(c(2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 3, 3, 3, 4, 3, 4, 4, 3, 5, 4))
    sup20 <- as.vector(c(3, 4, 4, 4, 5, 4, 4, 5, 4, 4, 5, 5, 5, 6, 5, 6, 6, 5, 7, 6))
    inf40 <- as.vector(c(1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 3, 2, 3, 3, 3, 4, 3))
    sup40 <- as.vector(c(4, 5, 5, 5, 6, 5, 5, 6, 5, 5, 6, 6, 6, 7, 6, 7, 7, 7, 9, 7))
    inf60 <- as.vector(c(1, 1, 1, 1, 2, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 3, 2))
    sup60 <- as.vector(c(5, 6, 6,  6,  8,  7,  7,  7,  7,  7,  7,  7,  8,  9,  8,  9,  9,  9, 11,  9))
    inf90 <- as.vector(c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 1, 0, 1, 1))
    sup90 <- as.vector(c(10, 11, 11, 11, 15, 13, 13, 14, 12, 13, 13, 13, 14, 17, 15, 17, 17, 16, 21, 18))

data <- cbind.data.frame(Nb_obs, Nb_obst, inf20, sup20, inf40, sup40, inf60 , sup60, inf90 , sup90)

我的任务：

plot(data$Nb_obst, data$Nb_obs, type = "n",  xlab = "Number obst", ylab = "number obs", ylim = c(0, 25))

lines(data$Nb_obst, data$inf20, col = "dark red")
lines(data$Nb_obst, data$sup20, col = "dark red")

lines(data$Nb_obst, data$inf40, col = "red")
lines(data$Nb_obst, data$sup40, col = "red")

lines(data$Nb_obst, data$inf60, col = "dark orange")
lines(data$Nb_obst, data$sup60, col = "dark orange")

lines(data$Nb_obst, data$inf90, col = "yellow")
lines(data$Nb_obst, data$sup90, col = "yellow")

我的问题：

我想做两件事情(我认为可以通过ggplot来实现):

在顶部图表的概念中，“inf”和“sup”是IC 20%、40%、60%和90%模型的限制。我希望先使每条曲线平滑，然后将同一个IC的两条曲线之间的表面着色，例如将“data$inf90”和“data$sup90”的表面着成黄色，“data$inf60”和“data$60”的区域是橙色等。并且我想要叠加每个有色表面 +请放置好合适的图例。

感谢您的帮助！

- thomas leon

---

请注意，as.vector(c(...))和c(...)是identical()的。 - Rui Barradas

Answer 1

很酷的问题，因为我不得不给自己一个使用LOESS制作带状图的速成课程！

首先要做的是将数据转换为长格式，因为这是ggplot所期望的，并且由于您的数据具有某些隐藏在值中的特征。例如，如果您将数据转换为长格式，并且有一个名为“key”的列，其中一个值为“inf20”，另一个值为“sup20”，则它们包含比您当前可以访问的更多信息，即测量类型为“inf”或“sup”，级别为20。您可以从该列中提取出该信息以获取测量类型（“inf”或“sup”）和级别（20、40、60或90）的列，然后将美学映射到这些变量上。

在这里，我将数据转换成长格式，然后使用spread将inf和sup制作成列，因为它们将成为襟带的ymin和ymax。我将level设为一个因子并反转其级别，因为我想改变绘制襟带的顺序，使较窄的襟带最后出现并位于顶部。

library(tidyverse)

data_long <- data %>%
  as_tibble() %>%
  gather(key = key, value = value, -Nb_obs, -Nb_obst) %>%
  mutate(measure = str_extract(key, "\\D+")) %>%
  mutate(level = str_extract(key, "\\d+")) %>%
  select(-key) %>%
  group_by(level, measure) %>%
  mutate(row = row_number()) %>%
  spread(key = measure, value = value) %>%
  ungroup() %>%
  mutate(level = as.factor(level) %>% fct_rev())

head(data_long)
#> # A tibble: 6 x 6
#>   Nb_obs Nb_obst level   row   inf   sup
#>    <dbl>   <dbl> <fct> <int> <dbl> <dbl>
#> 1      0      35 20        2     2     4
#> 2      0      35 40        2     2     5
#> 3      0      35 60        2     1     6
#> 4      0      35 90        2     0    11
#> 5      0      39 20        8     3     5
#> 6      0      39 40        8     2     6

ggplot(data_long, aes(x = Nb_obst, ymin = inf, ymax = sup, fill = level)) +
  geom_ribbon(alpha = 0.6) +
  scale_fill_manual(values = c("20" = "darkred", "40" = "red", 
      "60" = "darkorange", "90" = "yellow")) +
  theme_light()

但是它仍然存在锯齿问题，因此对于每个级别，我使用loess预测了inf和sup的平滑值与Nb_obst。 group_by 和 do生成了一个嵌套的数据框架，而unnest将其拉回到可操作的形式。请随意调整span参数，以及其他我不太了解的loess.control参数。

data_smooth <- data_long %>%
  group_by(level) %>%
  do(Nb_obst = .$Nb_obst,
     inf_smooth = predict(loess(.$inf ~ .$Nb_obst, span = 0.35), .$Nb_obst), 
     sup_smooth = predict(loess(.$sup ~ .$Nb_obst, span = 0.35), .$Nb_obst)) %>%
  unnest() 

head(data_smooth)
#> # A tibble: 6 x 4
#>   level Nb_obst inf_smooth sup_smooth
#>   <fct>   <dbl>      <dbl>      <dbl>
#> 1 90         35      0           11. 
#> 2 90         39      0           13.4
#> 3 90         48      0.526       16.7
#> 4 90         39      0           13.4
#> 5 90         41      0           13  
#> 6 90         41      0           13

ggplot(data_smooth, aes(x = Nb_obst, ymin = inf_smooth, ymax = sup_smooth, fill = level)) +
  geom_ribbon(alpha = 0.6) +
  scale_fill_manual(values = c("20" = "darkred", "40" = "red", 
      "60" = "darkorange", "90" = "yellow")) +
  theme_light()

这段文字是由reprex package（v0.2.0）在2018年5月26日创建的。

- camille

---

哦哦哦，看起来就是我想要的！谢谢。现在我得理解这段代码的微妙之处 :) - thomas leon

很好，如果你需要我进一步分解步骤，请告诉我。通常当我试图理清大量整理代码时，我会逐个运行其中的部分，并逐步添加回一个管道语句，直到我可以追踪所有正在进行的操作。 - camille

好的，谢谢！这是我的第一种情况下区域1的图表。我还需要做5个图表，并检查它们的全部样子。 - thomas leon

所以，如果您需要制作多个类似的图形，您可能希望将它们分面，并将其他变量输入到loess的“group_by”中。 - camille

是的，我有一个数据集，其中有1个案例。我不太擅长使用ggplot，我原以为我在使用 par(mfrow = c(3,2))。 - thomas leon

par 函数只适用于基本的 R，但在 ggplot 中等效的是设置 facet_wrap 或 facet_grid，取决于您需要拆分的变量数量。 - camille

Answer 2

这将使用基础R图形生成带有阴影区域的图表。
技巧在于将x值与y值配对。

plot(data$Nb_obst, data$Nb_obs, type = "n",  xlab = "Number obst", ylab = "number obs", ylim = c(0, 25))

lines(data$Nb_obst, data$inf20, col = "dark red")
lines(data$Nb_obst, data$sup20, col = "dark red")

lines(data$Nb_obst, data$inf40, col = "red")
lines(data$Nb_obst, data$sup40, col = "red")

lines(data$Nb_obst, data$inf60, col = "dark orange")
lines(data$Nb_obst, data$sup60, col = "dark orange")

lines(data$Nb_obst, data$inf90, col = "yellow")
lines(data$Nb_obst, data$sup90, col = "yellow")

with(data, polygon(c(Nb_obst, rev(Nb_obst)), c(inf90, rev(sup90)), col = "yellow"))
with(data, polygon(c(Nb_obst, rev(Nb_obst)), c(inf60, rev(sup60)), col = "dark orange"))
with(data, polygon(c(Nb_obst, rev(Nb_obst)), c(inf40, rev(sup40)), col = "red"))
with(data, polygon(c(Nb_obst, rev(Nb_obst)), c(inf20, rev(sup20)), col = "dark red"))

ggplot图表的代码有点长。有一个函数geom_ribbon非常适合这个。

g <- ggplot(data)
g + geom_ribbon(aes(x = Nb_obst, ymin = sup60, ymax = sup90), fill = "yellow") + 
    geom_ribbon(aes(x = Nb_obst, ymin = sup40, ymax = sup60), fill = "dark orange") + 
    geom_ribbon(aes(x = Nb_obst, ymin = sup20, ymax = sup40), fill = "red") + 
    geom_ribbon(aes(x = Nb_obst, ymin = inf20, ymax = sup20), fill = "dark red") + 
    geom_ribbon(aes(x = Nb_obst, ymin = inf40, ymax = inf20), fill = "red") + 
    geom_ribbon(aes(x = Nb_obst, ymin = inf60, ymax = inf40), fill = "dark orange") + 
    geom_ribbon(aes(x = Nb_obst, ymin = inf90, ymax = inf60), fill = "yellow")

数据。

我将重新设计您的数据集，简化其创建。您不需要使用 as.vector，如果您正在创建一个 data.frame，则无需使用 cbind 的 data.frame 方法，只需使用 data.frame(.) 即可。

Nb_obs <- c( 2,  0,  6,  2,  7,  1,  8,  0,  2,  1,  1,  3, 11,  5,  9,  6,  4,  0,  7,  9)
Nb_obst <- c(31, 35, 35, 35, 39, 39, 39, 39, 39, 41, 41, 42, 43, 43, 45, 45, 47, 48, 51, 51)
inf20 <- c(2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 3, 3, 3, 4, 3, 4, 4, 3, 5, 4)
sup20 <- c(3, 4, 4, 4, 5, 4, 4, 5, 4, 4, 5, 5, 5, 6, 5, 6, 6, 5, 7, 6)
inf40 <- c(1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 3, 2, 3, 3, 3, 4, 3)
sup40 <- c(4, 5, 5, 5, 6, 5, 5, 6, 5, 5, 6, 6, 6, 7, 6, 7, 7, 7, 9, 7)
inf60 <- c(1, 1, 1, 1, 2, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 3, 2)
sup60 <- c(5, 6, 6,  6,  8,  7,  7,  7,  7,  7,  7,  7,  8,  9,  8,  9,  9,  9, 11,  9)
inf90 <- c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 1, 0, 1, 1)
sup90 <- c(10, 11, 11, 11, 15, 13, 13, 14, 12, 13, 13, 13, 14, 17, 15, 17, 17, 16, 21, 18)

data <- data.frame(Nb_obs, Nb_obst, inf20, sup20, inf40, sup40, inf60 , sup60, inf90 , sup90)

- Rui Barradas

---

非常感谢！我们可以使用plot()和lines()函数来“平滑”每条线，还是需要使用其他函数，比如ggplot函数？ - thomas leon

@thomasleon 为了使线条平滑，您需要平滑数据，例如使用 loess(Nb_obst, sup90) 的输出或其他平滑函数的输出。 - Rui Barradas