以R为单位的阴影置信区间-如有可能，以R为基数
我正在比较两条用黄土退化的线。我想清楚地显示这两条线的置信区间，我遇到了一些困难 我尝试过使用各种线条类型和颜色，但在我看来，结果仍然很繁忙和混乱。我认为置信区间之间的阴影可能会使事情变得更清楚，但考虑到目前为止我的编码是如何构造的，我在思考这个问题时遇到了一些困难。我已经包括了生成的绘图、两组Analysis5k和Analysis5kz的数据，以及到目前为止我的代码 我见过一些例子，其中两个多边形重叠，以显示置信区间重叠的位置，这似乎是表示数据的好方法。如果有一种方法可以在两个置信区间共享的区域中绘制多边形，那么这可能是表示数据的另一种好方法 我理解多边形应该如何处理的基本概念，但我发现的示例已应用于更简单的线和数据。到目前为止，这部分是我自己对一些糟糕的组织的过错，但由于这一步基本上是我数据展示的最后一步，我真的不想从头开始重做每件事 非常感谢您的帮助或见解 更新 我更新了标题。我收到了一些使用ggplot的很好的例子，虽然我想在将来使用ggplot，但到目前为止，我只讨论了base R。对于这个特殊的项目，如果可能的话，我想尽量保持在R的基础上 分析5K以R为单位的阴影置信区间-如有可能，以R为基数,r,statistics,polygon,confidence-interval,loess,R,Statistics,Polygon,Confidence Interval,Loess,我正在比较两条用黄土退化的线。我想清楚地显示这两条线的置信区间，我遇到了一些困难 我尝试过使用各种线条类型和颜色，但在我看来，结果仍然很繁忙和混乱。我认为置信区间之间的阴影可能会使事情变得更清楚，但考虑到目前为止我的编码是如何构造的，我在思考这个问题时遇到了一些困难。我已经包括了生成的绘图、两组Analysis5k和Analysis5kz的数据，以及到目前为止我的代码 我见过一些例子，其中两个多边形重叠，以显示置信区间重叠的位置，这似乎是表示数据的好方法。如果有一种方法可以在两个置信区间共享的区
Period 15p5 Total_5plus
-4350 0.100529101 12.6
-3900 0.4 20
-3650 0.0625 9.6
-3900 0.126984127 16.8
-3958 0.133333333 5
-4350 0.150943396 10.6
-3400 0.146341463 8.2
-3650 0.255319149 9.4
-3400 0.222222222 9
-3500 0.245014245 39
-3600 0.125 8
-3808 0.1 20
-3900 0.160493827 18
-3958 0.238095238 7
-4058 0.2 5
-3500 0.086956522 28.75
-4117 0.141414141 6.6
-4350 0.171038825 31.76666667
-4350 0.166666667 6
-3650 0.143798024 30.36666667
-2715 0.137931034 7.25
-4350 0.235588972 26.6
-3500 0.228840125 79.75
-4350 0.041666667 8
-3650 0.174757282 20.6
-2715 0.377777778 11.25
-3500 0.2 7.5
-3650 0.078947368 7.6
-3400 0.208333333 24
-4233 0.184027778 19.2
-3650 0.285714286 12.6
-4350 0.166666667 6
Period 15p5 Total_5plus
-4350 0.100529101 12.6
-4350 0 5
-3900 0.4 20
-3650 0.0625 9.6
-3400 0 6
-3900 0.126984127 16.8
-3958 0.133333333 5
-4350 0.150943396 10.6
-3400 0.146341463 8.2
-3650 0.255319149 9.4
-3400 0.222222222 9
-3500 0.245014245 39
-3600 0.125 8
-3650 0 28
-3808 0.1 20
-3900 0.160493827 18
-3958 0.238095238 7
-4058 0.2 5
-3500 0 25
-3500 0.086956522 28.75
-4117 0.141414141 6.6
-4350 0.171038825 31.76666667
-4350 0.166666667 6
-3650 0.143798024 30.36666667
-2715 0.137931034 7.25
-4350 0.235588972 26.6
-3500 0.228840125 79.75
-4350 0.041666667 8
-3500 0 5
-3650 0.174757282 20.6
-3800 0 9
-2715 0.377777778 11.25
-3500 0.2 7.5
-3650 0.078947368 7.6
-4117 0 8
-4350 0 8
-3400 0.208333333 24
-4233 0.184027778 19.2
-3025 0 7
-3650 0.285714286 12.6
-4350 0.166666667 6
ppi这里有一种使用ggplot的方法：
（1） 将黄土平滑应用于两个data.Set
library(dplyr)
df.lo <- lapply(datlist, function(x)loess(X15p5 ~ Period, data=x, weights = Total_5plus, span = 0.6))
（5） 添加数据点和基线：
dat <- do.call(rbind, datlist)
p +
geom_point(data=dat, aes(y=X15p5, shape=as.factor(group)), alpha=.2) +
geom_hline(yintercept=0.173, linetype="dotted") +
geom_vline(xintercept=c(-4700, -4000, -3000), linetype="dotted") +
ylab("X15p5") +
theme_bw()
我会提出一个整洁的解决方案。在这种方法中，您首先创建一个函数，该函数将计算并提取所需的统计信息。然后创建一个列表列，其中包含nest
，map
该列表上的函数，以及unest
结果
有关此方法的更多信息，请访问
库（tidyverse）
#创建函数以检索fit和se
pred_fun%
unnest（数据、preds）
#绘图结果
ggplot（嵌套，aes（周期，`15p5`））+
geom_色带（aes（ymin=fit-1.96*se，ymax=fit+1.96*se，fill=origin），
α=.2）+
几何点（）+
几何线（aes（y=拟合，颜色=原点））+
缩放y连续（展开=c（.3，0））+
缩放x连续（扩展=c（.3，0），打断=缩放：：漂亮的打断（6））+
主题_bw（）+
主题（legend.position=“底部”）+
实验室（x=”年份B.P.”，y=表达式（''[15]*'P'[5]））
当然，您可以编辑组的颜色，例如：
cols这是一个基于代码的底图解决方案
多边形
的诀窍在于必须在一个向量中提供2倍的x坐标，一次按正常顺序，一次按相反顺序（使用函数rev
），并且必须提供y坐标作为上界向量，然后按相反顺序提供下界
我们使用adjustcolor
功能使标准颜色透明
library(Hmisc)
ppi <- 300
par(mfrow = c(1,1), pty = "s", oma=c(1,2,1,1), mar=c(4,4,2,2))
plot(X15p5 ~ Period, Analysis5kz, xaxt = "n", yaxt= "n", ylim=c(-0.2,0.7), xlim=c(-5000,-2500), xlab = "Years B.P.", ylab = expression(''[15]*'p'[5]), main = "")
vx <- seq(-5000,-2000, by = 500)
vy <- seq(-0.2,0.7, by = 0.1)
axis(1, at = vx)
axis(2, at = vy)
a5k <- order(Analysis5k$Period)
a5kz <- order(Analysis5kz$Period)
Analysis5k.lo <- loess(X15p5 ~ Period, Analysis5k, weights = Total_5plus, span = 0.6)
Analysis5kz.lo <- loess(X15p5 ~ Period, Analysis5kz, weights = Total_5plus, span = 0.6)
pred5k <- predict(Analysis5k.lo, se = TRUE)
pred5kz <- predict(Analysis5kz.lo, se = TRUE)
polygon(x = c(Analysis5k$Period[a5k], rev(Analysis5k$Period[a5k])),
y = c(pred5k$fit[a5k] - qt(0.975, pred5k$df)*pred5k$se[a5k],
rev(pred5k$fit[a5k] + qt(0.975, pred5k$df)*pred5k$se[a5k])),
col = adjustcolor("dodgerblue", alpha.f = 0.10), border = NA)
polygon(x = c(Analysis5kz$Period[a5kz], rev(Analysis5kz$Period[a5kz])),
y = c(pred5kz$fit[a5kz] - qt(0.975, pred5kz$df)*pred5kz$se[a5kz],
rev( pred5kz$fit[a5kz] + qt(0.975, pred5kz$df)*pred5kz$se[a5kz])),
col = adjustcolor("orangered", alpha.f = 0.10), border = NA)
lines(Analysis5k$Period[a5k], pred5k$fit[a5k], col="dodgerblue", lwd=2)
lines(Analysis5kz$Period[a5kz], pred5kz$fit[a5kz], col="orangered", lwd=2)
abline(h=0.173, lty=3)
abline(v=-4700, lty=3)
abline(v=-4000, lty=3)
abline(v=-3000, lty=3)
minor.tick(nx=5, ny=4, tick.ratio=0.5)
库（Hmisc）
谢谢亚当。看起来很棒。如果可能的话，我想试着在R基地完成这件事。我真的很喜欢你提供的例子，并希望在将来尝试使用ggplot进行类似的工作，但我有大量的数字，我已经尝试在这个项目中标准化。我有点担心，更改为ggplot可能会给我的其他一些绘图增加不可预见的困难。不过这是一个很好的解决方案。很抱歉，我没有在最初的帖子中指定base R。如果我不能在BaseR中实现这一点，那么您的示例将很好地解释如何使用ggplot向前推进。谢谢。以防在BaseR中没有这样做的方法，我有一个关于您的流程的基本问题。到目前为止，我一直在使用CSV文件作为我的参考数据（不好，我知道）。我环顾四周，似乎可以使用ggplot做类似的事情。有没有办法做到这一点，而不是像您的示例中所示复制和粘贴值？谢谢Thomas。我感谢你的帮助。我以前没有使用过tidyverse，但它似乎是一种非常精简的方法。不幸的是，我想尝试在BaseR中实现这一点。我有大量的绘图，以前从未使用过ggplot。我担心学习曲线和其他情节可能带来的复杂性可能会让我超过最后期限。很抱歉，我没有在帖子中指定base R。我以前在其他帖子中没有见过这种方法，所以我相信它对其他寻找类似解决方案的人会很有用。谢谢你的帮助。为了以防万一在BaseR中没有办法做到这一点，我有一个关于你的过程的基本问题。到目前为止，我一直在使用CSV文件作为我的参考数据（不好，我知道）。我环顾四周，似乎可以使用ggplot做类似的事情。有没有办法做到这一点，而不是像您的示例中所示复制和粘贴值？@Corey您可以简单地使用基本函数导入数据。如果您想购买tidyverse，请查看readr软件包：。只需使用readr导入数据，使用dplyr和purrr进行转换，如我所示，然后使用ggplot2进行打印。@Corey我用一个新版本编辑了我的文章，它看起来更像基础图形。谢谢！我感谢你的帮助！看起来很完美。ggplot方法也很棒，但这将为我节省大量额外工作。谢谢
nd1[,c("fit", "se")] <- predict(df1.lo[[1]], newdata=nd1, se=T)[1:2]
nd1 <- nd1 %>% mutate(group="5k")
nd2[,c("fit", "se")] <- predict(df2.lo[[2]], newdata=nd1, se=T)[1:2]
nd2 <- nd2 %>% mutate(group="5kz")
ndata <- rbind(nd1, nd2)
library(ggplot2)
p <- ggplot(ndata, aes(Period, fit)) +
geom_line(aes(colour=group)) +
geom_ribbon(aes(ymin=fit-1.96*se, ymax=fit+1.96*se, fill=group), alpha=.2)
p
dat <- do.call(rbind, datlist)
p +
geom_point(data=dat, aes(y=X15p5, shape=as.factor(group)), alpha=.2) +
geom_hline(yintercept=0.173, linetype="dotted") +
geom_vline(xintercept=c(-4700, -4000, -3000), linetype="dotted") +
ylab("X15p5") +
theme_bw()
structure(list(`5k` = structure(list(Period = c(-4350L, -3900L,
-3650L, -3900L, -3958L, -4350L, -3400L, -3650L, -3400L, -3500L,
-3600L, -3808L, -3900L, -3958L, -4058L, -3500L, -4117L, -4350L,
-4350L, -3650L, -2715L, -4350L, -3500L, -4350L, -3650L, -2715L,
-3500L, -3650L, -3400L, -4233L, -3650L, -4350L), X15p5 = c(0.100529101,
0.4, 0.0625, 0.126984127, 0.133333333, 0.150943396, 0.146341463,
0.255319149, 0.222222222, 0.245014245, 0.125, 0.1, 0.160493827,
0.238095238, 0.2, 0.086956522, 0.141414141, 0.171038825, 0.166666667,
0.143798024, 0.137931034, 0.235588972, 0.228840125, 0.041666667,
0.174757282, 0.377777778, 0.2, 0.078947368, 0.208333333, 0.184027778,
0.285714286, 0.166666667), Total_5plus = c(12.6, 20, 9.6, 16.8,
5, 10.6, 8.2, 9.4, 9, 39, 8, 20, 18, 7, 5, 28.75, 6.6, 31.76666667,
6, 30.36666667, 7.25, 26.6, 79.75, 8, 20.6, 11.25, 7.5, 7.6,
24, 19.2, 12.6, 6), group = c("5k", "5k", "5k", "5k", "5k", "5k",
"5k", "5k", "5k", "5k", "5k", "5k", "5k", "5k", "5k", "5k", "5k",
"5k", "5k", "5k", "5k", "5k", "5k", "5k", "5k", "5k", "5k", "5k",
"5k", "5k", "5k", "5k")), .Names = c("Period", "X15p5", "Total_5plus",
"group"), row.names = c(NA, 32L), class = "data.frame"), `5kz` =
structure(list(
Period = c(-4350L, -4350L, -3900L, -3650L, -3400L, -3900L,
-3958L, -4350L, -3400L, -3650L, -3400L, -3500L, -3600L, -3650L,
-3808L, -3900L, -3958L, -4058L, -3500L, -3500L, -4117L, -4350L,
-4350L, -3650L, -2715L, -4350L, -3500L, -4350L, -3500L, -3650L,
-3800L, -2715L, -3500L, -3650L, -4117L, -4350L, -3400L, -4233L,
-3025L, -3650L, -4350L), X15p5 = c(0.100529101, 0, 0.4, 0.0625,
0, 0.126984127, 0.133333333, 0.150943396, 0.146341463, 0.255319149,
0.222222222, 0.245014245, 0.125, 0, 0.1, 0.160493827, 0.238095238,
0.2, 0, 0.086956522, 0.141414141, 0.171038825, 0.166666667,
0.143798024, 0.137931034, 0.235588972, 0.228840125, 0.041666667,
0, 0.174757282, 0, 0.377777778, 0.2, 0.078947368, 0, 0, 0.208333333,
0.184027778, 0, 0.285714286, 0.166666667), Total_5plus = c(12.6,
5, 20, 9.6, 6, 16.8, 5, 10.6, 8.2, 9.4, 9, 39, 8, 28, 20,
18, 7, 5, 25, 28.75, 6.6, 31.76666667, 6, 30.36666667, 7.25,
26.6, 79.75, 8, 5, 20.6, 9, 11.25, 7.5, 7.6, 8, 8, 24, 19.2,
7, 12.6, 6), group = c("5kz", "5kz", "5kz", "5kz", "5kz",
"5kz", "5kz", "5kz", "5kz", "5kz", "5kz", "5kz", "5kz", "5kz",
"5kz", "5kz", "5kz", "5kz", "5kz", "5kz", "5kz", "5kz", "5kz",
"5kz", "5kz", "5kz", "5kz", "5kz", "5kz", "5kz", "5kz", "5kz",
"5kz", "5kz", "5kz", "5kz", "5kz", "5kz", "5kz", "5kz", "5kz"
)), .Names = c("Period", "X15p5", "Total_5plus", "group"), row.names = 33:73, class = "data.frame")), .Names = c("5k",
"5kz"))
library(Hmisc)
ppi <- 300
par(mfrow = c(1,1), pty = "s", oma=c(1,2,1,1), mar=c(4,4,2,2))
plot(X15p5 ~ Period, Analysis5kz, xaxt = "n", yaxt= "n", ylim=c(-0.2,0.7), xlim=c(-5000,-2500), xlab = "Years B.P.", ylab = expression(''[15]*'p'[5]), main = "")
vx <- seq(-5000,-2000, by = 500)
vy <- seq(-0.2,0.7, by = 0.1)
axis(1, at = vx)
axis(2, at = vy)
a5k <- order(Analysis5k$Period)
a5kz <- order(Analysis5kz$Period)
Analysis5k.lo <- loess(X15p5 ~ Period, Analysis5k, weights = Total_5plus, span = 0.6)
Analysis5kz.lo <- loess(X15p5 ~ Period, Analysis5kz, weights = Total_5plus, span = 0.6)
pred5k <- predict(Analysis5k.lo, se = TRUE)
pred5kz <- predict(Analysis5kz.lo, se = TRUE)
polygon(x = c(Analysis5k$Period[a5k], rev(Analysis5k$Period[a5k])),
y = c(pred5k$fit[a5k] - qt(0.975, pred5k$df)*pred5k$se[a5k],
rev(pred5k$fit[a5k] + qt(0.975, pred5k$df)*pred5k$se[a5k])),
col = adjustcolor("dodgerblue", alpha.f = 0.10), border = NA)
polygon(x = c(Analysis5kz$Period[a5kz], rev(Analysis5kz$Period[a5kz])),
y = c(pred5kz$fit[a5kz] - qt(0.975, pred5kz$df)*pred5kz$se[a5kz],
rev( pred5kz$fit[a5kz] + qt(0.975, pred5kz$df)*pred5kz$se[a5kz])),
col = adjustcolor("orangered", alpha.f = 0.10), border = NA)
lines(Analysis5k$Period[a5k], pred5k$fit[a5k], col="dodgerblue", lwd=2)
lines(Analysis5kz$Period[a5kz], pred5kz$fit[a5kz], col="orangered", lwd=2)
abline(h=0.173, lty=3)
abline(v=-4700, lty=3)
abline(v=-4000, lty=3)
abline(v=-3000, lty=3)
minor.tick(nx=5, ny=4, tick.ratio=0.5)