library(tidyverse)
## ── Attaching packages ─────────────────────────────────────── tidyverse 1.3.2 ──
## ✔ ggplot2 3.3.6      ✔ purrr   0.3.4 
## ✔ tibble  3.1.8      ✔ dplyr   1.0.10
## ✔ tidyr   1.2.1      ✔ stringr 1.4.1 
## ✔ readr   2.1.2      ✔ forcats 0.5.2 
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()
library(openintro)
## Loading required package: airports
## Loading required package: cherryblossom
## Loading required package: usdata

Exercise 1

For women, there tends to be a more upwards trend or at least a general height range that most tend to fall into. Whereas in men, the majority fell into one category that very few women were able to fall into. In general, the main variation in the aspect is the most common height range among the tested/selected individuals.

download.file("http://www.openintro.org/stat/data/bdims.RData", 
              destfile = "bdims.RData")
load("bdims.RData")

head(bdims)
##   bia.di bii.di bit.di che.de che.di elb.di wri.di kne.di ank.di sho.gi che.gi
## 1   42.9   26.0   31.5   17.7   28.0   13.1   10.4   18.8   14.1  106.2   89.5
## 2   43.7   28.5   33.5   16.9   30.8   14.0   11.8   20.6   15.1  110.5   97.0
## 3   40.1   28.2   33.3   20.9   31.7   13.9   10.9   19.7   14.1  115.1   97.5
## 4   44.3   29.9   34.0   18.4   28.2   13.9   11.2   20.9   15.0  104.5   97.0
## 5   42.5   29.9   34.0   21.5   29.4   15.2   11.6   20.7   14.9  107.5   97.5
## 6   43.3   27.0   31.5   19.6   31.3   14.0   11.5   18.8   13.9  119.8   99.9
##   wai.gi nav.gi hip.gi thi.gi bic.gi for.gi kne.gi cal.gi ank.gi wri.gi age
## 1   71.5   74.5   93.5   51.5   32.5   26.0   34.5   36.5   23.5   16.5  21
## 2   79.0   86.5   94.8   51.5   34.4   28.0   36.5   37.5   24.5   17.0  23
## 3   83.2   82.9   95.0   57.3   33.4   28.8   37.0   37.3   21.9   16.9  28
## 4   77.8   78.8   94.0   53.0   31.0   26.2   37.0   34.8   23.0   16.6  23
## 5   80.0   82.5   98.5   55.4   32.0   28.4   37.7   38.6   24.4   18.0  22
## 6   82.5   80.1   95.3   57.5   33.0   28.0   36.6   36.1   23.5   16.9  21
##    wgt   hgt sex
## 1 65.6 174.0   1
## 2 71.8 175.3   1
## 3 80.7 193.5   1
## 4 72.6 186.5   1
## 5 78.8 187.2   1
## 6 74.8 181.5   1
midms <- subset(bdims, sex== 1)
fdims <- subset(bdims, sex == 0)
par(mfrow=c(1,2))
hist(midms$hgt, ylim=c(0,100),main = "Mens Height",
     ylab= "Stated Height",
     xlab="Height Range in cm",
       col="Lavender")
hist(fdims$hgt,ylim = c(0,100), main = "Womens heigth",
     ylab= "Stated Heigth",
     xlab= "Height Range in cm", 
     col= "Lavender")

Exercise 2

Based on the plot, the data almost follows a normal distribution although exceeding it at times.

fhgtmean <- mean(fdims$hgt)
fhgtsd <- sd(fdims$hgt)

hist(fdims$hgt, 
     probability = TRUE,
     main = "Normal Distribution
     of height among Women", 
     xlab = "Height Range in cm",
     col="Lavender",
     ylim = c(0, 0.06)) #Density

x <- 140:190
y<- dnorm(x = x, mean = fhgtmean, sd = fhgtsd)

Exercise 3

No, not all the plots fall in the line within the depicted normal range, but it’s very similar to the probability of the data provided. Having some outliers in terms of being above the normal/average or lower is to be expected when measuring such a diverse variable.

par(mfrow=c(1,2))
qqnorm(fdims$hgt, 
       main= "womens Height Range
       probability",
       col= "Dark red")
sim_norm <- rnorm(n = length(fdims$hgt), mean = fhgtmean, sd = fhgtsd )
qqnorm(sim_norm,
       main="Sim_Norms,Probability
       of womens height",
       col="Dark Blue")

Exercise 4

Yes, most of the stimulated plots look very similar, consisting of the same average ranges shown in the gathered data, only ever differing slightly in a quantity that fall within the provided ranges.

qqnormsim(fdims$hgt)

Exercise 5

Height among women does seem to stem from a normal distribution, looking at and comparing both the made and stimulated probability plots, the average height seems to remain fairly consistent.

Exercise 6

Questions: 1.) What is the probability that 2 randomly chosen women are above 160 cm based on observation of date?

The probability is very high, as very few margins of women fall below that range, looking from both a provided data point of view and stimulated.

2.) What is the probability that 2 randomly chosen women will be above 70 kg based on observation of data?

Chances are quite low, primarily due to how many women tend to fall under this threshold. Looking at the histogram and Normal distribution furthers emphasizes the low chances of this occurring.

1 - pnorm(q = 182, mean = fhgtmean, sd = fhgtsd)
## [1] 0.004434387
sum(fdims$hgt > 182) / length(fdims$hgt)
## [1] 0.003846154
par(mfrow=c(1,2))
hist(fdims$hgt, 
     probability = TRUE,
     main = "Normal Distribution of height
     among Women", 
     xlab = "Height Range in cm",
     col="Lavender",
     ylim = c(0, 0.06)) #Density
hist(fdims$wgt,
     probability = TRUE, 
     main= "Normal Distribution of Weight 
     among women",
     xlab = "Weight in Kg",
     col="lavender",
     ylim = c(0, 0.06))

par(mfrow=c(1,2))
qqnorm(fdims$hgt,
       main="Normal Distribution (h)
       in Women"
       , col= "purple")
qqnorm(fdims$wgt, 
       main="Normal Distirbution(w) 
       in women",
       col="Magenta")

qqnormsim(fdims$wgt)

LS0tDQp0aXRsZTogIkxhYiA0OiBOb3JtYWwgRGlzdHJpYnV0aW9uIg0KYXV0aG9yOiAiQW5nZWwgT2Nob2EgIg0KZGF0ZTogIjA5LzIzLzIwMjIiDQpvdXRwdXQ6IG9wZW5pbnRybzo6bGFiX3JlcG9ydA0KLS0tDQoNCmBgYHtyfQ0KbGlicmFyeSh0aWR5dmVyc2UpDQpsaWJyYXJ5KG9wZW5pbnRybykNCmBgYA0KDQojIyMgRXhlcmNpc2UgMQ0KRm9yIHdvbWVuLCB0aGVyZSB0ZW5kcyB0byBiZSBhIG1vcmUgdXB3YXJkcyB0cmVuZCBvciBhdCBsZWFzdCBhIGdlbmVyYWwgaGVpZ2h0IHJhbmdlIHRoYXQgbW9zdCB0ZW5kIHRvIGZhbGwgaW50by4gV2hlcmVhcyBpbiBtZW4sIHRoZSBtYWpvcml0eSBmZWxsIGludG8gb25lIGNhdGVnb3J5IHRoYXQgdmVyeSBmZXcgd29tZW4gd2VyZSBhYmxlIHRvIGZhbGwgaW50by4gSW4gZ2VuZXJhbCwgdGhlIG1haW4gdmFyaWF0aW9uIGluIHRoZSBhc3BlY3QgaXMgdGhlIG1vc3QgY29tbW9uIGhlaWdodCByYW5nZSBhbW9uZyB0aGUgdGVzdGVkL3NlbGVjdGVkIGluZGl2aWR1YWxzLg0KYGBge3J9DQpkb3dubG9hZC5maWxlKCJodHRwOi8vd3d3Lm9wZW5pbnRyby5vcmcvc3RhdC9kYXRhL2JkaW1zLlJEYXRhIiwgDQogICAgICAgICAgICAgIGRlc3RmaWxlID0gImJkaW1zLlJEYXRhIikNCmxvYWQoImJkaW1zLlJEYXRhIikNCg0KaGVhZChiZGltcykNCm1pZG1zIDwtIHN1YnNldChiZGltcywgc2V4PT0gMSkNCmZkaW1zIDwtIHN1YnNldChiZGltcywgc2V4ID09IDApDQpwYXIobWZyb3c9YygxLDIpKQ0KaGlzdChtaWRtcyRoZ3QsIHlsaW09YygwLDEwMCksbWFpbiA9ICJNZW5zIEhlaWdodCIsDQogICAgIHlsYWI9ICJTdGF0ZWQgSGVpZ2h0IiwNCiAgICAgeGxhYj0iSGVpZ2h0IFJhbmdlIGluIGNtIiwNCiAgICAgICBjb2w9IkxhdmVuZGVyIikNCmhpc3QoZmRpbXMkaGd0LHlsaW0gPSBjKDAsMTAwKSwgbWFpbiA9ICJXb21lbnMgaGVpZ3RoIiwNCiAgICAgeWxhYj0gIlN0YXRlZCBIZWlndGgiLA0KICAgICB4bGFiPSAiSGVpZ2h0IFJhbmdlIGluIGNtIiwgDQogICAgIGNvbD0gIkxhdmVuZGVyIikNCmBgYA0KDQoNCiMjIyBFeGVyY2lzZSAyDQoNCkJhc2VkIG9uIHRoZSBwbG90LCB0aGUgZGF0YSBhbG1vc3QgZm9sbG93cyBhIG5vcm1hbCBkaXN0cmlidXRpb24gYWx0aG91Z2ggZXhjZWVkaW5nIGl0IGF0IHRpbWVzLiANCmBgYHtyfQ0KZmhndG1lYW4gPC0gbWVhbihmZGltcyRoZ3QpDQpmaGd0c2QgPC0gc2QoZmRpbXMkaGd0KQ0KDQpoaXN0KGZkaW1zJGhndCwgDQogICAgIHByb2JhYmlsaXR5ID0gVFJVRSwNCiAgICAgbWFpbiA9ICJOb3JtYWwgRGlzdHJpYnV0aW9uDQogICAgIG9mIGhlaWdodCBhbW9uZyBXb21lbiIsIA0KICAgICB4bGFiID0gIkhlaWdodCBSYW5nZSBpbiBjbSIsDQogICAgIGNvbD0iTGF2ZW5kZXIiLA0KICAgICB5bGltID0gYygwLCAwLjA2KSkgI0RlbnNpdHkNCiAgICAgDQp4IDwtIDE0MDoxOTANCnk8LSBkbm9ybSh4ID0geCwgbWVhbiA9IGZoZ3RtZWFuLCBzZCA9IGZoZ3RzZCkNCmBgYA0KDQoNCiMjIyBFeGVyY2lzZSAzDQpObywgbm90IGFsbCB0aGUgcGxvdHMgZmFsbCBpbiB0aGUgbGluZSB3aXRoaW4gdGhlIGRlcGljdGVkIG5vcm1hbCByYW5nZSwgYnV0IGl0J3MgdmVyeSBzaW1pbGFyIHRvIHRoZSBwcm9iYWJpbGl0eSBvZiB0aGUgZGF0YSBwcm92aWRlZC4gSGF2aW5nIHNvbWUgb3V0bGllcnMgaW4gdGVybXMgb2YgYmVpbmcgYWJvdmUgdGhlIG5vcm1hbC9hdmVyYWdlIG9yIGxvd2VyIGlzIHRvIGJlIGV4cGVjdGVkIHdoZW4gbWVhc3VyaW5nIHN1Y2ggYSBkaXZlcnNlIHZhcmlhYmxlLiAgDQoNCmBgYHtyfQ0KcGFyKG1mcm93PWMoMSwyKSkNCnFxbm9ybShmZGltcyRoZ3QsIA0KICAgICAgIG1haW49ICJ3b21lbnMgSGVpZ2h0IFJhbmdlDQogICAgICAgcHJvYmFiaWxpdHkiLA0KICAgICAgIGNvbD0gIkRhcmsgcmVkIikNCnNpbV9ub3JtIDwtIHJub3JtKG4gPSBsZW5ndGgoZmRpbXMkaGd0KSwgbWVhbiA9IGZoZ3RtZWFuLCBzZCA9IGZoZ3RzZCApDQpxcW5vcm0oc2ltX25vcm0sDQogICAgICAgbWFpbj0iU2ltX05vcm1zLFByb2JhYmlsaXR5DQogICAgICAgb2Ygd29tZW5zIGhlaWdodCIsDQogICAgICAgY29sPSJEYXJrIEJsdWUiKQ0KYGBgDQoNCg0KIyMjIEV4ZXJjaXNlIDQNClllcywgbW9zdCBvZiB0aGUgc3RpbXVsYXRlZCBwbG90cyBsb29rIHZlcnkgc2ltaWxhciwgY29uc2lzdGluZyBvZiB0aGUgc2FtZSBhdmVyYWdlIHJhbmdlcyBzaG93biBpbiB0aGUgZ2F0aGVyZWQgZGF0YSwgb25seSBldmVyIGRpZmZlcmluZyBzbGlnaHRseSBpbiBhIHF1YW50aXR5IHRoYXQgZmFsbCB3aXRoaW4gdGhlIHByb3ZpZGVkIHJhbmdlcy4NCg0KYGBge3J9DQoNCnFxbm9ybXNpbShmZGltcyRoZ3QpDQpgYGANCg0KDQojIyMgRXhlcmNpc2UgNQ0KDQpIZWlnaHQgYW1vbmcgd29tZW4gZG9lcyBzZWVtIHRvIHN0ZW0gZnJvbSBhIG5vcm1hbCBkaXN0cmlidXRpb24sIGxvb2tpbmcgYXQgYW5kIGNvbXBhcmluZyBib3RoIHRoZSBtYWRlIGFuZCBzdGltdWxhdGVkIHByb2JhYmlsaXR5IHBsb3RzLCB0aGUgYXZlcmFnZSBoZWlnaHQgc2VlbXMgdG8gcmVtYWluIGZhaXJseSBjb25zaXN0ZW50Lg0KYGBge3J9DQoNCmBgYA0KDQoNCiMjIyBFeGVyY2lzZSA2DQoNClF1ZXN0aW9uczoNCjEuKSBXaGF0IGlzIHRoZSBwcm9iYWJpbGl0eSB0aGF0IDIgcmFuZG9tbHkgY2hvc2VuIHdvbWVuIGFyZSBhYm92ZSAxNjAgY20gYmFzZWQgb24gb2JzZXJ2YXRpb24gb2YgZGF0ZT8NCg0KIFRoZSBwcm9iYWJpbGl0eSBpcyB2ZXJ5IGhpZ2gsIGFzIHZlcnkgZmV3IG1hcmdpbnMgb2Ygd29tZW4gZmFsbCBiZWxvdyB0aGF0IHJhbmdlLCBsb29raW5nIGZyb20gYm90aCBhIHByb3ZpZGVkIGRhdGEgcG9pbnQgb2YgdmlldyBhbmQgc3RpbXVsYXRlZC4gDQoNCjIuKSBXaGF0IGlzIHRoZSBwcm9iYWJpbGl0eSB0aGF0IDIgcmFuZG9tbHkgY2hvc2VuIHdvbWVuIHdpbGwgYmUgYWJvdmUgNzAga2cgYmFzZWQgb24gb2JzZXJ2YXRpb24gb2YgZGF0YT8NCg0KIENoYW5jZXMgYXJlIHF1aXRlIGxvdywgcHJpbWFyaWx5IGR1ZSB0byBob3cgbWFueSB3b21lbiB0ZW5kIHRvIGZhbGwgdW5kZXIgdGhpcyB0aHJlc2hvbGQuIExvb2tpbmcgYXQgdGhlIGhpc3RvZ3JhbSBhbmQgTm9ybWFsIGRpc3RyaWJ1dGlvbiBmdXJ0aGVycyBlbXBoYXNpemVzIHRoZSBsb3cgY2hhbmNlcyBvZiB0aGlzIG9jY3VycmluZy4NCg0KDQpgYGB7cn0NCjEgLSBwbm9ybShxID0gMTgyLCBtZWFuID0gZmhndG1lYW4sIHNkID0gZmhndHNkKQ0KDQpzdW0oZmRpbXMkaGd0ID4gMTgyKSAvIGxlbmd0aChmZGltcyRoZ3QpDQpwYXIobWZyb3c9YygxLDIpKQ0KaGlzdChmZGltcyRoZ3QsIA0KICAgICBwcm9iYWJpbGl0eSA9IFRSVUUsDQogICAgIG1haW4gPSAiTm9ybWFsIERpc3RyaWJ1dGlvbiBvZiBoZWlnaHQNCiAgICAgYW1vbmcgV29tZW4iLCANCiAgICAgeGxhYiA9ICJIZWlnaHQgUmFuZ2UgaW4gY20iLA0KICAgICBjb2w9IkxhdmVuZGVyIiwNCiAgICAgeWxpbSA9IGMoMCwgMC4wNikpICNEZW5zaXR5DQpoaXN0KGZkaW1zJHdndCwNCiAgICAgcHJvYmFiaWxpdHkgPSBUUlVFLCANCiAgICAgbWFpbj0gIk5vcm1hbCBEaXN0cmlidXRpb24gb2YgV2VpZ2h0IA0KICAgICBhbW9uZyB3b21lbiIsDQogICAgIHhsYWIgPSAiV2VpZ2h0IGluIEtnIiwNCiAgICAgY29sPSJsYXZlbmRlciIsDQogICAgIHlsaW0gPSBjKDAsIDAuMDYpKQ0KDQpwYXIobWZyb3c9YygxLDIpKQ0KcXFub3JtKGZkaW1zJGhndCwNCiAgICAgICBtYWluPSJOb3JtYWwgRGlzdHJpYnV0aW9uIChoKQ0KICAgICAgIGluIFdvbWVuIg0KICAgICAgICwgY29sPSAicHVycGxlIikNCnFxbm9ybShmZGltcyR3Z3QsIA0KICAgICAgIG1haW49Ik5vcm1hbCBEaXN0aXJidXRpb24odykgDQogICAgICAgaW4gd29tZW4iLA0KICAgICAgIGNvbD0iTWFnZW50YSIpDQpxcW5vcm1zaW0oZmRpbXMkd2d0KQ0KYGBgDQoNCg0KDQo=