Height and weight distributions of women and men illustrating central limit theorem and normal distribution. See Chapter 3 in Regression and Other Stories.
Load packages
library("rprojroot")
root<-has_file(".ROS-Examples-root")$make_fix_file()
Summary data of height and weight distributions of women and men
height_counts_women <- c(80,107,296,695,1612,2680,4645,8201,9948,11733,10270,9942,6181,3990,2131,1154,245,257,0,0,0,0)*10339/74167
weight_counts_women <- c(362,1677,4572,9363,11420,12328,9435,7023,5047,3621,2753,2081,1232,887,2366)*10339/74167
height_counts_men <- c(0,0,0,0,0,0,0,542,668,1221,2175,4213,5535,7980,9566,9578,8867,6716,5019,2745,1464,1263)*9983/67552
Height distribution for all adults
height_counts <- height_counts_men + height_counts_women
Tick labels for heights in inches
height_hist_names <- c("","55","","","","","60","","","","","65","","","","","70","","","","","75")
Bar plots
barplot (height_counts_women, names.arg=height_hist_names, xlab="height", ylab="Count", main="heights of women\n(histogram)")
barplot (height_counts, names.arg=height_hist_names, xlab="height", ylab="Count", main="heights of all adults\n(histogram)")
barplot (weight_counts_women, xlab="weight", ylab="Count", main="weights of women\n(histogram)")
Normal distribution for heights of women
par(mar=c(3,1,3,1), tck=-.02)
curve(dnorm(x,63.7,2.7), 52, 81, xlab="height (inches)", ylab="", bty="n", yaxs="i", main="heights of women\n(normal distribution)", yaxt="n",mgp=c(1.5,.5,0),cex.main=.9)
Normal distribution for heights of men
par(mar=c(3,1,3,1), tck=-.02)
curve(dnorm(x,69.1,2.9), 52, 81, xlab="height (inches)", ylab="", bty="n", yaxs="i", main="heights of men\n(normal distribution)", yaxt="n", mgp=c(1.5,.5,0), cex.main=.9)
Mixture of normals distribution for heights of all adults
par(mar=c(3,1,3,1), tck=-.02)
curve(.52*dnorm(x,63.7,2.7)+.48*dnorm(x,69.1,2.9), 52, 81, xlab="height (inches)", ylab="", bty="n", yaxs="i", main="heights of all adults\n(not a normal distribution)", yaxt="n",mgp=c(1.5,.5,0), cex.main=.9)
Normal distribution for log weights of men
par(mar=c(3,1,3,1), tck=-.02)
curve(dnorm(x,5.13,.17), 4, 6, xlab="logarithm of weight in pounds", ylab="", bty="n", yaxs="i", main="log weights of men\n(normal distribution)", yaxt="n", mgp=c(1.5,.5,0), cex.main=.9)
Log-normal distribution for weights of men
par(mar=c(3,1,3,1), tck=-.02)
curve(dlnorm(x,5.13,.17), 50, 350,xlab="weight in pounds", ylab="", bty="n", yaxs="i", main="weights of men\n(lognormal distribution)", yaxt="n", mgp=c(1.5,.5,0), cex.main=.9)
par(mar=c(2,0,2,0), tck=-.01)
curve(dnorm(x), -4, 4, ylim=c(0, 0.4), xlab="", ylab="", bty="n", yaxs="i", main="normal distribution", xaxt="n", yaxt="n")
axis(1, c(-4, -3, -2, -1, 0, 1, 2, 3, 4), c("", "-3", "-2", "-1", "0", "1", "2", "3", ""), mgp=c(1.5, .5, 0), cex.axis=1.2)
colors <- c("gray70", "gray50", "gray30")
for (i in 3:1){
grid <- seq(-i, i, .01)
polygon(c(grid, i, -i), c(dnorm(grid), 0, 0), col=colors[i])
}
text(0, .35*dnorm(0), "68%", cex=1.3)
text(-1.5, .3*dnorm(1.5), "13.5%", cex=1.3)
text(1.5, .3*dnorm(1.5), "13.5%", cex=1.3)
LS0tCnRpdGxlOiAiUmVncmVzc2lvbiBhbmQgT3RoZXIgU3RvcmllczogSGVpZ2h0cyBhbmQgd2VpZ2h0cyIKYXV0aG9yOiAiQW5kcmV3IEdlbG1hbiwgSmVubmlmZXIgSGlsbCwgQWtpIFZlaHRhcmkiCmRhdGU6ICJgciBmb3JtYXQoU3lzLkRhdGUoKSlgIgpvdXRwdXQ6CiAgaHRtbF9kb2N1bWVudDoKICAgIHRoZW1lOiByZWFkYWJsZQogICAgdG9jOiB0cnVlCiAgICB0b2NfZGVwdGg6IDIKICAgIHRvY19mbG9hdDogdHJ1ZQogICAgY29kZV9kb3dubG9hZDogdHJ1ZQotLS0KSGVpZ2h0IGFuZCB3ZWlnaHQgZGlzdHJpYnV0aW9ucyBvZiB3b21lbiBhbmQgbWVuIGlsbHVzdHJhdGluZwpjZW50cmFsIGxpbWl0IHRoZW9yZW0gYW5kIG5vcm1hbCBkaXN0cmlidXRpb24uIFNlZSBDaGFwdGVyIDMgaW4KUmVncmVzc2lvbiBhbmQgT3RoZXIgU3Rvcmllcy4KCi0tLS0tLS0tLS0tLS0KCgpgYGB7ciBzZXR1cCwgaW5jbHVkZT1GQUxTRX0Ka25pdHI6Om9wdHNfY2h1bmskc2V0KG1lc3NhZ2U9RkFMU0UsIGVycm9yPUZBTFNFLCB3YXJuaW5nPUZBTFNFLCBjb21tZW50PU5BKQojIHN3aXRjaCB0aGlzIHRvIFRSVUUgdG8gc2F2ZSBmaWd1cmVzIGluIHNlcGFyYXRlIGZpbGVzCnNhdmVmaWdzIDwtIEZBTFNFCmBgYAoKIyMjIyBMb2FkIHBhY2thZ2VzCgpgYGB7ciB9CmxpYnJhcnkoInJwcm9qcm9vdCIpCnJvb3Q8LWhhc19maWxlKCIuUk9TLUV4YW1wbGVzLXJvb3QiKSRtYWtlX2ZpeF9maWxlKCkKYGBgCgojIyMjIFN1bW1hcnkgZGF0YSBvZiBoZWlnaHQgYW5kIHdlaWdodCBkaXN0cmlidXRpb25zIG9mIHdvbWVuIGFuZCBtZW4KCmBgYHtyIH0KaGVpZ2h0X2NvdW50c193b21lbiA8LSBjKDgwLDEwNywyOTYsNjk1LDE2MTIsMjY4MCw0NjQ1LDgyMDEsOTk0OCwxMTczMywxMDI3MCw5OTQyLDYxODEsMzk5MCwyMTMxLDExNTQsMjQ1LDI1NywwLDAsMCwwKSoxMDMzOS83NDE2Nwp3ZWlnaHRfY291bnRzX3dvbWVuIDwtIGMoMzYyLDE2NzcsNDU3Miw5MzYzLDExNDIwLDEyMzI4LDk0MzUsNzAyMyw1MDQ3LDM2MjEsMjc1MywyMDgxLDEyMzIsODg3LDIzNjYpKjEwMzM5Lzc0MTY3CmhlaWdodF9jb3VudHNfbWVuIDwtIGMoMCwwLDAsMCwwLDAsMCw1NDIsNjY4LDEyMjEsMjE3NSw0MjEzLDU1MzUsNzk4MCw5NTY2LDk1NzgsODg2Nyw2NzE2LDUwMTksMjc0NSwxNDY0LDEyNjMpKjk5ODMvNjc1NTIKYGBgCgojIyMjIEhlaWdodCBkaXN0cmlidXRpb24gZm9yIGFsbCBhZHVsdHMKCmBgYHtyIH0KaGVpZ2h0X2NvdW50cyA8LSBoZWlnaHRfY291bnRzX21lbiArIGhlaWdodF9jb3VudHNfd29tZW4KYGBgCgojIyMjIFRpY2sgbGFiZWxzIGZvciBoZWlnaHRzIGluIGluY2hlcwoKYGBge3IgfQpoZWlnaHRfaGlzdF9uYW1lcyA8LSBjKCIiLCI1NSIsIiIsIiIsIiIsIiIsIjYwIiwiIiwiIiwiIiwiIiwiNjUiLCIiLCIiLCIiLCIiLCI3MCIsIiIsIiIsIiIsIiIsIjc1IikKYGBgCgojIyMjIEJhciBwbG90cwoKYGBge3IgfQpiYXJwbG90IChoZWlnaHRfY291bnRzX3dvbWVuLCBuYW1lcy5hcmc9aGVpZ2h0X2hpc3RfbmFtZXMsIHhsYWI9ImhlaWdodCIsIHlsYWI9IkNvdW50IiwgbWFpbj0iaGVpZ2h0cyBvZiB3b21lblxuKGhpc3RvZ3JhbSkiKQpiYXJwbG90IChoZWlnaHRfY291bnRzLCBuYW1lcy5hcmc9aGVpZ2h0X2hpc3RfbmFtZXMsIHhsYWI9ImhlaWdodCIsIHlsYWI9IkNvdW50IiwgbWFpbj0iaGVpZ2h0cyBvZiBhbGwgYWR1bHRzXG4oaGlzdG9ncmFtKSIpCmJhcnBsb3QgKHdlaWdodF9jb3VudHNfd29tZW4sIHhsYWI9IndlaWdodCIsIHlsYWI9IkNvdW50IiwgbWFpbj0id2VpZ2h0cyBvZiB3b21lblxuKGhpc3RvZ3JhbSkiKQpgYGAKCiMjIyMgTm9ybWFsIGRpc3RyaWJ1dGlvbiBmb3IgaGVpZ2h0cyBvZiB3b21lbgoKYGBge3IgZXZhbD1GQUxTRSwgaW5jbHVkZT1GQUxTRX0KaWYgKHNhdmVmaWdzKSBwZGYocm9vdCgiVml0YWxzL2ZpZ3MiLCJoZWlnaHRzMWFfd29tZW4ucGRmIiksIGhlaWdodD0yLjUsIHdpZHRoPTMuNSkKYGBgCmBgYHtyIH0KcGFyKG1hcj1jKDMsMSwzLDEpLCB0Y2s9LS4wMikKY3VydmUoZG5vcm0oeCw2My43LDIuNyksIDUyLCA4MSwgeGxhYj0iaGVpZ2h0IChpbmNoZXMpIiwgeWxhYj0iIiwgYnR5PSJuIiwgeWF4cz0iaSIsIG1haW49ImhlaWdodHMgb2Ygd29tZW5cbihub3JtYWwgZGlzdHJpYnV0aW9uKSIsIHlheHQ9Im4iLG1ncD1jKDEuNSwuNSwwKSxjZXgubWFpbj0uOSkKYGBgCmBgYHtyIGV2YWw9RkFMU0UsIGluY2x1ZGU9RkFMU0V9CmlmIChzYXZlZmlncykgZGV2Lm9mZigpCmBgYAoKIyMjIyBOb3JtYWwgZGlzdHJpYnV0aW9uIGZvciBoZWlnaHRzIG9mIG1lbgoKYGBge3IgZXZhbD1GQUxTRSwgaW5jbHVkZT1GQUxTRX0KaWYgKHNhdmVmaWdzKSBwZGYocm9vdCgiVml0YWxzL2ZpZ3MiLCJoZWlnaHRzMWFfbWVuLnBkZiIpLCBoZWlnaHQ9Mi41LCB3aWR0aD0zLjUpCmBgYApgYGB7ciB9CnBhcihtYXI9YygzLDEsMywxKSwgdGNrPS0uMDIpCmN1cnZlKGRub3JtKHgsNjkuMSwyLjkpLCA1MiwgODEsIHhsYWI9ImhlaWdodCAoaW5jaGVzKSIsIHlsYWI9IiIsIGJ0eT0ibiIsIHlheHM9ImkiLCBtYWluPSJoZWlnaHRzIG9mIG1lblxuKG5vcm1hbCBkaXN0cmlidXRpb24pIiwgeWF4dD0ibiIsIG1ncD1jKDEuNSwuNSwwKSwgY2V4Lm1haW49LjkpCmBgYApgYGB7ciBldmFsPUZBTFNFLCBpbmNsdWRlPUZBTFNFfQppZiAoc2F2ZWZpZ3MpIGRldi5vZmYoKQpgYGAKCiMjIyMgTWl4dHVyZSBvZiBub3JtYWxzIGRpc3RyaWJ1dGlvbiBmb3IgaGVpZ2h0cyBvZiBhbGwgYWR1bHRzCgpgYGB7ciBldmFsPUZBTFNFLCBpbmNsdWRlPUZBTFNFfQppZiAoc2F2ZWZpZ3MpIHBkZihyb290KCJWaXRhbHMvZmlncyIsImhlaWdodHMxYi5wZGYiKSwgaGVpZ2h0PTIuNSwgd2lkdGg9My41KQpgYGAKYGBge3IgfQpwYXIobWFyPWMoMywxLDMsMSksIHRjaz0tLjAyKQpjdXJ2ZSguNTIqZG5vcm0oeCw2My43LDIuNykrLjQ4KmRub3JtKHgsNjkuMSwyLjkpLCA1MiwgODEsIHhsYWI9ImhlaWdodCAoaW5jaGVzKSIsIHlsYWI9IiIsIGJ0eT0ibiIsIHlheHM9ImkiLCBtYWluPSJoZWlnaHRzIG9mIGFsbCBhZHVsdHNcbihub3QgYSBub3JtYWwgZGlzdHJpYnV0aW9uKSIsIHlheHQ9Im4iLG1ncD1jKDEuNSwuNSwwKSwgY2V4Lm1haW49LjkpCmBgYApgYGB7ciBldmFsPUZBTFNFLCBpbmNsdWRlPUZBTFNFfQppZiAoc2F2ZWZpZ3MpIGRldi5vZmYoKQpgYGAKCiMjIyMgTm9ybWFsIGRpc3RyaWJ1dGlvbiBmb3IgbG9nIHdlaWdodHMgb2YgbWVuCgpgYGB7ciBldmFsPUZBTFNFLCBpbmNsdWRlPUZBTFNFfQppZiAoc2F2ZWZpZ3MpIHBkZihyb290KCJWaXRhbHMvZmlncyIsIndlaWdodHMxYS5wZGYiKSwgaGVpZ2h0PTIuNSwgd2lkdGg9My41KQpgYGAKYGBge3IgfQpwYXIobWFyPWMoMywxLDMsMSksIHRjaz0tLjAyKQpjdXJ2ZShkbm9ybSh4LDUuMTMsLjE3KSwgNCwgNiwgeGxhYj0ibG9nYXJpdGhtIG9mIHdlaWdodCBpbiBwb3VuZHMiLCB5bGFiPSIiLCBidHk9Im4iLCB5YXhzPSJpIiwgbWFpbj0ibG9nIHdlaWdodHMgb2YgbWVuXG4obm9ybWFsIGRpc3RyaWJ1dGlvbikiLCB5YXh0PSJuIiwgbWdwPWMoMS41LC41LDApLCBjZXgubWFpbj0uOSkKYGBgCmBgYHtyIGV2YWw9RkFMU0UsIGluY2x1ZGU9RkFMU0V9CmlmIChzYXZlZmlncykgZGV2Lm9mZigpCmBgYAoKIyMjIyBMb2ctbm9ybWFsIGRpc3RyaWJ1dGlvbiBmb3Igd2VpZ2h0cyBvZiBtZW4KCmBgYHtyIGV2YWw9RkFMU0UsIGluY2x1ZGU9RkFMU0V9CmlmIChzYXZlZmlncykgcGRmKHJvb3QoIlZpdGFscy9maWdzIiwid2VpZ2h0czFiLnBkZiIpLCBoZWlnaHQ9Mi41LCB3aWR0aD0zLjUpCmBgYApgYGB7ciB9CnBhcihtYXI9YygzLDEsMywxKSwgdGNrPS0uMDIpCmN1cnZlKGRsbm9ybSh4LDUuMTMsLjE3KSwgNTAsIDM1MCx4bGFiPSJ3ZWlnaHQgaW4gcG91bmRzIiwgeWxhYj0iIiwgYnR5PSJuIiwgeWF4cz0iaSIsIG1haW49IndlaWdodHMgb2YgbWVuXG4obG9nbm9ybWFsIGRpc3RyaWJ1dGlvbikiLCB5YXh0PSJuIiwgbWdwPWMoMS41LC41LDApLCBjZXgubWFpbj0uOSkKYGBgCmBgYHtyIGV2YWw9RkFMU0UsIGluY2x1ZGU9RkFMU0V9CmlmIChzYXZlZmlncykgZGV2Lm9mZigpCgpgYGAKYGBge3IgZXZhbD1GQUxTRSwgaW5jbHVkZT1GQUxTRX0KaWYgKHNhdmVmaWdzKSBwZGYocm9vdCgiVml0YWxzL2ZpZ3MiLCJub3JtYWxfcGljdHVyZS5wZGYiKSwgaGVpZ2h0PTMuNSwgd2lkdGg9NywgY29sb3Jtb2RlbD0iZ3JheSIpCmBgYApgYGB7ciB9CnBhcihtYXI9YygyLDAsMiwwKSwgdGNrPS0uMDEpCmN1cnZlKGRub3JtKHgpLCAtNCwgNCwgeWxpbT1jKDAsIDAuNCksIHhsYWI9IiIsIHlsYWI9IiIsIGJ0eT0ibiIsIHlheHM9ImkiLCBtYWluPSJub3JtYWwgZGlzdHJpYnV0aW9uIiwgeGF4dD0ibiIsIHlheHQ9Im4iKQpheGlzKDEsIGMoLTQsIC0zLCAtMiwgLTEsICAwLCAgMSwgMiwgMywgNCksIGMoIiIsICItMyIsICItMiIsICItMSIsICAiMCIsICAiMSIsICIyIiwgIjMiLCAiIiksIG1ncD1jKDEuNSwgLjUsIDApLCBjZXguYXhpcz0xLjIpCmNvbG9ycyA8LSBjKCJncmF5NzAiLCAiZ3JheTUwIiwgImdyYXkzMCIpCmZvciAoaSBpbiAzOjEpewogIGdyaWQgPC0gc2VxKC1pLCBpLCAuMDEpCiAgcG9seWdvbihjKGdyaWQsIGksIC1pKSwgYyhkbm9ybShncmlkKSwgMCwgMCksIGNvbD1jb2xvcnNbaV0pCn0KdGV4dCgwLCAuMzUqZG5vcm0oMCksICI2OCUiLCBjZXg9MS4zKQp0ZXh0KC0xLjUsIC4zKmRub3JtKDEuNSksICIxMy41JSIsIGNleD0xLjMpCnRleHQoMS41LCAuMypkbm9ybSgxLjUpLCAiMTMuNSUiLCBjZXg9MS4zKQpgYGAKYGBge3IgZXZhbD1GQUxTRSwgaW5jbHVkZT1GQUxTRX0KaWYgKHNhdmVmaWdzKSBkZXYub2ZmKCkKYGBgCgo=