url="https://pengdsci.github.io/STA321/ww02/w02-Protein_Supply_Quantity_Data.csv"
protein = read.csv(url, header = TRUE)
var.name = names(protein)
kable(data.frame(var.name))
var.name
Country
AlcoholicBeverages
AnimalProducts
Animalfats
CerealsExcludingBeer
Eggs
FishSeafood
FruitsExcludingWine
Meat
MilkExcludingButter
Offals
Oilcrops
Pulses
Spices
StarchyRoots
Stimulants
Treenuts
VegetalProducts
VegetableOils
Vegetables
Miscellaneous
Obesity
Confirmed
Deaths
Recovered
Active
Population

1 Variable

The variable I chose is stimulants because I expected the percentage of protein intake attributed to stimulant foods to be negligible. Products categorized as such are not often marketed as protein sources. Therefore, the aim of the analysis is to determine whether the data support this expectation.

stimval = protein$Stimulants
sample.size = dim(protein)[1]
sample.size
## [1] 170
mean(stimval)
## [1] 0.4412329

2 Confidence Interval (Previously Used)

stimCI = t.test(stimval, conf.level = .95)$conf.int
stimCI
## [1] 0.3824862 0.4999797
## attr(,"conf.level")
## [1] 0.95

3 Bootstrap CI

bt.stim.mean.vec = NULL
for(i in 1:5000){ith.stim.sample = sample(x = stimval, size = sample.size, replace = TRUE)
  bt.stim.mean.vec[i] = mean(ith.stim.sample)}

stimbootCI = quantile(bt.stim.mean.vec, c(0.025, 0.975))
stimbootCI
##      2.5%     97.5% 
## 0.3852853 0.5021964

4 Bootstrap sampling distribution

hist(bt.stim.mean.vec, breaks = 14, xlab = "Bootstrap sample means for Stimulants", main = " Bootstrap Sampling Distribution \n of Stimulant Sample Means")

5 Comparison and Findings

The 95% CI using the t-test (0.3825, 0.5), and the 95% bootstrap confidence interval (0.3853, 0.5022) are very similar. The lower end differs by a small amount but the upper ends are nearly identical. This means that there is 95% confidence that the population mean percentage of protein intake stemming from stimulants lies within both intervals. The findings support our expectation since food categorized as stimulants account for about .44% of protein intake.

LS0tDQp0aXRsZTogJ1NUQTMyMTogV2VlayAjMDIgQXNzaWdubWVudCcNCmF1dGhvcjogJycNCmRhdGU6ICIiDQpvdXRwdXQ6DQogIGh0bWxfZG9jdW1lbnQ6DQogICAgdG9jOiB5ZXMNCiAgICB0b2NfZmxvYXQ6IHllcw0KICAgIHRvY19kZXB0aDogNA0KICAgIGZpZ193aWR0aDogNg0KICAgIGZpZ19oZWlnaHQ6IDQNCiAgICBmaWdfY2FwdGlvbjogeWVzDQogICAgbnVtYmVyX3NlY3Rpb25zOiB5ZXMNCiAgICB0b2NfY29sbGFwc2VkOiB5ZXMNCiAgICBjb2RlX2ZvbGRpbmc6IGhpZGUNCiAgICBjb2RlX2Rvd25sb2FkOiB5ZXMNCiAgICBzbW9vdGhfc2Nyb2xsOiB5ZXMNCiAgICB0aGVtZTogbHVtZW4NCiAgcGRmX2RvY3VtZW50OiANCiAgICB0b2M6IHllcw0KICAgIHRvY19kZXB0aDogNA0KICAgIGZpZ19jYXB0aW9uOiB5ZXMNCiAgICBudW1iZXJfc2VjdGlvbnM6IHllcw0KICB3b3JkX2RvY3VtZW50Og0KICAgIHRvYzogeWVzDQogICAgdG9jX2RlcHRoOiAnNCcNCi0tLQ0KDQo8c3R5bGUgdHlwZT0idGV4dC9jc3MiPg0KaDEudGl0bGUgew0KICBmb250LXNpemU6IDIwcHg7DQogIGNvbG9yOiBEYXJrUmVkOw0KICB0ZXh0LWFsaWduOiBjZW50ZXI7DQp9DQpoNC5hdXRob3IgeyAvKiBIZWFkZXIgNCAtIGFuZCB0aGUgYXV0aG9yIGFuZCBkYXRhIGhlYWRlcnMgdXNlIHRoaXMgdG9vICAqLw0KICAgIGZvbnQtc2l6ZTogMThweDsNCiAgZm9udC1mYW1pbHk6ICJUaW1lcyBOZXcgUm9tYW4iLCBUaW1lcywgc2VyaWY7DQogIGNvbG9yOiBEYXJrUmVkOw0KICB0ZXh0LWFsaWduOiBjZW50ZXI7DQp9DQpoNC5kYXRlIHsgLyogSGVhZGVyIDQgLSBhbmQgdGhlIGF1dGhvciBhbmQgZGF0YSBoZWFkZXJzIHVzZSB0aGlzIHRvbyAgKi8NCiAgZm9udC1zaXplOiAxOHB4Ow0KICBmb250LWZhbWlseTogIlRpbWVzIE5ldyBSb21hbiIsIFRpbWVzLCBzZXJpZjsNCiAgY29sb3I6IERhcmtCbHVlOw0KICB0ZXh0LWFsaWduOiBjZW50ZXI7DQp9DQpoMSB7IC8qIEhlYWRlciAzIC0gYW5kIHRoZSBhdXRob3IgYW5kIGRhdGEgaGVhZGVycyB1c2UgdGhpcyB0b28gICovDQogICAgZm9udC1zaXplOiAyMnB4Ow0KICAgIGZvbnQtZmFtaWx5OiAiVGltZXMgTmV3IFJvbWFuIiwgVGltZXMsIHNlcmlmOw0KICAgIGNvbG9yOiBkYXJrcmVkOw0KICAgIHRleHQtYWxpZ246IGNlbnRlcjsNCn0NCmgyIHsgLyogSGVhZGVyIDMgLSBhbmQgdGhlIGF1dGhvciBhbmQgZGF0YSBoZWFkZXJzIHVzZSB0aGlzIHRvbyAgKi8NCiAgICBmb250LXNpemU6IDE4cHg7DQogICAgZm9udC1mYW1pbHk6ICJUaW1lcyBOZXcgUm9tYW4iLCBUaW1lcywgc2VyaWY7DQogICAgY29sb3I6IG5hdnk7DQogICAgdGV4dC1hbGlnbjogbGVmdDsNCn0NCg0KaDMgeyAvKiBIZWFkZXIgMyAtIGFuZCB0aGUgYXV0aG9yIGFuZCBkYXRhIGhlYWRlcnMgdXNlIHRoaXMgdG9vICAqLw0KICAgIGZvbnQtc2l6ZTogMTVweDsNCiAgICBmb250LWZhbWlseTogIlRpbWVzIE5ldyBSb21hbiIsIFRpbWVzLCBzZXJpZjsNCiAgICBjb2xvcjogbmF2eTsNCiAgICB0ZXh0LWFsaWduOiBsZWZ0Ow0KfQ0KDQpoNCB7IC8qIEhlYWRlciA0IC0gYW5kIHRoZSBhdXRob3IgYW5kIGRhdGEgaGVhZGVycyB1c2UgdGhpcyB0b28gICovDQogICAgZm9udC1zaXplOiAxOHB4Ow0KICAgIGZvbnQtZmFtaWx5OiAiVGltZXMgTmV3IFJvbWFuIiwgVGltZXMsIHNlcmlmOw0KICAgIGNvbG9yOiBkYXJrcmVkOw0KICAgIHRleHQtYWxpZ246IGxlZnQ7DQp9DQo8L3N0eWxlPg0KDQoNCmBgYHtyIHNldHVwLCBpbmNsdWRlPUZBTFNFfQ0KIyBjb2RlIGNodW5rIHNwZWNpZmllcyB3aGV0aGVyIHRoZSBSIGNvZGUsIHdhcm5pbmdzLCBhbmQgb3V0cHV0IA0KIyB3aWxsIGJlIGluY2x1ZGVkIGluIHRoZSBvdXRwdXQgZmlsZXMuDQpsaWJyYXJ5KGtuaXRyKQ0Ka25pdHI6Om9wdHNfY2h1bmskc2V0KGVjaG8gPSBUUlVFLCAgICAgICAgICAgIyBpbmNsdWRlIGNvZGUgY2h1bmsgaW4gdGhlIG91dHB1dCBmaWxlDQogICAgICAgICAgICAgICAgICAgICAgd2FybmluZyA9IEZBTFNFLCAgICAgICAjIHNvbWV0aW1lcywgeW91IGNvZGUgbWF5IHByb2R1Y2Ugd2FybmluZyBtZXNzYWdlcywNCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAjIHlvdSBjYW4gY2hvb3NlIHRvIGluY2x1ZGUgdGhlIHdhcm5pbmcgbWVzc2FnZXMgaW4NCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAjIHRoZSBvdXRwdXQgZmlsZS4gDQogICAgICAgICAgICAgICAgICAgICAgcmVzdWx0cyA9IFRSVUUgICAgICAgICAgIyB5b3UgY2FuIGFsc28gZGVjaWRlIHdoZXRoZXIgdG8gaW5jbHVkZSB0aGUgb3V0cHV0DQogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIyBpbiB0aGUgb3V0cHV0IGZpbGUuDQogICAgICAgICAgICAgICAgICAgICAgKSAgIA0KYGBgDQoNCg0KDQpgYGB7cn0NCnVybD0iaHR0cHM6Ly9wZW5nZHNjaS5naXRodWIuaW8vU1RBMzIxL3d3MDIvdzAyLVByb3RlaW5fU3VwcGx5X1F1YW50aXR5X0RhdGEuY3N2Ig0KcHJvdGVpbiA9IHJlYWQuY3N2KHVybCwgaGVhZGVyID0gVFJVRSkNCnZhci5uYW1lID0gbmFtZXMocHJvdGVpbikNCmthYmxlKGRhdGEuZnJhbWUodmFyLm5hbWUpKQ0KYGBgDQoNCg0KIyBWYXJpYWJsZQ0KDQpUaGUgdmFyaWFibGUgSSBjaG9zZSBpcyBzdGltdWxhbnRzIGJlY2F1c2UgSSBleHBlY3RlZCB0aGUgcGVyY2VudGFnZSBvZiBwcm90ZWluIGludGFrZSBhdHRyaWJ1dGVkIHRvIHN0aW11bGFudCBmb29kcyB0byBiZSBuZWdsaWdpYmxlLiBQcm9kdWN0cyBjYXRlZ29yaXplZCBhcyBzdWNoIGFyZSBub3Qgb2Z0ZW4gbWFya2V0ZWQgYXMgcHJvdGVpbiBzb3VyY2VzLiBUaGVyZWZvcmUsIHRoZSBhaW0gb2YgdGhlIGFuYWx5c2lzIGlzIHRvIGRldGVybWluZSB3aGV0aGVyIHRoZSBkYXRhIHN1cHBvcnQgdGhpcyBleHBlY3RhdGlvbi4gDQoNCmBgYHtyfQ0Kc3RpbXZhbCA9IHByb3RlaW4kU3RpbXVsYW50cw0Kc2FtcGxlLnNpemUgPSBkaW0ocHJvdGVpbilbMV0NCnNhbXBsZS5zaXplDQptZWFuKHN0aW12YWwpDQpgYGANCg0KIyBDb25maWRlbmNlIEludGVydmFsIChQcmV2aW91c2x5IFVzZWQpDQoNCmBgYHtyfQ0Kc3RpbUNJID0gdC50ZXN0KHN0aW12YWwsIGNvbmYubGV2ZWwgPSAuOTUpJGNvbmYuaW50DQpzdGltQ0kNCmBgYA0KDQoNCiMgQm9vdHN0cmFwIENJDQoNCg0KYGBge3J9DQpidC5zdGltLm1lYW4udmVjID0gTlVMTA0KZm9yKGkgaW4gMTo1MDAwKXtpdGguc3RpbS5zYW1wbGUgPSBzYW1wbGUoeCA9IHN0aW12YWwsIHNpemUgPSBzYW1wbGUuc2l6ZSwgcmVwbGFjZSA9IFRSVUUpDQogIGJ0LnN0aW0ubWVhbi52ZWNbaV0gPSBtZWFuKGl0aC5zdGltLnNhbXBsZSl9DQoNCnN0aW1ib290Q0kgPSBxdWFudGlsZShidC5zdGltLm1lYW4udmVjLCBjKDAuMDI1LCAwLjk3NSkpDQpzdGltYm9vdENJDQoNCmBgYA0KDQoNCiMgQm9vdHN0cmFwIHNhbXBsaW5nIGRpc3RyaWJ1dGlvbg0KDQoNCmBgYHtyfQ0KaGlzdChidC5zdGltLm1lYW4udmVjLCBicmVha3MgPSAxNCwgeGxhYiA9ICJCb290c3RyYXAgc2FtcGxlIG1lYW5zIGZvciBTdGltdWxhbnRzIiwgbWFpbiA9ICIgQm9vdHN0cmFwIFNhbXBsaW5nIERpc3RyaWJ1dGlvbiBcbiBvZiBTdGltdWxhbnQgU2FtcGxlIE1lYW5zIikNCmBgYA0KDQoNCg0KIyBDb21wYXJpc29uIGFuZCBGaW5kaW5ncw0KDQpUaGUgOTUlIENJIHVzaW5nIHRoZSB0LXRlc3QgKGByIHJvdW5kKHN0aW1DSVsxXSwgNClgLCBgciByb3VuZChzdGltQ0lbMl0sIDQpYCksIGFuZCB0aGUgOTUlIGJvb3RzdHJhcCBjb25maWRlbmNlIGludGVydmFsIChgciByb3VuZChzdGltYm9vdENJWzFdLCA0KWAsIGByIHJvdW5kKHN0aW1ib290Q0lbMl0sNClgKSBhcmUgdmVyeSBzaW1pbGFyLiBUaGUgbG93ZXIgZW5kIGRpZmZlcnMgYnkgYSBzbWFsbCBhbW91bnQgYnV0IHRoZSB1cHBlciBlbmRzIGFyZSBuZWFybHkgaWRlbnRpY2FsLiBUaGlzIG1lYW5zIHRoYXQgdGhlcmUgaXMgOTUlIGNvbmZpZGVuY2UgdGhhdCB0aGUgcG9wdWxhdGlvbiBtZWFuIHBlcmNlbnRhZ2Ugb2YgcHJvdGVpbiBpbnRha2Ugc3RlbW1pbmcgZnJvbSBzdGltdWxhbnRzIGxpZXMgd2l0aGluIGJvdGggaW50ZXJ2YWxzLiBUaGUgZmluZGluZ3Mgc3VwcG9ydCBvdXIgZXhwZWN0YXRpb24gc2luY2UgZm9vZCBjYXRlZ29yaXplZCBhcyBzdGltdWxhbnRzIGFjY291bnQgZm9yIGFib3V0IC40NCUgb2YgcHJvdGVpbiBpbnRha2UuICANCg0KDQoNCg0KDQo=