下の写真はあなたが達成したいもののように見えますか?
コメントに続いて、更新された Rコードを次に示します。
do.it <- function(df, type="confidence", ...) {
require(ellipse)
lm0 <- lm(y ~ x, data=df)
xc <- with(df, xyTable(x, y))
df.new <- data.frame(x=seq(min(df$x), max(df$x), 0.1))
pred.ulb <- predict(lm0, df.new, interval=type)
pred.lo <- predict(loess(y ~ x, data=df), df.new)
plot(xc$x, xc$y, cex=xc$number*2/3, xlab="x", ylab="y", ...)
abline(lm0, col="red")
lines(df.new$x, pred.lo, col="green", lwd=1.5)
lines(df.new$x, pred.ulb[,"lwr"], lty=2, col="red")
lines(df.new$x, pred.ulb[,"upr"], lty=2, col="red")
lines(ellipse(cor(df$x, df$y), scale=c(sd(df$x),sd(df$y)),
centre=c(mean(df$x),mean(df$y))), lwd=1.5, col="green")
invisible(lm0)
}
set.seed(101)
n <- 1000
x <- rnorm(n, mean=2)
y <- 1.5 + 0.4*x + rnorm(n)
df <- data.frame(x=x, y=y)
# take a bootstrap sample
df <- df[sample(nrow(df), nrow(df), rep=TRUE),]
do.it(df, pch=19, col=rgb(0,0,.7,.5))
そしてこれがggplotizedバージョンです
次のコードで生成されます:
xc <- with(df, xyTable(x, y))
df2 <- cbind.data.frame(x=xc$x, y=xc$y, n=xc$number)
df.ell <- as.data.frame(with(df, ellipse(cor(x, y),
scale=c(sd(x),sd(y)),
centre=c(mean(x),mean(y)))))
library(ggplot2)
ggplot(data=df2, aes(x=x, y=y)) +
geom_point(aes(size=n), alpha=.6) +
stat_smooth(data=df, method="loess", se=FALSE, color="green") +
stat_smooth(data=df, method="lm") +
geom_path(data=df.ell, colour="green", size=1.2)
色シェーディング効果を使用して、クックの距離などのモデルフィットインデックスを追加することで、もう少しカスタマイズできます。