Plot influence of individual points in a fitted regression. See Chapter 8 in Regression and Other Stories.


Load packages

library("rprojroot")
root<-has_file(".ROS-Examples-root")$make_fix_file()

Fake data

x <- seq(2, 12, 1)
n <- length(x)
a <- 1
b <- 2
sigma <- 5
y <- rnorm(n, a + b*x, sigma)
least_squares_fit <- lm(y ~ x)
a_hat <- coef(least_squares_fit)[1]
b_hat <- coef(least_squares_fit)[2]

Plot histogram of the data

par(mar=c(3,3,1,1), mgp=c(1.7,.5,0), tck=-.01)
plot(x, y, ylim=c(a_hat + b_hat*min(x) - 2*sigma, a_hat + b_hat*max(x) + 2*sigma), pch=20, bty="l")
abline(a_hat, b_hat)
for (i in 1:n){
  lines(rep(x[i], 2), c(y[i], a_hat + b_hat*x[i]), lwd=0.5)
}

LS0tCnRpdGxlOiAiUmVncmVzc2lvbiBhbmQgT3RoZXIgU3RvcmllczogSW5mbHVlbmNlIgphdXRob3I6ICJBbmRyZXcgR2VsbWFuLCBKZW5uaWZlciBIaWxsLCBBa2kgVmVodGFyaSIKZGF0ZTogImByIGZvcm1hdChTeXMuRGF0ZSgpKWAiCm91dHB1dDoKICBodG1sX2RvY3VtZW50OgogICAgdGhlbWU6IHJlYWRhYmxlCiAgICB0b2M6IHRydWUKICAgIHRvY19kZXB0aDogMgogICAgdG9jX2Zsb2F0OiB0cnVlCiAgICBjb2RlX2Rvd25sb2FkOiB0cnVlCi0tLQpQbG90IGluZmx1ZW5jZSBvZiBpbmRpdmlkdWFsIHBvaW50cyBpbiBhIGZpdHRlZCByZWdyZXNzaW9uLiBTZWUKQ2hhcHRlciA4IGluIFJlZ3Jlc3Npb24gYW5kIE90aGVyIFN0b3JpZXMuCgotLS0tLS0tLS0tLS0tCgoKYGBge3Igc2V0dXAsIGluY2x1ZGU9RkFMU0V9CmtuaXRyOjpvcHRzX2NodW5rJHNldChtZXNzYWdlPUZBTFNFLCBlcnJvcj1GQUxTRSwgd2FybmluZz1GQUxTRSwgY29tbWVudD1OQSkKIyBzd2l0Y2ggdGhpcyB0byBUUlVFIHRvIHNhdmUgZmlndXJlcyBpbiBzZXBhcmF0ZSBmaWxlcwpzYXZlZmlncyA8LSBGQUxTRQpgYGAKCiMjIyMgTG9hZCBwYWNrYWdlcwoKYGBge3IgfQpsaWJyYXJ5KCJycHJvanJvb3QiKQpyb290PC1oYXNfZmlsZSgiLlJPUy1FeGFtcGxlcy1yb290IikkbWFrZV9maXhfZmlsZSgpCmBgYAoKIyMjIyBGYWtlIGRhdGEKCmBgYHtyIH0KeCA8LSBzZXEoMiwgMTIsIDEpCm4gPC0gbGVuZ3RoKHgpCmEgPC0gMQpiIDwtIDIKc2lnbWEgPC0gNQp5IDwtIHJub3JtKG4sIGEgKyBiKngsIHNpZ21hKQpsZWFzdF9zcXVhcmVzX2ZpdCA8LSBsbSh5IH4geCkKYV9oYXQgPC0gY29lZihsZWFzdF9zcXVhcmVzX2ZpdClbMV0KYl9oYXQgPC0gY29lZihsZWFzdF9zcXVhcmVzX2ZpdClbMl0KYGBgCgojIyMjIFBsb3QgaGlzdG9ncmFtIG9mIHRoZSBkYXRhCgpgYGB7ciBldmFsPUZBTFNFLCBpbmNsdWRlPUZBTFNFfQppZiAoc2F2ZWZpZ3MpIHBkZihyb290KCJJbmZsdWVuY2UvZmlncyIsImluZmx1ZW5jZTEucGRmIiksIGhlaWdodD00LCB3aWR0aD01KQpgYGAKYGBge3IgfQpwYXIobWFyPWMoMywzLDEsMSksIG1ncD1jKDEuNywuNSwwKSwgdGNrPS0uMDEpCnBsb3QoeCwgeSwgeWxpbT1jKGFfaGF0ICsgYl9oYXQqbWluKHgpIC0gMipzaWdtYSwgYV9oYXQgKyBiX2hhdCptYXgoeCkgKyAyKnNpZ21hKSwgcGNoPTIwLCBidHk9ImwiKQphYmxpbmUoYV9oYXQsIGJfaGF0KQpmb3IgKGkgaW4gMTpuKXsKICBsaW5lcyhyZXAoeFtpXSwgMiksIGMoeVtpXSwgYV9oYXQgKyBiX2hhdCp4W2ldKSwgbHdkPTAuNSkKfQpgYGAKYGBge3IgZXZhbD1GQUxTRSwgaW5jbHVkZT1GQUxTRX0KaWYgKHNhdmVmaWdzKSBkZXYub2ZmKCkKYGBgCgo=