Simple graphs illustrating regression for causal inference. See Chapter 1 in Regression and Other Stories.

The simulated data depends on the random seed, and thus the plots and numbers here and in the book may differ. You can experiment with the simulation variation by changing the seed.


Load packages

library("rprojroot")
root<-has_file(".ROS-Examples-root")$make_fix_file()
library("arm")
# for reproducibility of simulated data
SEED <- 1151

Simulated data from linear model

set.seed(SEED)
N <- 50
x <- runif(N, 1, 5)
y <- rnorm(N, 10 + 3*x, 3)
x_binary <- ifelse(x<3, 0, 1)
data <- data.frame(N, x, y, x_binary)

Regression with binary predictor

lm_1a <- lm(y ~ x_binary, data = data)
display(lm_1a)
lm(formula = y ~ x_binary, data = data)
            coef.est coef.se
(Intercept) 16.20     0.65  
x_binary     4.63     0.95  
---
n = 50, k = 2
residual sd = 3.36, R-Squared = 0.33

Plots

par(mar=c(3, 3, 1.5, 1), mgp=c(1.7, .5, 0), tck=-.01)
plot(x_binary, y, xlab="", ylab="Outcome measurement", pch=20, cex=.5, bty="l", main="Regression with binary treatment", cex.main=.9, xaxt="n", cex.lab=.9, cex.axis=.9)
axis(1, c(0,1), c("    Control", "Treatment    "), cex.axis=.9)
abline(coef(lm_1a)[1], coef(lm_1a)[2])
text(0.3, 13, paste("Estimated treatment effect is\nslope of fitted line: ", fround(coef(lm_1a)[2], 1)), cex=.8, adj=0)

Regression with continuous predictor

lm_1b <- lm(y ~ x, data = data)
display(lm_1b)
lm(formula = y ~ x, data = data)
            coef.est coef.se
(Intercept) 10.08     1.13  
x            2.89     0.37  
---
n = 50, k = 2
residual sd = 2.73, R-Squared = 0.56
par(mar=c(3, 3, 1.5, 1), mgp=c(1.7, .5, 0), tck=-.01)
plot(x, y, xlab="Treatment level", ylab="Outcome measurement", pch=20, cex=.5, bty="l", main="Regression with continuous treatment", cex.main=.9, cex.lab=.9, cex.axis=.9)
abline(coef(lm_1b)[1], coef(lm_1b)[2])
text(3.2, 15, paste("Estimated treatment\neffect per unit of x is\nslope of fitted line: ", fround(coef(lm_1b)[2], 1)), cex=.8, adj=0)

Simulated data from nonlinear model

set.seed(SEED)
y <- rnorm(N, 5 + 30*exp(-x), 2)
data$y <- y

Classical regression with continuous predictor

lm_2a <- lm(y ~ x, data = data)
display(lm_2a)
lm(formula = y ~ x, data = data)
            coef.est coef.se
(Intercept) 13.37     0.74  
x           -2.18     0.24  
---
n = 50, k = 2
residual sd = 1.78, R-Squared = 0.63
par(mar=c(3, 3, 1.5, 1), mgp=c(1.7, .5, 0), tck=-.01)
plot(x, y, xlab="Treatment level", ylab="Outcome measurement", pch=20, cex=.5, bty="l", main="Nonlinear treatment effect", cex.main=.9, cex.lab=.9, cex.axis=.9)
curve(5 + 30*exp(-x), add=TRUE)

par(mar=c(3, 3, 1.5, 1), mgp=c(1.7, .5, 0), tck=-.01)
plot(x, y, xlab="Treatment level", ylab="Outcome measurement", pch=20, cex=.5, bty="l", main="Nonlinear effect, estimated with straight line fit", cex.main=.9, cex.lab=.9, cex.axis=.9)
abline(coef(lm_2a)[1], coef(lm_2a)[2])

Simulated data from two groups

set.seed(SEED)
N <- 100
z <- rep(0:1, N/2)
xx <- ifelse(z==0, rnorm(N, 0, 1.2)^2, rnorm(N, 0, .8)^2)
yy <- rnorm(N, 20 + 5*xx + 10*z, 3)
data <- data.frame(xx, z, yy)
lm_2 <- lm(yy ~ xx + z, data=data)
display(lm_2)
lm(formula = yy ~ xx + z, data = data)
            coef.est coef.se
(Intercept) 20.33     0.48  
xx           5.05     0.22  
z            9.83     0.59  
---
n = 100, k = 3
residual sd = 2.90, R-Squared = 0.87
par(mar=c(3, 3, 1.5, 1), mgp=c(1.7, .5, 0), tck=-.01)
plot(xx, yy, xlab="Pre-treatment predictor", ylab="Outcome measurement", bty="l", main="Continuous pre-treatment predictor and binary treatment    ", cex.main=.9, cex.lab=.9, cex.axis=.9, type="n")
points(xx[z==0], yy[z==0], pch=20, cex=.5)
points(xx[z==1], yy[z==1], pch=1, cex=1)
abline(coef(lm_2)[1], coef(lm_2)[2])
abline(coef(lm_2)[1] + coef(lm_2)[3], coef(lm_2)[2])
text(2.3, 29.5, "Controls", cex=.9, adj=0)
text(1.5, 45, "Treated", cex=.9, adj=0)
x0 <- 5.2
arrows(x0, coef(lm_2)[1] + coef(lm_2)[2]*x0, x0, coef(lm_2)[1] + coef(lm_2)[2]*x0 + coef(lm_2)[3], length=.1, code=3)
text(x0+.15, 1 + coef(lm_2)[1] + coef(lm_2)[2]*x0 + .5*coef(lm_2)[3], paste("Estimated\ntreatment\neffect is", fround(coef(lm_2)[3], 1)), cex=.8, adj=0)

LS0tCnRpdGxlOiAiUmVncmVzc2lvbiBhbmQgT3RoZXIgU3RvcmllczogU2ltcGxlQ2F1c2FsIgphdXRob3I6ICJBbmRyZXcgR2VsbWFuLCBKZW5uaWZlciBIaWxsLCBBa2kgVmVodGFyaSIKZGF0ZTogImByIGZvcm1hdChTeXMuRGF0ZSgpKWAiCm91dHB1dDoKICBodG1sX2RvY3VtZW50OgogICAgdGhlbWU6IHJlYWRhYmxlCiAgICB0b2M6IHRydWUKICAgIHRvY19kZXB0aDogMgogICAgdG9jX2Zsb2F0OiB0cnVlCiAgICBjb2RlX2Rvd25sb2FkOiB0cnVlCi0tLQpTaW1wbGUgZ3JhcGhzIGlsbHVzdHJhdGluZyByZWdyZXNzaW9uIGZvciBjYXVzYWwgaW5mZXJlbmNlLiBTZWUKQ2hhcHRlciAxIGluIFJlZ3Jlc3Npb24gYW5kIE90aGVyIFN0b3JpZXMuCgpUaGUgc2ltdWxhdGVkIGRhdGEgZGVwZW5kcyBvbiB0aGUgcmFuZG9tIHNlZWQsIGFuZCB0aHVzIHRoZSBwbG90cwphbmQgbnVtYmVycyBoZXJlIGFuZCBpbiB0aGUgYm9vayBtYXkgZGlmZmVyLiBZb3UgY2FuIGV4cGVyaW1lbnQKd2l0aCB0aGUgc2ltdWxhdGlvbiB2YXJpYXRpb24gYnkgY2hhbmdpbmcgdGhlIHNlZWQuCgotLS0tLS0tLS0tLS0tCgoKYGBge3Igc2V0dXAsIGluY2x1ZGU9RkFMU0V9CmtuaXRyOjpvcHRzX2NodW5rJHNldChtZXNzYWdlPUZBTFNFLCBlcnJvcj1GQUxTRSwgd2FybmluZz1GQUxTRSwgY29tbWVudD1OQSkKIyBzd2l0Y2ggdGhpcyB0byBUUlVFIHRvIHNhdmUgZmlndXJlcyBpbiBzZXBhcmF0ZSBmaWxlcwpzYXZlZmlncyA8LSBGQUxTRQpgYGAKCiMjIyMgTG9hZCBwYWNrYWdlcwoKYGBge3IgfQpsaWJyYXJ5KCJycHJvanJvb3QiKQpyb290PC1oYXNfZmlsZSgiLlJPUy1FeGFtcGxlcy1yb290IikkbWFrZV9maXhfZmlsZSgpCmxpYnJhcnkoImFybSIpCiMgZm9yIHJlcHJvZHVjaWJpbGl0eSBvZiBzaW11bGF0ZWQgZGF0YQpTRUVEIDwtIDExNTEKYGBgCgojIyBTaW11bGF0ZWQgZGF0YSBmcm9tIGxpbmVhciBtb2RlbAoKYGBge3IgfQpzZXQuc2VlZChTRUVEKQpOIDwtIDUwCnggPC0gcnVuaWYoTiwgMSwgNSkKeSA8LSBybm9ybShOLCAxMCArIDMqeCwgMykKeF9iaW5hcnkgPC0gaWZlbHNlKHg8MywgMCwgMSkKZGF0YSA8LSBkYXRhLmZyYW1lKE4sIHgsIHksIHhfYmluYXJ5KQpgYGAKCiMjIyMgUmVncmVzc2lvbiB3aXRoIGJpbmFyeSBwcmVkaWN0b3IKCmBgYHtyIH0KbG1fMWEgPC0gbG0oeSB+IHhfYmluYXJ5LCBkYXRhID0gZGF0YSkKZGlzcGxheShsbV8xYSkKYGBgCgojIyMjIFBsb3RzCgpgYGB7ciBldmFsPUZBTFNFLCBpbmNsdWRlPUZBTFNFfQppZiAoc2F2ZWZpZ3MpIHBkZihyb290KCJTaW1wbGVDYXVzYWwvZmlncyIsIm92ZXJ2aWV3XzFhLnBkZiIpLCBoZWlnaHQ9My41LCB3aWR0aD00LjUpCmBgYApgYGB7ciB9CnBhcihtYXI9YygzLCAzLCAxLjUsIDEpLCBtZ3A9YygxLjcsIC41LCAwKSwgdGNrPS0uMDEpCnBsb3QoeF9iaW5hcnksIHksIHhsYWI9IiIsIHlsYWI9Ik91dGNvbWUgbWVhc3VyZW1lbnQiLCBwY2g9MjAsIGNleD0uNSwgYnR5PSJsIiwgbWFpbj0iUmVncmVzc2lvbiB3aXRoIGJpbmFyeSB0cmVhdG1lbnQiLCBjZXgubWFpbj0uOSwgeGF4dD0ibiIsIGNleC5sYWI9LjksIGNleC5heGlzPS45KQpheGlzKDEsIGMoMCwxKSwgYygiICAgIENvbnRyb2wiLCAiVHJlYXRtZW50ICAgICIpLCBjZXguYXhpcz0uOSkKYWJsaW5lKGNvZWYobG1fMWEpWzFdLCBjb2VmKGxtXzFhKVsyXSkKdGV4dCgwLjMsIDEzLCBwYXN0ZSgiRXN0aW1hdGVkIHRyZWF0bWVudCBlZmZlY3QgaXNcbnNsb3BlIG9mIGZpdHRlZCBsaW5lOiAiLCBmcm91bmQoY29lZihsbV8xYSlbMl0sIDEpKSwgY2V4PS44LCBhZGo9MCkKYGBgCmBgYHtyIGV2YWw9RkFMU0UsIGluY2x1ZGU9RkFMU0V9CmlmIChzYXZlZmlncykgZGV2Lm9mZigpCmBgYAoKIyMjIyBSZWdyZXNzaW9uIHdpdGggY29udGludW91cyBwcmVkaWN0b3IKCmBgYHtyIH0KbG1fMWIgPC0gbG0oeSB+IHgsIGRhdGEgPSBkYXRhKQpkaXNwbGF5KGxtXzFiKQoKYGBgCmBgYHtyIGV2YWw9RkFMU0UsIGluY2x1ZGU9RkFMU0V9CmlmIChzYXZlZmlncykgcGRmKHJvb3QoIlNpbXBsZUNhdXNhbC9maWdzIiwib3ZlcnZpZXdfMWIucGRmIiksIGhlaWdodD0zLjUsIHdpZHRoPTQuNSkKYGBgCmBgYHtyIH0KcGFyKG1hcj1jKDMsIDMsIDEuNSwgMSksIG1ncD1jKDEuNywgLjUsIDApLCB0Y2s9LS4wMSkKcGxvdCh4LCB5LCB4bGFiPSJUcmVhdG1lbnQgbGV2ZWwiLCB5bGFiPSJPdXRjb21lIG1lYXN1cmVtZW50IiwgcGNoPTIwLCBjZXg9LjUsIGJ0eT0ibCIsIG1haW49IlJlZ3Jlc3Npb24gd2l0aCBjb250aW51b3VzIHRyZWF0bWVudCIsIGNleC5tYWluPS45LCBjZXgubGFiPS45LCBjZXguYXhpcz0uOSkKYWJsaW5lKGNvZWYobG1fMWIpWzFdLCBjb2VmKGxtXzFiKVsyXSkKdGV4dCgzLjIsIDE1LCBwYXN0ZSgiRXN0aW1hdGVkIHRyZWF0bWVudFxuZWZmZWN0IHBlciB1bml0IG9mIHggaXNcbnNsb3BlIG9mIGZpdHRlZCBsaW5lOiAiLCBmcm91bmQoY29lZihsbV8xYilbMl0sIDEpKSwgY2V4PS44LCBhZGo9MCkKYGBgCmBgYHtyIGV2YWw9RkFMU0UsIGluY2x1ZGU9RkFMU0V9CmlmIChzYXZlZmlncykgZGV2Lm9mZigpCmBgYAoKIyMgU2ltdWxhdGVkIGRhdGEgZnJvbSBub25saW5lYXIgbW9kZWwKCmBgYHtyIH0Kc2V0LnNlZWQoU0VFRCkKeSA8LSBybm9ybShOLCA1ICsgMzAqZXhwKC14KSwgMikKZGF0YSR5IDwtIHkKYGBgCgojIyMjIENsYXNzaWNhbCByZWdyZXNzaW9uIHdpdGggY29udGludW91cyBwcmVkaWN0b3IKCmBgYHtyIH0KbG1fMmEgPC0gbG0oeSB+IHgsIGRhdGEgPSBkYXRhKQpkaXNwbGF5KGxtXzJhKQoKYGBgCmBgYHtyIGV2YWw9RkFMU0UsIGluY2x1ZGU9RkFMU0V9CmlmIChzYXZlZmlncykgcGRmKHJvb3QoIlNpbXBsZUNhdXNhbC9maWdzIiwib3ZlcnZpZXdfMmEucGRmIiksIGhlaWdodD0zLjUsIHdpZHRoPTQuNSkKYGBgCmBgYHtyIH0KcGFyKG1hcj1jKDMsIDMsIDEuNSwgMSksIG1ncD1jKDEuNywgLjUsIDApLCB0Y2s9LS4wMSkKcGxvdCh4LCB5LCB4bGFiPSJUcmVhdG1lbnQgbGV2ZWwiLCB5bGFiPSJPdXRjb21lIG1lYXN1cmVtZW50IiwgcGNoPTIwLCBjZXg9LjUsIGJ0eT0ibCIsIG1haW49Ik5vbmxpbmVhciB0cmVhdG1lbnQgZWZmZWN0IiwgY2V4Lm1haW49LjksIGNleC5sYWI9LjksIGNleC5heGlzPS45KQpjdXJ2ZSg1ICsgMzAqZXhwKC14KSwgYWRkPVRSVUUpCmBgYApgYGB7ciBldmFsPUZBTFNFLCBpbmNsdWRlPUZBTFNFfQppZiAoc2F2ZWZpZ3MpIGRldi5vZmYoKQoKYGBgCmBgYHtyIGV2YWw9RkFMU0UsIGluY2x1ZGU9RkFMU0V9CmlmIChzYXZlZmlncykgcGRmKHJvb3QoIlNpbXBsZUNhdXNhbC9maWdzIiwib3ZlcnZpZXdfMmIucGRmIiksIGhlaWdodD0zLjUsIHdpZHRoPTQuNSkKYGBgCmBgYHtyIH0KcGFyKG1hcj1jKDMsIDMsIDEuNSwgMSksIG1ncD1jKDEuNywgLjUsIDApLCB0Y2s9LS4wMSkKcGxvdCh4LCB5LCB4bGFiPSJUcmVhdG1lbnQgbGV2ZWwiLCB5bGFiPSJPdXRjb21lIG1lYXN1cmVtZW50IiwgcGNoPTIwLCBjZXg9LjUsIGJ0eT0ibCIsIG1haW49Ik5vbmxpbmVhciBlZmZlY3QsIGVzdGltYXRlZCB3aXRoIHN0cmFpZ2h0IGxpbmUgZml0IiwgY2V4Lm1haW49LjksIGNleC5sYWI9LjksIGNleC5heGlzPS45KQphYmxpbmUoY29lZihsbV8yYSlbMV0sIGNvZWYobG1fMmEpWzJdKQpgYGAKYGBge3IgZXZhbD1GQUxTRSwgaW5jbHVkZT1GQUxTRX0KaWYgKHNhdmVmaWdzKSBkZXYub2ZmKCkKYGBgCgojIyBTaW11bGF0ZWQgZGF0YSBmcm9tIHR3byBncm91cHMKCmBgYHtyIH0Kc2V0LnNlZWQoU0VFRCkKTiA8LSAxMDAKeiA8LSByZXAoMDoxLCBOLzIpCnh4IDwtIGlmZWxzZSh6PT0wLCBybm9ybShOLCAwLCAxLjIpXjIsIHJub3JtKE4sIDAsIC44KV4yKQp5eSA8LSBybm9ybShOLCAyMCArIDUqeHggKyAxMCp6LCAzKQpkYXRhIDwtIGRhdGEuZnJhbWUoeHgsIHosIHl5KQpsbV8yIDwtIGxtKHl5IH4geHggKyB6LCBkYXRhPWRhdGEpCmRpc3BsYXkobG1fMikKCmBgYApgYGB7ciBldmFsPUZBTFNFLCBpbmNsdWRlPUZBTFNFfQppZiAoc2F2ZWZpZ3MpIHBkZihyb290KCJTaW1wbGVDYXVzYWwvZmlncyIsIm92ZXJ2aWV3XzMucGRmIiksIGhlaWdodD0zLjUsIHdpZHRoPTQuNSkKYGBgCmBgYHtyIH0KcGFyKG1hcj1jKDMsIDMsIDEuNSwgMSksIG1ncD1jKDEuNywgLjUsIDApLCB0Y2s9LS4wMSkKcGxvdCh4eCwgeXksIHhsYWI9IlByZS10cmVhdG1lbnQgcHJlZGljdG9yIiwgeWxhYj0iT3V0Y29tZSBtZWFzdXJlbWVudCIsIGJ0eT0ibCIsIG1haW49IkNvbnRpbnVvdXMgcHJlLXRyZWF0bWVudCBwcmVkaWN0b3IgYW5kIGJpbmFyeSB0cmVhdG1lbnQgICAgIiwgY2V4Lm1haW49LjksIGNleC5sYWI9LjksIGNleC5heGlzPS45LCB0eXBlPSJuIikKcG9pbnRzKHh4W3o9PTBdLCB5eVt6PT0wXSwgcGNoPTIwLCBjZXg9LjUpCnBvaW50cyh4eFt6PT0xXSwgeXlbej09MV0sIHBjaD0xLCBjZXg9MSkKYWJsaW5lKGNvZWYobG1fMilbMV0sIGNvZWYobG1fMilbMl0pCmFibGluZShjb2VmKGxtXzIpWzFdICsgY29lZihsbV8yKVszXSwgY29lZihsbV8yKVsyXSkKdGV4dCgyLjMsIDI5LjUsICJDb250cm9scyIsIGNleD0uOSwgYWRqPTApCnRleHQoMS41LCA0NSwgIlRyZWF0ZWQiLCBjZXg9LjksIGFkaj0wKQp4MCA8LSA1LjIKYXJyb3dzKHgwLCBjb2VmKGxtXzIpWzFdICsgY29lZihsbV8yKVsyXSp4MCwgeDAsIGNvZWYobG1fMilbMV0gKyBjb2VmKGxtXzIpWzJdKngwICsgY29lZihsbV8yKVszXSwgbGVuZ3RoPS4xLCBjb2RlPTMpCnRleHQoeDArLjE1LCAxICsgY29lZihsbV8yKVsxXSArIGNvZWYobG1fMilbMl0qeDAgKyAuNSpjb2VmKGxtXzIpWzNdLCBwYXN0ZSgiRXN0aW1hdGVkXG50cmVhdG1lbnRcbmVmZmVjdCBpcyIsIGZyb3VuZChjb2VmKGxtXzIpWzNdLCAxKSksIGNleD0uOCwgYWRqPTApCmBgYApgYGB7ciBldmFsPUZBTFNFLCBpbmNsdWRlPUZBTFNFfQppZiAoc2F2ZWZpZ3MpIGRldi5vZmYoKQoKZm9yIChqIGluIDA6MSkgcHJpbnQobWVhbih5eVt6PT1qXSkpCmZvciAoaiBpbiAwOjEpIHByaW50KG1lYW4oeHhbej09al0pKQpgYGAKCg==