library(tidyverse)
library(openintro)
library(infer)
global_monitor <- tibble(
scientist_work = c(rep("Benefits", 80000), rep("Doesn't benefit", 20000))
)
ggplot(global_monitor, aes(x = scientist_work)) +
geom_bar() +
labs(
x = "", y = "",
title = "Do you believe that the work scientists do benefit people like you?"
) +
coord_flip()
global_monitor %>%
count(scientist_work) %>%
mutate(p = n /sum(n))
## # A tibble: 2 × 3
## scientist_work n p
## <chr> <int> <dbl>
## 1 Benefits 80000 0.8
## 2 Doesn't benefit 20000 0.2
samp1 <- global_monitor %>%
sample_n(50)
sample_n function takes
a random sample of observations (i.e. rows) from the dataset, you can
still refer to the variables in the dataset with the same names. Code
you presented earlier for visualizing and summarizing the population
data will still be useful for the sample, however be careful to not
label your proportion p since you’re now calculating a
sample statistic, not a population parameters. You can customize the
label of the statistics to indicate that it comes from the sample.samp1 %>%
count(scientist_work) %>%
mutate(p_hat = n /sum(n))
## # A tibble: 2 × 3
## scientist_work n p_hat
## <chr> <int> <dbl>
## 1 Benefits 37 0.74
## 2 Doesn't benefit 13 0.26
The distribution on this sample can show that the people who believe in sciences’ Data is skewed more on this direction. Comparing this to the population, a sample can represent a mirror of the entire population.
I would not expect the sample proportion to match another’s student sample. This is becuse sample proportion is random, or generated randomly. No 2 samples can be similar. I do expect most of the student’s sample can be similar in the sense that their sample can have a higher % of benefits vs non-benefits due to 80% benefits and 20% don’t benefits.
samp2. How does the sample proportion of samp2
compare with that of samp1? Suppose we took two more
samples, one of size 100 and one of size 1000. Which would you think
would provide a more accurate estimate of the population
proportion?samp2 <- global_monitor %>%
sample_n(50)
samp2 %>%
count(scientist_work) %>%
mutate(p_hat_ = n /sum(n))
## # A tibble: 2 × 3
## scientist_work n p_hat_
## <chr> <int> <dbl>
## 1 Benefits 42 0.84
## 2 Doesn't benefit 8 0.16
As I mentioned on Question 2. When we know the basic line of sample population has a 80% benefit and 20% non-benefits. Other random generated samples will create similar outcomes. samp2 is simialr to s1 due to close to 1 ratio. If the sample is around 1,000 I think there is a better chance of distribution.
sample_props50 <- global_monitor %>%
rep_sample_n(size = 50, reps = 15000, replace = TRUE) %>%
count(scientist_work) %>%
mutate(p_hat = n /sum(n)) %>%
filter(scientist_work == "Doesn't benefit")
And we can visualize the distribution of these proportions with a histogram.
ggplot(data = sample_props50, aes(x = p_hat)) +
geom_histogram(binwidth = 0.02) +
labs(
x = "p_hat (Doesn't benefit)",
title = "Sampling distribution of p_hat",
subtitle = "Sample size = 50, Number of samples = 15000"
)
#4. How many elements are there in sample_props50?
Describe the sampling distribution, and be sure to specifically note its
center. Make sure to include a plot of the distribution in your
answer.
There is 2,000 elements in this graph represented. The sampling distribution is symmetric, and in the center laying around 20%.
global_monitor %>%
sample_n(size = 50, replace = TRUE) %>%
count(scientist_work) %>%
mutate(p_hat = n /sum(n)) %>%
filter(scientist_work == "Doesn't benefit")
## # A tibble: 1 × 3
## scientist_work n p_hat
## <chr> <int> <dbl>
## 1 Doesn't benefit 6 0.12
rep_sample_n function does, try
modifying the code to create a sampling distribution of 25
sample proportions from samples of size 10,
and put them in a data frame named sample_props_small.
Print the output. How many observations are there in this object called
sample_props_small? What does each observation
represent?sample_props_small <- global_monitor %>%
rep_sample_n(size = 10, reps = 25, replace = TRUE) %>%
count(scientist_work) %>%
mutate(p_hat = n /sum(n)) %>%
filter(scientist_work == "Doesn't benefit")
sample_props_small
## # A tibble: 23 × 4
## # Groups: replicate [23]
## replicate scientist_work n p_hat
## <int> <chr> <int> <dbl>
## 1 1 Doesn't benefit 2 0.2
## 2 2 Doesn't benefit 2 0.2
## 3 3 Doesn't benefit 1 0.1
## 4 4 Doesn't benefit 3 0.3
## 5 5 Doesn't benefit 1 0.1
## 6 6 Doesn't benefit 1 0.1
## 7 8 Doesn't benefit 2 0.2
## 8 9 Doesn't benefit 2 0.2
## 9 10 Doesn't benefit 1 0.1
## 10 11 Doesn't benefit 1 0.1
## # … with 13 more rows
## # ℹ Use `print(n = ...)` to see more rows
There are 25 observation in sample_props_small, each observation represents a proportion of response in each sample equal to population doesn’t believe in scientists.
ggplot(data = sample_props50, aes(x = p_hat)) +
geom_histogram(binwidth = 0.02)
#6. Use the app below to create sampling distributions of proportions of Doesn’t benefit from samples of size 10, 50, and 100. Use 5,000 simulations. What does each observation in the sampling distribution represent? How does the mean, standard error, and shape of the sampling distribution change as the sample size increases? How (if at all) do these values change if you increase the number of simulations? (You do not need to include plots in your answer.)
set.seed(1)
sample_props_small1 <- global_monitor %>%
rep_sample_n(size = 10, reps = 5000, replace = TRUE) %>%
count(scientist_work) %>%
mutate(p_hat = n /sum(n)) %>%
filter(scientist_work == "Doesn't benefit")
sample_props_small1
## # A tibble: 4,486 × 4
## # Groups: replicate [4,486]
## replicate scientist_work n p_hat
## <int> <chr> <int> <dbl>
## 1 2 Doesn't benefit 4 0.4
## 2 3 Doesn't benefit 5 0.5
## 3 4 Doesn't benefit 1 0.1
## 4 5 Doesn't benefit 2 0.2
## 5 6 Doesn't benefit 1 0.1
## 6 7 Doesn't benefit 2 0.2
## 7 8 Doesn't benefit 1 0.1
## 8 9 Doesn't benefit 3 0.3
## 9 10 Doesn't benefit 2 0.2
## 10 11 Doesn't benefit 1 0.1
## # … with 4,476 more rows
## # ℹ Use `print(n = ...)` to see more rows
sample_props_small2 <- global_monitor %>%
rep_sample_n(size = 50, reps = 5000, replace = TRUE) %>%
count(scientist_work) %>%
mutate(p_hat = n /sum(n)) %>%
filter(scientist_work == "Doesn't benefit")
sample_props_small2
## # A tibble: 5,000 × 4
## # Groups: replicate [5,000]
## replicate scientist_work n p_hat
## <int> <chr> <int> <dbl>
## 1 1 Doesn't benefit 10 0.2
## 2 2 Doesn't benefit 12 0.24
## 3 3 Doesn't benefit 10 0.2
## 4 4 Doesn't benefit 13 0.26
## 5 5 Doesn't benefit 11 0.22
## 6 6 Doesn't benefit 6 0.12
## 7 7 Doesn't benefit 13 0.26
## 8 8 Doesn't benefit 9 0.18
## 9 9 Doesn't benefit 13 0.26
## 10 10 Doesn't benefit 12 0.24
## # … with 4,990 more rows
## # ℹ Use `print(n = ...)` to see more rows
set.seed(3)
sample_props_small3 <- global_monitor %>%
rep_sample_n(size = 100, reps = 5000, replace = TRUE) %>%
count(scientist_work) %>%
mutate(p_hat = n /sum(n)) %>%
filter(scientist_work == "Doesn't benefit")
sample_props_small3
## # A tibble: 5,000 × 4
## # Groups: replicate [5,000]
## replicate scientist_work n p_hat
## <int> <chr> <int> <dbl>
## 1 1 Doesn't benefit 26 0.26
## 2 2 Doesn't benefit 17 0.17
## 3 3 Doesn't benefit 16 0.16
## 4 4 Doesn't benefit 20 0.2
## 5 5 Doesn't benefit 22 0.22
## 6 6 Doesn't benefit 17 0.17
## 7 7 Doesn't benefit 18 0.18
## 8 8 Doesn't benefit 22 0.22
## 9 9 Doesn't benefit 19 0.19
## 10 10 Doesn't benefit 24 0.24
## # … with 4,990 more rows
## # ℹ Use `print(n = ...)` to see more rows
Setting the sample size from 10,50, and 100. I can see that with the sample size increasing there seem to be a converge closer to the true population porportion around 26%. With a higher sample size the standard error is sammlar vs the sample size of 10.
#7. Take a sample of size 15 from the population and calculate the proportion of people in this sample who think the work scientists do enhances their lives. Using this sample, what is your best point estimate of the population proportion of people who think the work scientists do enchances their lives?
set.seed(4)
samp3 <- global_monitor %>%
sample_n(15)
samp3 %>%
count(scientist_work) %>%
mutate(sam = n/sum(n))
## # A tibble: 2 × 3
## scientist_work n sam
## <chr> <int> <dbl>
## 1 Benefits 14 0.933
## 2 Doesn't benefit 1 0.0667
Based on this calculation and seeing the point estimate. There is a 93% chance that the population believes scientist benefits the population. My best point estimates will be around 88%.
#8. Since you have access to the population, simulate the sampling
distribution of proportion of those who think the work scientists do
enchances their lives for samples of size 15 by taking 2000 samples from
the population of size 15 and computing 2000 sample proportions. Store
these proportions in as sample_props15. Plot the data, then
describe the shape of this sampling distribution. Based on this sampling
distribution, what would you guess the true proportion of those who
think the work scientists do enchances their lives to be? Finally,
calculate and report the population proportion.
sample_props15 <- global_monitor %>%
rep_sample_n(size = 15, reps = 2000, replace = TRUE) %>%
count(scientist_work) %>%
mutate(p_hat = n /sum(n)) %>%
filter(scientist_work == "Benefits")
sample_props15
## # A tibble: 2,000 × 4
## # Groups: replicate [2,000]
## replicate scientist_work n p_hat
## <int> <chr> <int> <dbl>
## 1 1 Benefits 11 0.733
## 2 2 Benefits 13 0.867
## 3 3 Benefits 12 0.8
## 4 4 Benefits 12 0.8
## 5 5 Benefits 13 0.867
## 6 6 Benefits 15 1
## 7 7 Benefits 14 0.933
## 8 8 Benefits 13 0.867
## 9 9 Benefits 12 0.8
## 10 10 Benefits 13 0.867
## # … with 1,990 more rows
## # ℹ Use `print(n = ...)` to see more rows
ggplot(data = sample_props15, aes(x = p_hat)) +
geom_histogram(binwidth = 0.02) +
labs(
x = "p_hat (Benefits)",
title = "Sampling distribution of population proportion",
subtitle = "Sample size = 15, Number of samples = 2000"
)
mean(sample_props15$p_hat)
## [1] 0.8038667
Calculatng the p_hat shows around 80% of the population believes scientists are real and enhance their everyday lives.
#9. Change your sample size from 15 to 150, then compute the sampling
distribution using the same method as above, and store these proportions
in a new object called sample_props150. Describe the shape
of this sampling distribution and compare it to the sampling
distribution for a sample size of 15. Based on this sampling
distribution, what would you guess to be the true proportion of those
who think the work scientists do enchances their lives?
sample_props150 <- global_monitor %>%
rep_sample_n(size = 150, reps = 2000, replace = TRUE) %>%
count(scientist_work) %>%
mutate(p_hat = n /sum(n)) %>%
filter(scientist_work == "Benefits")
sample_props150
## # A tibble: 2,000 × 4
## # Groups: replicate [2,000]
## replicate scientist_work n p_hat
## <int> <chr> <int> <dbl>
## 1 1 Benefits 121 0.807
## 2 2 Benefits 123 0.82
## 3 3 Benefits 113 0.753
## 4 4 Benefits 119 0.793
## 5 5 Benefits 120 0.8
## 6 6 Benefits 126 0.84
## 7 7 Benefits 118 0.787
## 8 8 Benefits 124 0.827
## 9 9 Benefits 127 0.847
## 10 10 Benefits 118 0.787
## # … with 1,990 more rows
## # ℹ Use `print(n = ...)` to see more rows
ggplot(data = sample_props150, aes(x = p_hat)) +
geom_histogram(binwidth = 0.02) +
labs(
x = "p_hat (Benefits)",
title = "Sampling distribution of population proportion",
subtitle = "Sample size = 150, Number of samples = 2000"
)
Going from a sample of 15 to 150. We can see that the p_hat is still
laying close to 80%.
#10. Of the sampling distributions from 2 and 3, which has a smaller spread? Ifyou’re concerned with making estimates that are more often close to the true value, would you prefer a sampling distribution with a large or small spread? On the graphs I posted, I see that chart 2 has a smaller spread because the sample size is smaller. When we have a smaller sample size, this can affect the spread greatly because one sample represents a huge amount of the sample size. * * *