library(tidyverse)
## ── Attaching packages ─────────────────────────────────────── tidyverse 1.3.1 ──
## ✓ ggplot2 3.3.5 ✓ purrr 0.3.4
## ✓ tibble 3.1.4 ✓ dplyr 1.0.7
## ✓ tidyr 1.1.3 ✓ stringr 1.4.0
## ✓ readr 2.0.1 ✓ forcats 0.5.1
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## x dplyr::filter() masks stats::filter()
## x dplyr::lag() masks stats::lag()
library(grid)
Answer: The probability of getting a sum of 1 from a pair of fair dice is 0.
Answer: The probability of getting a sum of 5 from a pair of fair dice is 4/36 = 11.11%.
Answer: The probability of getting a sum of 5 from a pair of fair dice is 1/36 = 2.78%
Answer: No, there are 4.2% of the population living below the poverty line and speaking a language other than English.
library(VennDiagram)
## Loading required package: futile.logger
grid.newpage()
draw.pairwise.venn(14.6, 20.7, 4.2, category = c("Poverty", "Other Language"), Ity = rep ("blank", 2), fill = c("green", "orange"), alpha = rep(0.5, 2), cat.pos = c(0,0), cat.dist = rep(0.025, 2))
## (polygon[GRID.polygon.1], polygon[GRID.polygon.2], polygon[GRID.polygon.3], polygon[GRID.polygon.4], text[GRID.text.5], text[GRID.text.6], text[GRID.text.7], text[GRID.text.8], text[GRID.text.9])
=> 14.6% - 4.2% = 10.4%
=> 14.6 + 20.7 - 4.2 = 31.1%
100% - (20.7 + 14.6 - 4.2) = 68.9%
=> Those events aren’t independent.
Assortative mating. (3.18, p. 111) Assortative mating is a nonrandom mating pattern where individuals with similar genotypes and/or phenotypes mate with one another more frequently than what would be expected under a random mating pattern. Researchers studying this topic collected data on eye colors of 204 Scandinavian men and their female partners. The table below summarizes the results. For simplicity, we only include heterosexual relationships in this exercise.
Partner (female)
Blue Brown Green Total
Blue 78 23 13 114
Brown 19 23 12 54
Green 11 9 16 36
Total 108 55 41 204
f_blue <- 108 / 204
f_brown <- 55 / 204
f_green <- 41 / 204
m_blue <- 114 / 204
m_brown <- 54 / 204
m_green <- 36 / 204
both_blue <- 78 / 204
both_brown <- 54 / 204
both_green <- 36 / 204
both_blue <- 78 / 204
both_brown <- 23 / 204
both_green <- 16 / 204
m_brown_f_blue <- 19 / 204
m_green_f_blue <- 11 / 204
either_blue <- f_blue + m_blue - both_blue
either_blue
## [1] 0.7058824
m_blue_both_blue <- both_blue / m_blue
m_blue_both_blue
## [1] 0.6842105
p_m_brown_f_blue <- m_brown_f_blue / m_brown
p_m_brown_f_blue
## [1] 0.3518519
p_m_green_f_blue <- m_green_f_blue / m_green
p_m_green_f_blue
## [1] 0.3055556
=> No, it appears that male eye color and their partner’s eye color are dependent.
Books on a bookshelf. (3.26, p. 114) The table below shows the distribution of books on a bookcase based on whether they are nonfiction or fiction and hardcover or paperback.
Format
Hardcover Paperback Total
Fiction 13 59 72
Nonfiction 15 8 23
Total 28 67 95
prob <- paste(round(((28/95)*(59/94))*100, digits = 2), "%", sep = "")
prob
## [1] "18.5%"
prob <- paste(round(((28/95)*(59/94))*100, digits = 2), "%", sep = "")
prob
## [1] "18.5%"
prob <- paste(round(((72/9)*(28/95))*100, digits = 2), "%", sep = "")
prob
## [1] "235.79%"
=> The observations are almost independent even when sampling with no replacement.
Baggage fees. (3.34, p. 124) An airline charges the following baggage fees: $25 for the first bag and $35 for the second. Suppose 54% of passengers have no checked luggage, 34% have one piece of checked luggage and 12% have two pieces. We suppose a negligible portion of people check more than two bags.
fees <- c(0, 25, 35)
proportion <- c(0.54, 0.34, 0.12)
model <- fees*proportion
mean(model)
## [1] 4.233333
sd(model)
## [1] 4.250098
sum(model*120)
## [1] 1524
120*sd(model)
## [1] 510.0118
Income and gender. (3.38, p. 128) The relative frequency table below displays the distribution of annual total personal income (in 2009 inflation-adjusted dollars) for a representative sample of 96,420,486 Americans. These data come from the American Community Survey for 2005-2009. This sample is comprised of 59% males and 41% females.
Income Total
$1 to $9,999 or loss 2.2%
$10,000 to $14,999 4.7%
$15,000 to $24,999 15.8%
$25,000 to $34,999 18.3%
$35,000 to $49,999 21.2%
$50,000 to $64,999 13.9%
$65,000 to $74,999 5.8%
$75,000 to $99,999 8.4%
$100,000 or more 9.7%
inc <- c(5, 12.5, 20, 29.5, 42.5, 57.5, 70, 88, 110)
tot <- c(0.022, 0.047, 0.158, 0.183, 0.212, 0.139, 0.058, 0.084, 0.097)
barplot(tot, inc)
sum(tot)
## [1] 1
p_earn_less_than_50 <- sum(tot[0:5])
p_earn_less_than_50
## [1] 0.622
p_earn_less_than_50_F <- sum(tot[0:5])*0.41
p_earn_less_than_50_F
## [1] 0.25502
Female <- 0.718 *0.41
Female
## [1] 0.29438