Solutions Manual for Probability, Statistics, and Data A Fresh Approach Using R, 1e by Darrin Speegle, Bryan Clair (All Chapters)
1 Data in R – Solutions Problem 1 a. 2 4 6; b. 6 10 12; c. 5 Problem 2 a. 1 2 3 (result not stored into x). b. 2 4 6 c. 1 2 3 (result not stored into x) d. 2 3 4 Problem 3 1:10 ## [1] 1 1:10 * 2
2
3
4
## [1] 1:10ˆ2
4
6
8 10 12 14 16 18 20
2 20 38 56 74 92
3 21 39 57 75 93
3
4
5
6
2
3
4
5
2
## [1] ## [19] ## [37] ## [55] ## [73] ## [91] 1:10 + 1 ##
[1]
1 19 37 55 73 91 2
5
6
4 22 40 58 76 94
7
8
9 10
5 23 41 59 77 95
6 24 42 60 78 96
7 25 43 61 79 97
7
8
9 10 11
6
7
8
8 26 44 62 80 98
9 10 27 28 45 46 63 64 81 82 99 100
11 29 47 65 83
12 30 48 66 84
13 31 49 67 85
14 32 50 68 86
15 33 51 69 87
16 34 52 70 88
17 35 53 71 89
1:(10 * 2) ##
[1]
1
9 10 11 12 13 14 15 16 17 18 19 20
rep(c(1,1,2), times = 2) ## [1] 1 1 2 1 1 2 seq(from = 0, to = 10, length.out = 5) ## [1]
0.0
2.5
5.0
7.5 10.0
Problem 4 p <- seq(0,1,0.2) plot(p,p*(1-p),type='l')
1
18 36 54 72 90
0.15
1. Data in R – Solutions
0.00
p * (1 − p)
2
0.0
0.2
0.4
0.6
0.8
1.0
0.6
0.8
1.0
p
0.15 0.00
p * (1 − p)
p <- seq(0,1,0.01) plot(p,p*(1-p),type='l')
0.0
0.2
0.4 p
Problem 5 sum((1:100)ˆ2) ## [1] 338350 Problem 6 x <- seq(from = 10, to = 30, by = 2) length(x) ## [1] 11 x[2] ## [1] 12 x[1:5] ## [1] 10 12 14 16 18 x[1:3*2] ## [1] 12 16 20 x[1:(3*2)] ## [1] 10 12 14 16 18 20
1. Data in R – Solutions
3
x > 25 ##
[1] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
TRUE
TRUE
TRUE
x[x > 25] ## [1] 26 28 30 x[-1] ##
[1] 12 14 16 18 20 22 24 26 28 30
x[-1:-3] ## [1] 16 18 20 22 24 26 28 30 Problem 7 mean(rivers) ## [1] 591.1844 sd(rivers) ## [1] 493.8708 hist(rivers)
80 40 0
Frequency
Histogram of rivers
0
1000
2000
3000
4000
rivers summary(rivers) ## ##
Min. 1st Qu. 135.0 310.0
Median 425.0
Mean 3rd Qu. 591.2 680.0
Max. 3710.0
max(rivers) ## [1] 3710 min(rivers) ## [1] 135 rivers[rivers > 1000] ## [1] 1459 1450 1243 2348 1171 3710 2315 2533 1306 1054 1270 1885 1100 1205 1038 ## [16] 1770
4
1. Data in R – Solutions
Problem 8 str(airquality) ## 'data.frame': ## $ Ozone : int ## $ Solar.R: int ## $ Wind : num ## $ Temp : int ## $ Month : int ## $ Day : int
153 obs. of 6 variables: 41 36 12 18 NA 28 23 19 8 NA ... 190 118 149 313 NA NA 299 99 19 194 ... 7.4 8 12.6 11.5 14.3 14.9 8.6 13.8 20.1 8.6 ... 67 72 74 62 56 66 65 59 61 69 ... 5 5 5 5 5 5 5 5 5 5 ... 1 2 3 4 5 6 7 8 9 10 ...
153 observations of 6 variables, named Ozone, Solar.R, Wind, Temp, Month, Day. They are all type int except for Wind, which is type num. Ozone, Solar.R, and Temp would be more natural as num types. Month and Day could be stored as factor types. Problem 9 a. table(state.region) ## state.region ## Northeast ## 9
South North Central 16 12
West 13
b. state.name[state.area < 10000] ## [1] "Connecticut" "Delaware" ## [5] "New Hampshire" "New Jersey"
"Hawaii" "Rhode Island"
"Massachusetts" "Vermont"
"Mazda RX4 Wag" "Datsun 710" "Merc 280" "Merc 280C" "Toyota Corolla" "Fiat X1-9"
"Merc 240D" "Fiat 128" "Volvo 142E"
c. state.name[which.min(state.center$y)] ## [1] "Florida" Problem 10 row.names(mtcars)[mtcars$gear == 4] ## ## ##
[1] "Mazda RX4" [5] "Merc 230" [9] "Honda Civic"
row.names(mtcars)[mtcars$gear == 4 & mtcars$am == 1] ## [1] "Mazda RX4" ## [5] "Honda Civic"
"Mazda RX4 Wag" "Datsun 710" "Toyota Corolla" "Fiat X1-9"
"Fiat 128" "Volvo 142E"
row.names(mtcars)[mtcars$gear == 4 | mtcars$am == 1] ## [1] "Mazda RX4" ## [5] "Merc 230" ## [9] "Honda Civic" ## [13] "Lotus Europa" ## [17] "Volvo 142E"
"Mazda RX4 Wag" "Datsun 710" "Merc 280" "Merc 280C" "Toyota Corolla" "Fiat X1-9" "Ford Pantera L" "Ferrari Dino"
mean(mtcars$mpg[mtcars$carb == 2])
"Merc 240D" "Fiat 128" "Porsche 914-2" "Maserati Bora"
1. Data in R – Solutions
5
## [1] 22.4 Problem 11 mtcars$am <- factor(mtcars$am, levels = c(0, 1), labels = c("auto", "manual")) table(mtcars$am) ## ## ##
auto manual 19 13
table(mtcars$am[mtcars$mpg > 25]) ## ## ##
auto manual 0 6
Problem 12 a. 54 observations of 3 variables; b. Beef, Meat, Poultry; c. 645; d. 190 max(hot_dogs[hot_dogs$type == "Beef","calories"]) ## [1] 190 Problem 13 a. 70 obs. of 6 variables. class and trade are type Factor. sober, drinks, and n are type int. wage is type num. b. Profession #23, factory worker, is the lowest paid. c. 604 workers were surveyed d. The average wage of all 604 workers was 24.60 shillings/week. library(HistData) which.min(DrinksWages$wage) ## [1] 23 DrinksWages[23,] ## class trade sober drinks wage n ## 23 A factory worker 1 3 12 4 sum(DrinksWages$n) ## [1] 604 sum(DrinksWages$wage * DrinksWages$n)/604 ## [1] 24.59782 Problem 14 library(Lahman) a. 102816 obs. of 22 variables c,d,e with base R: max(Batting$X3B) ## [1] 36
6
1. Data in R – Solutions
Batting[which.max(Batting$X3B),c("playerID","yearID","X3B")] ## playerID yearID X3B ## 13805 wilsoch01 1912 36 recent<-Batting[Batting$yearID >= 1960,c("playerID","yearID","X3B")] recent[which.max(recent$X3B),] ## playerID yearID X3B ## 89181 grandcu01 2007 23 wilsoch01 hit 36 triples in 1912. Since 1960, It’s grandcu01 (Curtis Granderson) with 23 in 2007. Alternately, c,d,e with dplyr library: head(arrange(Batting,desc(X3B)),1) ## playerID yearID stint teamID lgID G AB R H X2B X3B HR RBI SB CS BB SO ## 1 wilsoch01 1912 1 PIT NL 152 583 80 175 19 36 11 95 16 NA 35 67 ## IBB HBP SH SF GIDP ## 1 NA 2 23 NA NA recent <- filter(Batting, yearID > 1960) head(arrange(recent,desc(X3B)),1) ## playerID yearID stint teamID lgID G AB R H X2B X3B HR RBI SB CS BB ## 1 grandcu01 2007 1 DET AL 158 612 122 185 38 23 23 74 26 1 52 ## SO IBB HBP SH SF GIDP ## 1 141 3 5 5 2 3 Problem 15 a. 803 pass b. 44.76% pass c. table(bechdel$year) d. 2010; which.max(table(bechdel$year)) e. 5 f. bechdel[bechdel$binary == "PASS",] g. bechdel[!is.na(bechdel$domgross),]
2 Probability – Solutions Problem 1 The probability that one die is twice the other is 1/6. Problem 2 a. P (difference = 0) = 1/6 b. P (difference = 4) = 1/9 Problem 3 a. The sample space consists of the following 15 ordered pairs: (1,2), (1,3), (1,4), (1,5), (1,6), (2,3), (2,4), (2,5), (2,6), (3,4), (3,5), (3,6), (4,5), (4,6), (5,6). b. E = {(1, 4), (2, 3)}. c. P (E) = 2/15. d. P (F ) = 0. Problem 4 a. About 11 percent. mean(replicate(10000, { sum(sample(1:8, 2, TRUE)) == 8 })) ## [1] 0.1092 b. About 23 percent. mean(replicate(10000, { any(sample(1:8, 2, TRUE) == 2) })) ## [1] 0.2282 Problem 5 a. 0.80; b. 0.47; c. 0.61; d. 0.013 mmdist <- c(0.14, 0.13, 0.20, 0.12, 0.20, 0.21) mmcolors <- c('Yel','Red','Org','Brn','Grn','Blu') mean(replicate(10000,any(sample(mmcolors,4,replace=TRUE,prob=mmdist)=='Blu'))) ## [1] 0.6049 mean(replicate(10000,anyDuplicated(sample(mmcolors,6,replace=TRUE,prob=mmdist)) == 0)) ## [1] 0.0135 Problem 6 About 0.065. mean(replicate(10000,{ bag <- sample(mmcolors,30,replace=TRUE,prob=mmdist); blueCount <- sum(bag == 'Blu'); orangeCount <- sum(bag == 'Org'); (blueCount >= 9) & (orangeCount >= 6) })) ## [1] 0.0647
7
8
2. Probability – Solutions
Problem 7 About 38%. P (same) = P (OO) + P (AA) + P (BB) + P (ABAB) = 0.452 + 0.402 + 0.112 + 0.042 = 0.3762. Or simulate: types <- c("O", "A", "B", "AB") p <- c(0.45, 0.40, 0.11, 0.04) mean(replicate(10000,sample(types,1,prob=p) == sample(types,1,prob=p))) ## [1] 0.3813 Problem 8 mean(replicate(10000,sum(sample(1:6,2,replace=TRUE)) == 10)) ## [1] 0.0878 3/36 ## [1] 0.08333333 Problem 9 mean(replicate(10000,sum(sample(0:1,7,replace=TRUE)) == 3)) ## [1] 0.2719 choose(7,3)/128 ## [1] 0.2734375 Problem 10 About 0.56. mean(replicate(10000,{roll <- sum(sample(1:6,5,replace=TRUE)); roll >= 15 & roll <= 20})) ## [1] 0.5519 Problem 11 mean(replicate(10000, {dieRoll <- sample(1:6, 20, replace = TRUE); 20 %in% cumsum(dieRoll)})) ## [1] 0.289 Problem 12
0 1000
rolls <- replicate(10000,sum(sample(1:6,2,replace=TRUE))) barplot(table(rolls))
2
3
4
5
6
7
8
rolls <- replicate(10000,5+sample(c(2,6),1)) barplot(table(rolls))
9
10
11
12
9
0 3000
2. Probability – Solutions
7
11
0 1000
rolls <- replicate(10000,sample(c(1,2,2,3,3,4),1)+sample(c(1,3,4,5,6,8),1)) barplot(table(rolls))
2
3
4
5
6
7
8
9
10
11
12
A sum of two Sicherman dice has the same probability distribution as a sum of two normal dice. Problem 13 If you happen to be born on day 255, like I was: mean(replicate(10000,any(sample(1:365,199,replace=TRUE)==255))) ## [1] 0.4201 1-(364/365)ˆ199 ## [1] 0.420711 Problem 14 num_hours <- 24 * 365 sim_data <- replicate(10000, { birth_hours <- sample(1:num_hours, 100, T) anyDuplicated(birth_hours) > 0 }) mean(sim_data) ## [1] 0.4296 The probability is about 43 percent! Problem 15 The probability is approximately 0.12. most_with_same_birthday <- replicate(10000,max(table(sample(1:365,50,replace=TRUE)))) mean(most_with_same_birthday >= 3) ## [1] 0.121 Problem 16 sum(replicate(100000,length(unique(sample(1:20,100,replace=TRUE))) < 20))/100000 ## [1] 0.11546 Gives (with rounding) 0.113 consistently Problem 17 a. 0.048; b. 0.060
10
2. Probability – Solutions
deck <- rep(c(2:10,10,10,10,11),4) deals <- replicate(100000, sum(sample(deck,2))) mean(deals == 21) ## [1] 0.04828 mean(deals == 19) ## [1] 0.06084 Problem 18 Between .04 and .05. About .047. pp <- replicate(10000, { x1 <- sample(1:1000, 1) x2 <- sample(1:x1, 1) x3 <- sample(1:x2, 1) x4 <- sample(1:x3, 1) return(x4 == 1 && x3 > 1) }) mean(pp) ## [1] 0.0451 Problem 19 About .019. vowels <- c("A","E","I","O","U") mean(replicate(100000,{ hand <- sample(fosdata::scrabble$piece,7); length(intersect(hand,vowels)) == 0 })) ## [1] 0.01895 1 Problem 20 a. 12 ≈ 0.083 b. 16 ≈ 0.167 c. 12
1 2 Problem 21 a. 15 ≈ 0.067 b. 15 ≈ 0.133 c. 12
Problem 22 Disjoint: AD, CD; Independent: AB, BD Problem 23 a. A and C are disjoint. b. B and C are independent. c. P (B|A) = 1. Problem 24 Since B is contained in A ∪ B, P (A ∪ B|B) =
P ((A ∪ B) ∩ B) P (B) = =1 P (B) P (B)
Problem 25 #Solution Needed Problem 26 P (A) = 1/6, P (B) ≈ .42 and P (A ∩ B) ≈ .11. A and B are not independent since P (A ∩ B) 6= P (A)P (B). prob_a <- mean(replicate(10000, { die_roll <- sample(1:6, 3, T) die_roll[1] >= max(die_roll[2:3]) })) prob_a ## [1] 0.4237
2. Probability – Solutions
11
prob_ab <- mean(replicate(10000, { die_roll <- sample(1:6, 3, T) die_roll[1] >= max(die_roll[2:3]) && die_roll[1] == 5 })) prob_ab ## [1] 0.1144 p(1−p) = 21 . Problem 27 The probability is 2p(1−p)
Problem 28 a. 0.934; b. 0.063. Problem 29
0.9 0.5
p^2 + (1 − p)^2
p <- seq(0,1,.05); plot(p,pˆ2 + (1-p)ˆ2, type='l')
0.0
0.2
0.4
0.6
0.8
1.0
p a. 1/2; b. p2 + (1 − p)2 ; d. P (same) = 0.505, P (diff) = 0.495. e. Call same. f. Yes, closer to even. Problem 30 There is only a 40.5% chance a person testing positive has the disease. Let D be the event “has disease” and + be the event “tests positive”. Given P (+|D) = 0.999, P (−|not D) = 0.97 and P (D) = 0.02. First, P (+|not D) = 0.03 so the law of total probability gives P (+) = 0.999 · 0.02 + 0.03 · 0.98 = 0.04938
Now Bayes’ rule gives
P (D|+) = P (+|D) ·
P (D) 0.02 = 0.999 · ≈ 0.405 P (+) 0.04938
Problem 31 Let R be the event “red marble” and B1 and B2 be the events corresponding to the boxes. a. With the law of total probability: P (R) = P (R|B1 )P (B1 ) + P (R|B2 )P (B2 ) =
31 22 1 + = 73 73 3
b. Using Bayes’ rule: P (B1 |R) = P (R|B1 ) Problem 32 a. About 84%.
P (B1 ) 3 1/3 3 = = ≈ 0.249 P (R) 7 1/3 7
12
2. Probability – Solutions
mean(replicate(20000, { box <- sample(0:9, 1); marblesInBox <- c(rep("R", box), rep("B", 9 - box)); marblesDrawn <- sample(marblesInBox, 3, TRUE); if (all(marblesDrawn == "R")) { sample(marblesInBox, 1) == "R" } else NA }), na.rm = TRUE) ## [1] 0.83779 Here is another approach. Let B be the event “three red marbles drawn” and A the event “four red marbles drawn”. Estimate P (B) and P (A ∩ B) to get P (A|B). This is somewhat less accurate for the same number of trials. probB <- mean(replicate(10000, { box <- sample(0:9, 1); marblesInBox <- c(rep("R", box), rep("B", 9 - box)); marblesDrawn <- sample(marblesInBox, 3, TRUE); all(marblesDrawn == "R") })) #Prob of B probAB <- mean(replicate(10000, { box <- sample(0:9, 1); marblesInBox <- c(rep("R", box), rep("B", 9 - box)); marblesDrawn <- sample(marblesInBox, 4, TRUE); all(marblesDrawn == "R") } )) #Prob of A cap B probAB/probB ## [1] 0.8216944 b. About 36%. mean(replicate(20000, { box <- sample(0:9, 1); marblesInBox <- c(rep("R", box), rep("B", 9 - box)); marblesDrawn <- sample(marblesInBox, 3, TRUE); if (all(marblesDrawn == "R")) { box == 9 # TRUE if box 9, FALSE otherwise } else NA # don't count this trial }), na.rm = TRUE) ## [1] 0.3653223 Problem 33 10 4 = 210. Problem 34 93 = 84. Problem 35
a. 66 = 46656. b. 6! = 720. c. 720/46656 = 5/324 ≈ 0.015.
Problem 36
2. Probability – Solutions a. 10 210. 6 = b. 54 52 = 50. c. 50/210 ≈ 0.238
13
3 Discrete Random Variables – Solutions Problem 1 a. 1/4 + 1/2 + 1/8 + 1/8 = 1. b. P (X ≥ 2) = 1/4. c. P (X ≥ 2|X ≥ 1) = 1/3. d. P (X ≥ 2 ∪ X ≥ 1) = P (X ≥ 1) = 3/4 Problem 2
X <- sample(0:3, 10000, prob=c(1/4,1/2,1/8,1/8), replace=TRUE) mean(X == 1) # part a ## [1] 0.4947 table(X)/10000
# part b
## X ## 0 1 2 3 ## 0.2497 0.4947 0.1322 0.1234 P Problem 3 Need 1 = x p(x) = C/4 + C/2 + C = 7C/4 so C = 4/7.
Problem 4 For example, p(x) = 1/2 when x = ±1 and p(x) = 0 otherwise. Problem 5 E[X] = 0 · 41 + 1 · 12 + 2 · 18 + 3 · 18 = 89 = 1.125
1 1 11 1 + · · · + 10 · 10 = 10 (1 + 2 + · · · + 10) = 55 Problem 6 E[X] = 1 · 10 10 = 2 = 5.5
X <- sample(1:10, 10000, replace=TRUE) mean(X) ## [1] 5.5062 Problem 7 Exactly: products <- sort(rep(1:6,6)) * (1:6) sum(products)/36
# clever way to get all 36 products
## [1] 12.25 Or by simulation: mean( replicate(10000, prod(sample(1:6,2,replace=TRUE)))) ## [1] 12.1701 Problem 8 If X is the product, X = 2, X = 3, and X = 6 are all equally likely. Then E(X) = 13 2 + 31 3 + 13 6 = 11 3 90 900 10 + 2 · 1000 + 3 · 1000 = 2.89. Problem 9 The expected number of digits is 1 · 1000
Problem 10
a. X can take two values, 1 and 3. p(1) = .952 = 0.9025, p(3) = 1 − .952 = 0.0975. b. E[X] = 1 · 0.9025 + 3 · 0.0975 = 1.195.
c.Using simulations:
15
16
3. Discrete Random Variables – Solutions
npool <- 90 # number of people in the pool sim_data <- replicate(10000, { tests <- sample(c("pos", "neg"), npool, TRUE, prob = c(5, 95)) ifelse(any(tests == "pos"), 1+npool, 1) }) table(sim_data)/10000 ## sim_data ## 1 91 ## 0.01 0.99 mean(sim_data) ## [1] 90.1 d. Pooled testing uses less tests. In this setting pooled testing uses less tests with the pool size 87 or less, although the advantage diminishes after a pool size of 18. Problem 11 a. Expected value of $1 bet on red is 1 ∗ (18/38) + (−1) ∗ (20/38) = −2/38 ≈ −0.053. b. Expected value of let it ride, once, is 3 ∗ (18/38)2 + (−1) ∗ (1 − (18/38)2 ) = −0.102.
Problem 12 a. Bet doubling, you can lose 6 in a row. Seven losses in a row and you are out of money. b. The probability you do not win $1 is (20/38)7 = 0.0112. The probability you win $1 is 1 − 0.0112 = 0.9888. You are about 99% likely to win a dollar with bet doubling! c. Expected value is 1 ∗ 0.9888 + (−127) ∗ 0.0112 = −0.432. This is not good - you expect to lose, on average, 43 cents every time you play this strategy. d. Let X be the number of wins before you go broke. X ∼ Geom(0.0112), so the expected value is E(X) = (1 − p)/p = 0.9888/0.0112 ≈ 88.4 plays before you go broke. Problem 13 This code uses some tools that are a little advanced for this chapter. library(plyr) suppressMessages(suppressWarnings(library(dplyr)))
n <- 10 #flips to sample k <- 1 #count flips after k-in-a-row successes trials <- rdply(10000, { shots <- sample(0:1,n,replace=TRUE) after <- shots[diff(c(rep(0,k+1),cumsum(shots)),k) == k] table(factor(after, levels=0:1), useNA="no") }) trials <- mutate(trials, hit = `1`, miss = `0`, count = hit + miss, p = hit/count) %>% select(hit,miss,count,p) mean(trials$p,na.rm=TRUE) ## [1] 0.4425184 Problem 14 a. $1 straight: 0.60 b. $1 front pair: 0.60 c. $1 back pair: 0.60 d. $6 6-way: 3.60 (since the bet costs $6, this is a return of 0.60 on the dollar) e. $3 3-way: 1.80 (since the bet costs $3, this is a return of 0.60 on the dollar) f. $1 1-off: (1 × 300 + 6 × 29 + 12 × 4 + 8 × 9)/1000 = 0.594 (this is the worst bet, you don’t get your sixty cents on the dollar)
7 Data Visualization with ggplot – Solutions library(ggplot2) library(dplyr) library(tidyr) Problem 1 ggplot(quakes, aes(x=long, y=lat, color=depth, size=mag)) + geom_point() 600
−10
400 200
lat
−20
mag −30
4.0 4.5 5.0 5.5 165
170
175
180
185
6.0
long Problem 2 ggplot(mtcars, aes(x=factor(cyl), y=mpg)) + geom_boxplot() 35
30
mpg
25
20
15
10 4
6
8
factor(cyl) 71
72
7. Data Visualization with ggplot – Solutions
Problem 3 fosdata::brake %>% ggplot(aes(x=p1_p2)) + geom_density()
density
0.0015
0.0010
0.0005
0.0000 1000
1500
2000
2500
p1_p2 a. The data is skew right. b. The most likely time is about 1100 msec. Problem 4 fosdata::brake %>% ggplot(aes(sample=latency_p1)) + geom_qq() + geom_qq_line() 1250
y
1000
750
500
250 −2
−1
0
x The data is right skew. Problem 5
1
2
7. Data Visualization with ggplot – Solutions
73
mpg %>% ggplot(aes(x=hwy, y=cty, color=cyl)) + geom_jitter()
30
cyl 8
cty
7 6
20
5 4 10 10
20
30
40
hwy mpg %>% ggplot(aes(x=hwy, y=cty, color=factor(cyl))) + geom_jitter()
30
factor(cyl) cty
4 5 20
6 8
10 10
20
30
40
hwy Problem 6 storms %>% ggplot(aes(x = wind, fill=category)) + geom_histogram()
74
7. Data Visualization with ggplot – Solutions
category
1500
−1
count
0 1
1000
2 3 500
4 5
0 0
40
80
120
160
wind storms %>% ggplot(aes(x = pressure, fill=category)) + geom_histogram()
category 2000
−1
count
0 1 2 1000
3 4 5
0 880
920
960
1000
pressure c. The wind data is right skew. The pressure data is left skew. d. The category variable is an ordered factor. This causes ggplot to choose a color scale that has discrete colors but in a progression. Problem 7 storms %>% filter(year ==
2014) %>% ggplot(aes(x = long, y = lat, color=name)) + geom_point()
7. Data Visualization with ggplot – Solutions
75
name 40
Arthur
lat
Cristobal Edouard
30
Fay Gonzalo Hanna
20
Two 10 −80
−60
−40
long Gonzalo made it furthest North. Problem 8 fosdata::austen %>% ggplot(aes(x = word_length)) + geom_bar() + facet_wrap(~novel) Emma
Pride and Prejudice
count
30000
20000
10000
0 0
5
10
15
20 0
5
10
word_length Problem 9 fosdata::austen %>% filter(novel == "Emma", sentiment_score != 0) %>% group_by(chapter) %>% summarize(mean_positive = mean(sentiment_score > 0)) %>% ggplot(aes(x = chapter, y = mean_positive)) + geom_point() + geom_smooth(span = .4)
15
20
76
7. Data Visualization with ggplot – Solutions 0.70
mean_positive
0.65
0.60
0.55
0.50
0
20
40
chapter geom_smooth gives a smoothed version of a line through the points, where geom_line doesn’t give any extra information over just the points. There is no chapter 3.5, so I would choose geom_smooth. Problem 10 fosdata::austen %>% filter(novel == "Emma") %>% group_by(chapter) %>% summarize(mean_sentiment = mean(sentiment_score)) %>% ggplot(aes(chapter, y = mean_sentiment)) + geom_bar(stat = "identity")
mean_sentiment
0.06
0.04
0.02
0.00 0
20
40
chapter Problem 11 ISwR::juul %>% ggplot(aes(x=age, y=igf1, color=factor(tanner))) + geom_point() ## Warning: Removed 326 rows containing missing values (geom_point).
7. Data Visualization with ggplot – Solutions
77
factor(tanner)
750
1
igf1
2 500
3 4 5
250
NA
0 0
20
40
60
80
age Neither geom_line or geom_smooth works well with this data. Problem 12 pres_election <- fosdata::pres_election library(mapproj) library(stringr) data("unemp") combined_data <- left_join(pres_election, unemp, by = c("FIPS" = "fips")) head(combined_data) ## year state state_po county FIPS candidate party candidatevotes ## 1 2000 Alabama AL Autauga 1001 Al Gore democrat 4942 ## 2 2000 Alabama AL Autauga 1001 George W. Bush republican 11993 ## 3 2000 Alabama AL Autauga 1001 Ralph Nader green 160 ## 4 2000 Alabama AL Autauga 1001 Other <NA> 113 ## 5 2000 Alabama AL Baldwin 1003 Al Gore democrat 13997 ## 6 2000 Alabama AL Baldwin 1003 George W. Bush republican 40872 ## totalvotes pop unemp ## 1 17208 23288 9.7 ## 2 17208 23288 9.7 ## 3 17208 23288 9.7 ## 4 17208 23288 9.7 ## 5 56480 81706 9.1 ## 6 56480 81706 9.1 combined_data %>% filter(year == 2000) %>% filter(str_detect(candidate, "Bush")) %>% mutate(percent_bush = candidatevotes/totalvotes) %>% ggplot(aes(x = unemp, y = percent_bush)) + geom_point() ## Warning: Removed 42 rows containing missing values (geom_point).
78
7. Data Visualization with ggplot – Solutions
percent_bush
0.75
0.50
0.25
0
10
20
30
unemp Problem 13 bechdel <- fosdata::bechdel bechdel %>% group_by(year) %>% summarize(percent_pass = mean(binary == "PASS")) %>% ggplot(aes(x = year, y = percent_pass)) + geom_point() 1.00
percent_pass
0.75
0.50
0.25
0.00 1970
1980
1990
2000
year Problem 14 ggplot(CO2, aes(x = conc, y = uptake, color = Type)) + geom_point() + geom_smooth() + facet_wrap(vars(Plant))
2010
7. Data Visualization with ggplot – Solutions
79
Qn1
Qn2
Qn3
Qc1
Qc3
Qc2
Mn3
Mn2
uptake
100 50 0 −50
Type
100 50 0 −50
Quebec Mississippi Mn1
Mc2
Mc3
Mc1
100 50 0 −50 2505007501000 2505007501000 2505007501000 2505007501000
conc Problem 15 fosdata::pres_election %>% group_by(year,party) %>% summarize(votes = sum(candidatevotes, na.rm=TRUE)) %>% ggplot(aes(x=party,y=votes)) + geom_col() + facet_wrap(vars(year)) 2000
2004
2012
2016
2008
6e+07 4e+07
votes
2e+07 0e+00 democrat green republicanNA
6e+07 4e+07 2e+07 0e+00 democrat green republicanNA democrat green republicanNA
party Problem 16 We remove the outlier that has a charge time of over 40 hours. cc <- fosdata::ecars cc <- janitor::clean_names(cc) cc <- cc %>% mutate(weekday = factor(weekday,levels = c("Mon", "Tue", "Wed", "Thu", "Fri", "Sat", "Sun"))) cc %>%
80
7. Data Visualization with ggplot – Solutions
filter(!str_detect(platform, "web"), charge_time_hrs < 40) %>% ggplot(aes(x = charge_time_hrs, y = kwh_total)) + geom_point() + facet_grid(platform ~ weekday) + labs(x = "Charge Time (hrs)", y = "Total Kilowatt Hours") Mon
Tue
Wed
Thu
Fri
Sat
Sun
android
15 10 5 0 20 15
ios
Total Kilowatt Hours
20
10 5 0
0 3 6 9 120 3 6 9 120 3 6 9 120 3 6 9 120 3 6 9 120 3 6 9 120 3 6 9 12
Charge Time (hrs) Problem 17 library(Lahman) # a) Batting %>% group_by(yearID) %>% summarize(dubs=sum(X2B)) %>% ggplot(aes(x = yearID, y = dubs)) + geom_point() # b) Batting %>% filter(lgID %in% c('AL','NL')) %>% group_by(yearID, lgID) %>% summarize(dubs=sum(X2B)) %>% ggplot(aes(x = yearID, y = dubs, color=lgID)) + scale_color_manual(values = c("red", "blue")) + geom_point()
7. Data Visualization with ggplot – Solutions
81 5000
4000
dubs
dubs
7500
5000
lgID
3000
AL NL
2000 2500 1000 0
1900
1950
2000
1880 1920 1960 2000
yearID
yearID
Problem 18 Batting %>% filter(yearID >= 1969) %>% group_by(yearID,lgID) %>% summarize(runs=sum(R)) %>% ggplot(aes(x = lgID, y = runs)) + geom_boxplot()
12000
runs
10000
8000
6000
4000 AL
NL
lgID Problem 19 Batting %>% group_by(playerID) %>% summarize(avg = sum(H)/sum(AB), abs = sum(AB)) %>% filter(abs >= 1000) %>% ggplot(aes(x = avg)) + geom_histogram(binwidth = 0.01)
82
7. Data Visualization with ggplot – Solutions
600
count
400
200
0 0.2
0.3
avg Problem 20 a.
Lahman::People %>% janitor::clean_names() %>% ggplot(aes(x = birth_month)) + geom_bar(stat = "count") + scale_x_discrete(limits = factor(1:12), labels = c("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Ju labs(x = "Birth Month", y = "Number of MLB Players All-Time") ## Warning: Removed 282 rows containing non-finite values (stat_count).
Number of MLB Players All−Time
2000
1500
1000
500
0 Jan
Feb
Mar
Apr
May
Jun
Jul
Birth Month b. Lahman::People %>% janitor::clean_names() %>%
Aug
Sep
Oct
Nov
Dec