plot(ggplot?)2条曲线之间的平滑+颜色区域

时间:2018-05-26 16:20:52

标签: r plot ggplot2

我有一个问题请你:

我的数据:

    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”之间的表面是黄色,“数据$ inf60“和”数据$ 60“是橙色等。我想叠加这些彩色表面+请把好的传说。

感谢您的帮助!

2 个答案:

答案 0 :(得分:7)

很酷的问题,因为我必须给自己一个使用LOESS用于色带的速成课程!

我正在做的第一件事就是将数据变成一个长形状,因为这是ggplot所期望的,并且因为您的数据具有一些隐藏在值内的特征。例如,如果您将gather变成一个长形状,并且有一个列key,其值为“inf20”而另一个为“sup20”,那么这些信息比您当前拥有的信息更多。 ,即度量类型为“inf”或“sup”,级别为20.您可以从该列中提取该信息,以获取度量类型(“inf”或“sup”)和级别(20, 40,60或90),然后将美学映射到那些变量上。

所以我在这里得到的数据很长,然后使用spread制作infsup的列,因为这些列会变成ymin和{ {1}}为丝带。我把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() 预测了infsupNb_obst的平滑值。 loessgroup_by会生成一个嵌套数据框,do会将其拉回到可行的形式。您可以随意调整unnest参数以及我对此知之甚少的其他span参数。

loess.control

reprex package(v0.2.0)创建于2018-05-26。

答案 1 :(得分:1)

使用基本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"))

enter image description here

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")

enter image description here

数据。

我将重做您的数据集,简化其创建。您不需要as.vector,如果您要创建data.frame,则不需要使用data.frame cbind方法,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)