install.packages("mosaic")

Suppose a friend claims to be able to predict the color of a playing card from a standard deck of playing cards. Because a standard deck of playing cards has 26 red and 26 black cards, your friend would be expected to guess the correct card color 50% of the time, simply due to random chance. If your friend has the ability to predict the card color, you would expect her to correctly determine the card color at a rate beyond 50%. Using the language of hypothesis testing, we want to test

\(H_0: p = 0.5\) versus
\(H_1: p > 0.5\)

To test your friend’s ability, you shuffle a deck of cards, randomly draw a card from the deck, and ask your friend to determine the color. You repeat this for a total of 40 predictions. Suppose your friend is able to correctly report the color of the card in 24 of 40 repetitions of the experiment. Do these results suggest that your friend is able to correctly determine the card color more than 50% of the time (the alternative hypothesis)? Or, is it possible that she is guessing (the null hypothesis) and just happened to respond correctly, by pure chance, 24 of 40 times? What would be convincing, or statistically significant , evidence to you?

First, we will flip 40 fair coins (P(Heads) = 0.5) 5000 times. Store the results in a data frame titled guess. We also introduce the idea of using a seed if you want to replicate the same results (based on the value of the seed). Note if a seed is not used everyone will get different results.

library(mosaic)
set.seed(3)      #Sets a seed so everyone gets same result
guess <- do(5000)*rflip(40)   #Flip 40 fair coins 5000 times. Store in data frame "guess".
head(guess,n=4)
##    n heads tails  prop
## 1 40    20    20 0.500
## 2 40    17    23 0.425
## 3 40    19    21 0.475
## 4 40    20    20 0.500

Now, we want to compute the proportion of simulations that result in 24 or more heads (correct guesses).

tally(~heads,data=guess,format="proportion")
## heads
##      7      9     10     11     12     13     14     15     16     17     18 
## 0.0002 0.0002 0.0014 0.0028 0.0058 0.0114 0.0186 0.0346 0.0618 0.0798 0.0976 
##     19     20     21     22     23     24     25     26     27     28     29 
## 0.1158 0.1324 0.1174 0.1032 0.0816 0.0566 0.0362 0.0240 0.0106 0.0050 0.0008 
##     30     31 
## 0.0012 0.0010
histogram(~heads,data=guess,width=1,main="Distribution of Correct Guesses",v=24) #Draw a vertical bar at 24 correct guesses.

prop(~(heads >= 24),data=guess)  #Compute the proportion of simulations in whichs there are 24 or more heads. 
## prop_TRUE 
##    0.1354

The probability of observing 24 or more correct guesses is 0.1354.

Simulation With a Coin That Is Not Fair

Suppose the proportion of registered voters who are Republican in a certain congressional district is 0.42. In some states, the state legislature has the responsibility to redistrict congressional districts after the census (conducted every ten years). After redistricting United States Congressional districts in Illinois, members of the Republican National Committee (RNC) wonder if the proportion of Republicans in this district is now less than 0.42. In a random sample of 60 registered voters in the new district, it is found that 22 are registered Republicans. Do the results of this survey suggest that redistricting resulted in a lower proportion of Republicans?

Here, we are testing

\(H_0: p = 0.42\)
\(H_1: p < 0.42\)

Let’s simulate this scenario using a coin where “Heads” represents a Republican and P(Heads) = 0.42.

library(mosaic)
set.seed(3)      #Sets a seed so everyone gets same result
party <- do(5000)*rflip(60,prob=0.42)   #Flip 60 coins where P(Heads) = 0.42 5000 times. Store in data frame "guess".
head(party,n=4)
##    n heads tails      prop
## 1 60    27    33 0.4500000
## 2 60    26    34 0.4333333
## 3 60    24    36 0.4000000
## 4 60    28    32 0.4666667
tally(~heads,data=party,format="proportion")
## heads
##     12     13     14     15     16     17     18     19     20     21     22 
## 0.0002 0.0006 0.0018 0.0022 0.0034 0.0102 0.0194 0.0260 0.0390 0.0588 0.0804 
##     23     24     25     26     27     28     29     30     31     32     33 
## 0.0870 0.1000 0.1048 0.0976 0.0912 0.0808 0.0676 0.0470 0.0338 0.0226 0.0134 
##     34     35     36     37     39 
## 0.0068 0.0026 0.0018 0.0006 0.0004
histogram(~heads,data=party,width=1,main="Distribution of Republicans",v=22) #Draw a vertical bar at 22 Republicans.

prop(~(heads <= 22),data=party)  #Compute the proportion of simulations in whichs there are 22 or fewer heads. 
## prop_TRUE 
##     0.242

Two-Tailed Tests

Let’s do the scenario from Example 3 in Section 10.2A.

Which do you think is easier to raise—a boy or a girl? When asked this question in 1947, 24% of all Americans said raising a girl was easier. In June, 2018, the Gallup Organization surveyed 1500 adult Americans, of which 408 felt it was easier to raise a girl. Does this result suggest the proportion of adult Americans who believe it is easier to raise a girl has changed since 1947?

Here, we are testing

\(H_0: p = 0.24\)
\(H_1: p \neq 0.24\)

set.seed(3)      #Sets a seed so everyone gets same result
girl <- do(5000)*rflip(1500,prob=0.24)   #Flip 1500 coins where P(Heads) = 0.24 5000 times. Store in data frame "girl".
head(girl,n=4)
##      n heads tails      prop
## 1 1500   368  1132 0.2453333
## 2 1500   356  1144 0.2373333
## 3 1500   346  1154 0.2306667
## 4 1500   366  1134 0.2440000

To approximate the P-value, first determine the expected number of Americans who believe it is easier to raise a girl assuming p = 0.24.

\(\mu_\hat{p} = np = 1500(0.24) = 360\)

The observed result, 408, is 48 individuals higher than expected. To compute the two-tailed P-value, compute the number of simulations that result in

\(360 - 48 = 312\) or fewer heads

or

408 or more heads.

histogram(~heads,data=girl,width=1,main="Distribution of Americans Who Believe It Is Easier to Raise a Girl") 

prop(~(heads <= 312),data=girl) + prop(~(heads >= 408),data=girl)  #Compute the proportion of simulations in whichs there are 328 or fewer heads or 408 or more heads. 
## prop_TRUE 
##    0.0028