R ggplot2：使用嵌套循环将多个geom_ribbon对象叠加在一个绘图中 [英] R ggplot2: overlaying multiple geom_ribbon objects in a single plot using a nested loop
问题描述
我有五条线图，我想从中输出一个阴影区域，代表它们绘制的上部和下部区域之间的区域。我创建了一个R脚本（见下文），因为我有多个数据集，需要重复这个练习。
然而，我只能打印geom_ribbon from the last i and j pair - 我似乎无法将每个geom_ribbon输出到创建的列表中。
感谢您提供关于如何导入所有geom_ribbon对象放入列表中。只有一个图是用 print（Z）（下面的例子）打印的。如果可能的话，我想要将所有geom_ribbon对象重叠并打印为单个ggplot？
Z < - list （）
allmaxi < - list（cahp_max_plot15cb $ decade_maxa，cahp_max_plot15cb $ decade_maxc，cahp_max_plot15cb $ decade_maxd，cahp_max_plot15cb $ decade_maxe，cahp_max_plot15cb $ decade_maxf）
allmaxj < - list（cahp_max_plot15cb $ decade_maxa，cahp_max_plot15cb $ decade_maxc， cahp_max_plot15cb $ decade_maxd，cahp_max_plot15cb $ decade_maxe，cahp_max_plot15cb $ decade_maxf）
for（i in allmaxi）{
for（j in allmaxj）{
l < - geom_ribbon（data = cahp_max_plot15cb，aes（x （b）（b）（b）（b）=（b）=十年，ymin = i，ymax = j））
Z [[length（Z）+ 1]] < -
print（i）
print b}
print（ggplot（）+ Z）
（从print（i）和print（j）以脚本形式）从输入一个数据集（decade_maxa）到i列表，并将其他四个数据集输入到j列表：
[1] 2010.811 1723.783 1961.088 1662.909 1587.191 1662.140 1665.415 1602.974 1807.453 1586.106
[11] 1580.880 1685.253 1653.178 1824.842
[1] 1390.260 1247.700 1263.578 1711.638 1228.326 1762.045 1260.147 1171.914 1697.987 1350.867
[11] 1434.525 1488.818 1610.513 1536.895
`
`[1] 2010.811 1723.783 1961.088 1662.909 1587.191 1662.140 1665.415 1602.974 1807.453 1586.106
[11] 1580.880 1685.253 1653.178 1824.842
`
`[1] 1120.2700 1094.3047 1196.8792 1227.9660 1236.9170 1266.0935 1127.1480 974.6948 947.3365
[10] 1244.3242 1254.2704 1082.3667 1286.9080 1126.1943
`
`[1] 2010.811 1723.783 1961.088 1662.909 1587.191 1662.140 1665.415 1602.974 1807.453 1586.106
[11] 1580.880 1685.253 1653.178 1824.842
`
`[1] 1396.695 1425.073 1382.941 1913.495 1401.754 1499.763 1600.656 1367.043 1413.390 1343.804
[11] 1431.790 1402.292 1329.192 1696.729
`
`[1] 2010.811 1723.783 1961.088 1662.909 1587.191 1662.140 1665.415 1602.974 1807.453 1586.106
[11] 1580.880 1685.253 1653.178 1824.842
`
`[1] 1718.874 1389.134 1501.574 1233.189 1262.480 1508.919 1291.467 1431.869 1505.102 1376.519
[11] 1441.181 1421.552 1326.547 1635.599
`
> print（ggplot（）+ Z）
`
这是我的目标。也许有更好的方法与lapply？
这是如下所提出的那样通过整合中间值来输出图像：
median_g < - group_by（cahp_max_plot15cbm，decade）
median_gm< - 变异（median_g，median = median（value））
p2 <-ggplot（median_gm）+ geom_ribbon（aes（x = decade，ymin = median，ymax = value，group = variable），alpha = 0.40， （aes（x = decade，y = value，group = variable，color = variable），lwd = 1）+
geom_point（aes（x = decade， y =中位数））
p2
以下是一个稍微过度设计的解决方案：查找所有细分市场交集，添加这些abscis
＃某段段交集代码
＃http://paulbourke.net/geometry/pointlineplane/
ssi< - 函数（x1，x2，x3，x4，y1，y2，y3，y4）{
denom < - （（y4-y3）*（x2-x1） - （x4-x3）*（y2-y1））
denom [abs（denom）< （（x4-x3）*（y1-y3） - （y4-y3）*（x1-x3））/ denom（1e-10）<-NA＃平行线
ua<
ub < - （（x2-x1）*（y1-y3） - （y2-y1）*（x1-x3））/ denom
x < - x1 + ua * （x2-x1）
y< -y1 + ua *（y2-y1）
inside< - （ua> = 0）& （ua< = 1）& （ub> = 0）& （ub <= 1）
data.frame（x = ifelse（inside，x，NA），
y = ifelse（inside，y，NA））
}
＃用两条多段线（xy dataframes）做
ssi_polyline < - 函数（l1，l2）{
n1 < - nrow（l1）
n2 < - nrow l2）
stopifnot（n1 == n2）
x1 < - l1 [-n1,1]; y1 < - l1 [-n1,2]
x2 < - l1 [-1L，1]; y2 < - l1 [-1L，2]
x3 < - l2 [-n2,1]; y3 < - l2 [-n2,2]
x4 < - l2 [-1L，1]; y4 < - l2 [-1L，2]
ssi（x1，x2，x3，x4，y1，y2，y3，y4）
}
＃测试上述
d1 <-cbind（seq（1,10），rnorm（10））
d2 <-cbind（seq（1,10），rnorm（10））
plot（rbind（d1， d2），t =n）
lines（d1）
lines（d2，col = 2）
points（ssi_polyline（d1，d2））
＃做一个矩阵的所有列（假设常见的xs）
＃一般情况下（不同的xs）可以被类似地处理
＃例如通过首先对所有唯一的xs进行线性插值
ssi_matrix < - 函数（x，m）{
＃成对组合
cn < - combn（ncol（m），2）
test_pair< - function（i）{
l1 < - cbind（x，m [，cn [1，i]]）
p2< ; - ssi_polyline（l1，l2）
pts [complete.cases（pts），]
}
ints< - lapply（seq_len（ncol（cn）），test_pair）
$ c $（
$ b）
＃在一个矩阵上测试它
m< - replicate（5，rnorm（10））
x< - seq_len（nrow（m））
matplot（x，m， t =l，lty = 1）
test < - ssi_matrix（x，m）
points（test）
＃现在，将其应用于手头的数据集
$ b库（ggplot2）
库（reshape2）
库（plyr）
set.seed（123）
数据< - data.frame（十进制= 1：10）
n = nrow（数据）
数据$ maxa < - runif（n，1000,2000）
数据$ maxb < - runif（n，1000,2000 ）
data $ maxc < - runif（n，1000,2000）
data $ maxd < - runif（n，1000,2000）
data $ maxe < - runif（n ，1000,2000）
newpoints< - setNames（data.frame（ssi_matrix（data $ decade，data [， - 1L]），
added），c（decade （data，id = 1L）
插值< - ddply（mdata，variable，function（d ）{
xy < - approx（d $ decade，d $ value，xout = newpoints [，1]）$ b $ b data.frame（decade = xy $ x，value = xy $ y，variable = 插值）
}）
全部< - rbind（mdata，interpolated，newpoints）
rib < - ddply（all，decade，总结一下，
ymin = min（value），ymax = max（value））
ggplot（mdata，aes（decade））+
geom_ribbon（data = rib，aes（x = decade，ymin = ymin，ymax = ymax），
alpha = 0.40，fill =＃3985ff）+
geom_line（aes（y = value，color = variable））
I have five line plots from which I'd like to output a shaded area that represents the region between their plotted upper and lower regions. I'm creating an R script (see below) as I have multiple datasets for which I need to repeat this exercise.
However, I'm only able to print the geom_ribbon from the last i and j pair - I can't seem to output every geom_ribbon into the created list.
I'd grateful for any ideas on how to import all of the geom_ribbon objects into the list. Only one plot is printed with print(Z)(example below). I'd like, if possible, all geom_ribbon objects to be overlain and printed as a single ggplot?
Z <- list()
allmaxi <- list(cahp_max_plot15cb$decade_maxa, cahp_max_plot15cb$decade_maxc,cahp_max_plot15cb$decade_maxd, cahp_max_plot15cb$decade_maxe, cahp_max_plot15cb$decade_maxf)
allmaxj <- list(cahp_max_plot15cb$decade_maxa, cahp_max_plot15cb$decade_maxc,cahp_max_plot15cb$decade_maxd, cahp_max_plot15cb$decade_maxe, cahp_max_plot15cb$decade_maxf)
for (i in allmaxi) {
for (j in allmaxj) {
l <- geom_ribbon(data=cahp_max_plot15cb,aes(x=decade,ymin=i, ymax=j))
Z[[length(Z) + 1]] <- l
print(i)
print(j)
}
}
print(ggplot() + Z)
Sample output (from print(i) and print(j) in script) from inputting one dataset (decade_maxa) to i list, and four other data sets to j list:
[1] 2010.811 1723.783 1961.088 1662.909 1587.191 1662.140 1665.415 1602.974 1807.453 1586.106
[11] 1580.880 1685.253 1653.178 1824.842
[1] 1390.260 1247.700 1263.578 1711.638 1228.326 1762.045 1260.147 1171.914 1697.987 1350.867
[11] 1434.525 1488.818 1610.513 1536.895
`
`[1] 2010.811 1723.783 1961.088 1662.909 1587.191 1662.140 1665.415 1602.974 1807.453 1586.106
[11] 1580.880 1685.253 1653.178 1824.842
`
`[1] 1120.2700 1094.3047 1196.8792 1227.9660 1236.9170 1266.0935 1127.1480 974.6948 947.3365
[10] 1244.3242 1254.2704 1082.3667 1286.9080 1126.1943
`
`[1] 2010.811 1723.783 1961.088 1662.909 1587.191 1662.140 1665.415 1602.974 1807.453 1586.106
[11] 1580.880 1685.253 1653.178 1824.842
`
`[1] 1396.695 1425.073 1382.941 1913.495 1401.754 1499.763 1600.656 1367.043 1413.390 1343.804
[11] 1431.790 1402.292 1329.192 1696.729
`
`[1] 2010.811 1723.783 1961.088 1662.909 1587.191 1662.140 1665.415 1602.974 1807.453 1586.106
[11] 1580.880 1685.253 1653.178 1824.842
`
`[1] 1718.874 1389.134 1501.574 1233.189 1262.480 1508.919 1291.467 1431.869 1505.102 1376.519
[11] 1441.181 1421.552 1326.547 1635.599
`
> print(ggplot() + Z)
`
This is my aim. Maybe there is a better way with lapply?
This is the image output by integrating median values, as proposed below:
median_g <- group_by(cahp_max_plot15cbm,decade)
median_gm <- mutate(median_g, median=median(value))
p2 <- ggplot(median_gm) + geom_ribbon(aes(x=decade, ymin=median,ymax=value,group=variable),alpha=0.40,fill="#3985ff") +
geom_line(aes(x=decade,y=value,group=variable,color=variable),lwd=1) +
geom_point(aes(x=decade,y=median))
p2
Here's a slightly over-engineered solution: find all segment-segment intersections, add those abscissae to the mix, and for each x locate the min and max values.
# some segment-segment intersection code
# http://paulbourke.net/geometry/pointlineplane/
ssi <- function(x1, x2, x3, x4, y1, y2, y3, y4){
denom <- ((y4 - y3)*(x2 - x1) - (x4 - x3)*(y2 - y1))
denom[abs(denom) < 1e-10] <- NA # parallel lines
ua <- ((x4 - x3)*(y1 - y3) - (y4 - y3)*(x1 - x3)) / denom
ub <- ((x2 - x1)*(y1 - y3) - (y2 - y1)*(x1 - x3)) / denom
x <- x1 + ua * (x2 - x1)
y <- y1 + ua * (y2 - y1)
inside <- (ua >= 0) & (ua <= 1) & (ub >= 0) & (ub <= 1)
data.frame(x = ifelse(inside, x, NA),
y = ifelse(inside, y, NA))
}
# do it with two polylines (xy dataframes)
ssi_polyline <- function(l1, l2){
n1 <- nrow(l1)
n2 <- nrow(l2)
stopifnot(n1==n2)
x1 <- l1[-n1,1] ; y1 <- l1[-n1,2]
x2 <- l1[-1L,1] ; y2 <- l1[-1L,2]
x3 <- l2[-n2,1] ; y3 <- l2[-n2,2]
x4 <- l2[-1L,1] ; y4 <- l2[-1L,2]
ssi(x1, x2, x3, x4, y1, y2, y3, y4)
}
# testing the above
d1 <- cbind(seq(1, 10), rnorm(10))
d2 <- cbind(seq(1, 10), rnorm(10))
plot(rbind(d1, d2), t="n")
lines(d1)
lines(d2, col=2)
points(ssi_polyline(d1, d2))
# do it with all columns of a matrix (common xs assumed)
# the general case (different xs) could be treated similarly
# e.g by doing first a linear interpolation at all unique xs
ssi_matrix <- function(x, m){
# pairwise combinations
cn <- combn(ncol(m), 2)
test_pair <- function(i){
l1 <- cbind(x, m[,cn[1,i]])
l2 <- cbind(x, m[,cn[2,i]])
pts <- ssi_polyline(l1, l2)
pts[complete.cases(pts),]
}
ints <- lapply(seq_len(ncol(cn)), test_pair)
do.call(rbind, ints)
}
# testing this on a matrix
m <- replicate(5, rnorm(10))
x <- seq_len(nrow(m))
matplot(x, m, t="l", lty=1)
test <- ssi_matrix(x, m)
points(test)
# now, apply this to the dataset at hand
library(ggplot2)
library(reshape2)
library(plyr)
set.seed(123)
data <- data.frame(decade=1:10)
n=nrow(data)
data$maxa <- runif(n,1000,2000)
data$maxb <- runif(n,1000,2000)
data$maxc <- runif(n,1000,2000)
data$maxd <- runif(n,1000,2000)
data$maxe <- runif(n,1000,2000)
newpoints <- setNames(data.frame(ssi_matrix(data$decade, data[,-1L]),
"added"), c("decade", "value", "variable"))
mdata <- melt(data, id=1L)
interpolated <- ddply(mdata, "variable", function(d){
xy <- approx(d$decade, d$value, xout=newpoints[,1])
data.frame(decade = xy$x, value=xy$y, variable = "interpolated")
})
all <- rbind(mdata, interpolated, newpoints)
rib <- ddply(all, "decade", summarise,
ymin=min(value), ymax=max(value))
ggplot(mdata, aes(decade)) +
geom_ribbon(data = rib, aes(x=decade, ymin=ymin, ymax=ymax),
alpha=0.40,fill="#3985ff")+
geom_line(aes(y=value, colour=variable))
这篇关于R ggplot2：使用嵌套循环将多个geom_ribbon对象叠加在一个绘图中的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
