如何在每个方面添加两个回归线方程和r2?
我想在每个方面添加两个回归线方程和r2。我采用了这个方法来解决这个问题,但我发现每个方程都是一样的。可能的原因是向函数发送错误的数据子集。任何建议都将不胜感激 我的代码:如何在每个方面添加两个回归线方程和r2?,r,ggplot2,facet-wrap,R,Ggplot2,Facet Wrap,我想在每个方面添加两个回归线方程和r2。我采用了这个方法来解决这个问题,但我发现每个方程都是一样的。可能的原因是向函数发送错误的数据子集。任何建议都将不胜感激 我的代码: p <- ggplot(data=df,aes(x=x))+ geom_point(aes(y = y1),size=2.0)+ geom_smooth(aes(y = y1),method=lm,se=FALSE,size=0.5, fullrange = TRUE)+ # Add
p <- ggplot(data=df,aes(x=x))+
geom_point(aes(y = y1),size=2.0)+
geom_smooth(aes(y = y1),method=lm,se=FALSE,size=0.5,
fullrange = TRUE)+ # Add regression line;
annotate("text",x = 150,y =320, label = lm_eqn(lm(y1~x,df)), # maybe wrong
size = 2.0, parse = TRUE)+ # Add regression line equation;
geom_point(aes(y = y2),size=2.0)+
geom_smooth(aes(y = y2),method=lm,se=FALSE,size=0.5,
fullrange = TRUE)+ # Add regression line;
annotate("text",x = 225,y =50, label = lm_eqn(lm(y2~x,df)),
size = 2.0, parse = TRUE)+ # Add regression line equation;
facet_wrap(~trt)
我的情节:
另外,在每个方面有两条线和你的方程,这两条线是对的,但这两个方程是错的。显然,左、右切面上的上/下方程应该彼此不同。1)ggplot2首先尝试将df
转换为长格式(请参见##行)。我们创建了一个注释数据框ann
,它定义了文本,并将文本用于geom_text
。请注意,由于绘图由trt
分面,因此geom_text
将使用ann
的每行中的trt
列将该行与适当的分面关联
library(ggplot2)
library(reshape2)
long <- melt(df, measure.vars = 2:3) ##
trts <- unique(long$trt)
ann <- data.frame(x = c(0, 100),
y = c(250, 100),
label = c(lm_eqn(lm(y1 ~ x, df, subset = trt == trts[1])),
lm_eqn(lm(y2 ~ x, df, subset = trt == trts[1])),
lm_eqn(lm(y1 ~ x, df, subset = trt == trts[2])),
lm_eqn(lm(y2 ~ x, df, subset = trt == trts[2]))),
trt = rep(trts, each = 2),
variable = c("y1", "y2"))
ggplot(long, aes(x, value)) +
geom_point() +
geom_smooth(aes(col = variable), method = "lm", se = FALSE,
full_range = TRUE) +
geom_text(aes(x, y, label = label, col = variable), data = ann,
parse = TRUE, hjust = -0.1, size = 2) +
facet_wrap(~ trt)
(图后续)
2)lattice在这种情况下,使用lattice可能更容易:
library(lattice)
xyplot(y1 + y2 ~ x | factor(trt), df,
key = simpleKey(text = c("y1", "y2"), col = c("blue", "red")),
panel = panel.superpose,
panel.groups = function(x, y, group.value, ...) {
if (group.value == "y1") {
X <- 150; Y <- 300; col <- "blue"
} else {
X <- 250; Y <- 100; col <- "red"
}
panel.points(x, y, col = col)
panel.abline(lm(y ~ x), col = col)
panel.text(X, Y, parse(text = lm_eqn(lm(y ~ x))), col = col, cex = 0.7)
}
)
更新
- 添加了彩色文本李>
- 添加了备选
李>ann
- 添加晶格解
- 向晶格解决方案添加晶格额外的变化
geom_文本
设置为与geom_平滑
相同的颜色?非常感谢。更新答案,为方程式添加颜色,并为ann
提供替代等效表达式。
f <- function(v) lm_eqn(lm(value ~ x, long, subset = variable==v[[1]] & trt==v[[2]]))
Grid <- expand.grid(variable = c("y1", "y2"), trt = trts)
ann <- data.frame(x = c(0, 100), y = c(250, 100), label = apply(Grid, 1, f), Grid)
library(lattice)
xyplot(y1 + y2 ~ x | factor(trt), df,
key = simpleKey(text = c("y1", "y2"), col = c("blue", "red")),
panel = panel.superpose,
panel.groups = function(x, y, group.value, ...) {
if (group.value == "y1") {
X <- 150; Y <- 300; col <- "blue"
} else {
X <- 250; Y <- 100; col <- "red"
}
panel.points(x, y, col = col)
panel.abline(lm(y ~ x), col = col)
panel.text(X, Y, parse(text = lm_eqn(lm(y ~ x))), col = col, cex = 0.7)
}
)
library(latticeExtra)
xyplot(y1 + y2 ~ x | factor(trt), df, par.settings = ggplot2like(),
key = simpleKey(text = c("y1", "y2"), col = c("blue", "red")),
panel = panel.superpose,
panel.groups = function(x, y, group.value, ...) {
if (group.value == "y1") {
X <- 150; Y <- 300; col <- "blue"
} else {
X <- 250; Y <- 100; col <- "red"
}
panel.points(x, y, col = col)
panel.grid()
panel.abline(lm(y ~ x), col = col)
panel.text(X, Y, parse(text = lm_eqn(lm(y ~ x))), col = col, cex = 0.7)
}
)
df <-
structure(list(x = c(22.48349, 93.52976, 163.00984, 205.62072,
265.46812, 23.79859, 99.97307, 189.91814, 268.1006, 325.65609,
357.59726), y1 = c(34.2, 98.5, 164.2, 216.7, 271.8, 35.8, 119.4,
200.8, 279.5, 325.7, 353.6), y2 = c(31, 96, 169.8, 210, 258.5,
24.2, 90.6, 189.3, 264.6, 325.4, 353.8), trt = c(6030L, 6030L,
6030L, 6030L, 6030L, 6060L, 6060L, 6060L, 6060L, 6060L, 6060L
)), .Names = c("x", "y1", "y2", "trt"), class = "data.frame", row.names = c(NA,
-11L))