## Warning: package 'tidyverse' was built under R version 4.3.3
## Warning: package 'ggplot2' was built under R version 4.3.3
## Warning: package 'tibble' was built under R version 4.3.3
## Warning: package 'tidyr' was built under R version 4.3.3
## Warning: package 'readr' was built under R version 4.3.3
## Warning: package 'purrr' was built under R version 4.3.3
## Warning: package 'dplyr' was built under R version 4.3.3
## Warning: package 'stringr' was built under R version 4.3.3
## Warning: package 'forcats' was built under R version 4.3.3
## Warning: package 'lubridate' was built under R version 4.3.3
## Warning: package 'openintro' was built under R version 4.3.3
## Warning: package 'airports' was built under R version 4.3.3
## Warning: package 'cherryblossom' was built under R version 4.3.3
## Warning: package 'usdata' was built under R version 4.3.3
## Warning: package 'infer' was built under R version 4.3.3
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)
Exercise 1
samp1 %>%
count(scientist_work) %>%
mutate(p_hat = n /sum(n))
## # A tibble: 2 × 3
## scientist_work n p_hat
## <chr> <int> <dbl>
## 1 Benefits 39 0.78
## 2 Doesn't benefit 11 0.22
## In this sample, the responses are distributed somewhat different from that of the true population. Whereas 20% of the true population does not believe that the work of scientists actually benefits them, 26% of the sample population does not believe that the work of scientists benefits them.
Exercise 2
## I would not expect the sample proportion I procured to match that of another student's because the random nature of the sample provides no garuntees that we would end up with the same population. Given this key fact, however, I would not expect the proportions of another student's data to differ much from mine because of the rather large size of the original population. Having a robust population sizes imrpoves the accuracy and consequentially the consistency of data, therefore the samples of two students should not be very different.
Exercise 3
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 39 0.78
## 2 Doesn't benefit 11 0.22
## The proportion of people that do not believe that the work of scientists benefits them is 22% in sample 2, which is 4% less than what it was in sample 1. If we were to take two additional samples in the sizes 100 and 1,000 people, I believe that the sample of 1,000 people would provide a more accurate estimate of the population proportion. This is because a larger sample is more representative of a population due to the fact that it includes more people.
Exercise 4
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")
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"
)

## There are 6 elements in "sample_prose50" being used to produce the desired results. The pictured sampling distribution displays a standard bell curve that is slightly skewed right.
Exercise 5
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")
## In the object "sample_props_small" there are 25 observations, though upon initially running the code, there were only 23. I believe this is because 2 of the samples were duplicates of prior ones, thus they were consolidated into a single observation. Therefore, each observation represents a unique sample of 10 individuals and their respective proportions.
Exercise 6
ggplot(data = sample_props50, aes(x = p_hat)) +
geom_histogram(binwidth = 0.02)

## Each observation in the sampling distribution represents the percentage of people who do not believe that the work of scientists benefits them within a single population. As the sample size increases, the standard error and width of the sampling distribution decrease. This is because increasing sample size improves accuracy, lessening the error value and creating a smaller confidence interval, creating a more narrow visual. The mean, however, does not change nearly as drastically as the other values. The mean of the sampling distribution only really changed when the sample size was very small, this being because having fewer samples to average ultimately comes with there being greater variety between them.
LS0tDQp0aXRsZTogIkxhYiAxOiBJbnRybyB0byBSIg0KYXV0aG9yOiAiRyBBZGlndW4iDQpkYXRlOiAiYHIgU3lzLkRhdGUoKWAiDQpvdXRwdXQ6IG9wZW5pbnRybzo6bGFiX3JlcG9ydA0KLS0tDQoNCmBgYHtyIGxvYWQtcGFja2FnZXMsIG1lc3NhZ2U9RkFMU0V9DQpsaWJyYXJ5KHRpZHl2ZXJzZSkNCmxpYnJhcnkob3BlbmludHJvKQ0KbGlicmFyeShpbmZlcikNCmBgYA0KDQpgYGB7cn0NCmdsb2JhbF9tb25pdG9yIDwtIHRpYmJsZSgNCiAgc2NpZW50aXN0X3dvcmsgPSBjKHJlcCgiQmVuZWZpdHMiLCA4MDAwMCksIHJlcCgiRG9lc24ndCBiZW5lZml0IiwgMjAwMDApKQ0KKQ0KYGBgDQoNCmBgYHtyfQ0KZ2dwbG90KGdsb2JhbF9tb25pdG9yLCBhZXMoeCA9IHNjaWVudGlzdF93b3JrKSkgKw0KICBnZW9tX2JhcigpICsNCiAgbGFicygNCiAgICB4ID0gIiIsIHkgPSAiIiwNCiAgICB0aXRsZSA9ICJEbyB5b3UgYmVsaWV2ZSB0aGF0IHRoZSB3b3JrIHNjaWVudGlzdHMgZG8gYmVuZWZpdCBwZW9wbGUgbGlrZSB5b3U/Ig0KICApICsNCiAgY29vcmRfZmxpcCgpIA0KYGBgDQoNCmBgYHtyfQ0KZ2xvYmFsX21vbml0b3IgJT4lDQogIGNvdW50KHNjaWVudGlzdF93b3JrKSAlPiUNCiAgbXV0YXRlKHAgPSBuIC9zdW0obikpDQpgYGANCg0KYGBge3J9DQpzYW1wMSA8LSBnbG9iYWxfbW9uaXRvciAlPiUNCiAgc2FtcGxlX24oNTApDQpgYGANCg0KIyMjIEV4ZXJjaXNlIDENCg0KYGBge3J9DQpzYW1wMSAlPiUNCiAgY291bnQoc2NpZW50aXN0X3dvcmspICU+JQ0KICBtdXRhdGUocF9oYXQgPSBuIC9zdW0obikpDQpgYGANCg0KYGBge3J9DQojIyBJbiB0aGlzIHNhbXBsZSwgdGhlIHJlc3BvbnNlcyBhcmUgZGlzdHJpYnV0ZWQgc29tZXdoYXQgZGlmZmVyZW50IGZyb20gdGhhdCBvZiB0aGUgdHJ1ZSBwb3B1bGF0aW9uLiBXaGVyZWFzIDIwJSBvZiB0aGUgdHJ1ZSBwb3B1bGF0aW9uIGRvZXMgbm90IGJlbGlldmUgdGhhdCB0aGUgd29yayBvZiBzY2llbnRpc3RzIGFjdHVhbGx5IGJlbmVmaXRzIHRoZW0sIDI2JSBvZiB0aGUgc2FtcGxlIHBvcHVsYXRpb24gZG9lcyBub3QgYmVsaWV2ZSB0aGF0IHRoZSB3b3JrIG9mIHNjaWVudGlzdHMgYmVuZWZpdHMgdGhlbS4NCmBgYA0KDQojIyMgRXhlcmNpc2UgMg0KDQpgYGB7cn0NCiMjIEkgd291bGQgbm90IGV4cGVjdCB0aGUgc2FtcGxlIHByb3BvcnRpb24gSSBwcm9jdXJlZCB0byBtYXRjaCB0aGF0IG9mIGFub3RoZXIgc3R1ZGVudCdzIGJlY2F1c2UgdGhlIHJhbmRvbSBuYXR1cmUgb2YgdGhlIHNhbXBsZSBwcm92aWRlcyBubyBnYXJ1bnRlZXMgdGhhdCB3ZSB3b3VsZCBlbmQgdXAgd2l0aCB0aGUgc2FtZSBwb3B1bGF0aW9uLiBHaXZlbiB0aGlzIGtleSBmYWN0LCBob3dldmVyLCBJIHdvdWxkIG5vdCBleHBlY3QgdGhlIHByb3BvcnRpb25zIG9mIGFub3RoZXIgc3R1ZGVudCdzIGRhdGEgdG8gZGlmZmVyIG11Y2ggZnJvbSBtaW5lIGJlY2F1c2Ugb2YgdGhlIHJhdGhlciBsYXJnZSBzaXplIG9mIHRoZSBvcmlnaW5hbCBwb3B1bGF0aW9uLiBIYXZpbmcgYSByb2J1c3QgcG9wdWxhdGlvbiBzaXplcyBpbXJwb3ZlcyB0aGUgYWNjdXJhY3kgYW5kIGNvbnNlcXVlbnRpYWxseSB0aGUgY29uc2lzdGVuY3kgb2YgZGF0YSwgdGhlcmVmb3JlIHRoZSBzYW1wbGVzIG9mIHR3byBzdHVkZW50cyBzaG91bGQgbm90IGJlIHZlcnkgZGlmZmVyZW50Lg0KYGBgDQoNCiMjIyBFeGVyY2lzZSAzDQoNCmBgYHtyfQ0Kc2FtcDIgPC0gZ2xvYmFsX21vbml0b3IgJT4lDQogIHNhbXBsZV9uKDUwKQ0KYGBgDQoNCmBgYHtyfQ0Kc2FtcDIgJT4lDQogIGNvdW50KHNjaWVudGlzdF93b3JrKSAlPiUNCiAgbXV0YXRlKHBfaGF0ID0gbiAvc3VtKG4pKQ0KYGBgDQoNCmBgYHtyfQ0KIyMgVGhlIHByb3BvcnRpb24gb2YgcGVvcGxlIHRoYXQgZG8gbm90IGJlbGlldmUgdGhhdCB0aGUgd29yayBvZiBzY2llbnRpc3RzIGJlbmVmaXRzIHRoZW0gaXMgMjIlIGluIHNhbXBsZSAyLCB3aGljaCBpcyA0JSBsZXNzIHRoYW4gd2hhdCBpdCB3YXMgaW4gc2FtcGxlIDEuIElmIHdlIHdlcmUgdG8gdGFrZSB0d28gYWRkaXRpb25hbCBzYW1wbGVzIGluIHRoZSBzaXplcyAxMDAgYW5kIDEsMDAwIHBlb3BsZSwgSSBiZWxpZXZlIHRoYXQgdGhlIHNhbXBsZSBvZiAxLDAwMCBwZW9wbGUgd291bGQgcHJvdmlkZSBhIG1vcmUgYWNjdXJhdGUgZXN0aW1hdGUgb2YgdGhlIHBvcHVsYXRpb24gcHJvcG9ydGlvbi4gVGhpcyBpcyBiZWNhdXNlIGEgbGFyZ2VyIHNhbXBsZSBpcyBtb3JlIHJlcHJlc2VudGF0aXZlIG9mIGEgcG9wdWxhdGlvbiBkdWUgdG8gdGhlIGZhY3QgdGhhdCBpdCBpbmNsdWRlcyBtb3JlIHBlb3BsZS4NCmBgYA0KDQojIyMgRXhlcmNpc2UgNA0KDQpgYGB7cn0NCnNhbXBsZV9wcm9wczUwIDwtIGdsb2JhbF9tb25pdG9yICU+JQ0KICAgICAgICAgICAgICAgICAgICByZXBfc2FtcGxlX24oc2l6ZSA9IDUwLCByZXBzID0gMTUwMDAsIHJlcGxhY2UgPSBUUlVFKSAlPiUNCiAgICAgICAgICAgICAgICAgICAgY291bnQoc2NpZW50aXN0X3dvcmspICU+JQ0KICAgICAgICAgICAgICAgICAgICBtdXRhdGUocF9oYXQgPSBuIC9zdW0obikpICU+JQ0KICAgICAgICAgICAgICAgICAgICBmaWx0ZXIoc2NpZW50aXN0X3dvcmsgPT0gIkRvZXNuJ3QgYmVuZWZpdCIpDQpgYGANCg0KYGBge3J9DQpnZ3Bsb3QoZGF0YSA9IHNhbXBsZV9wcm9wczUwLCBhZXMoeCA9IHBfaGF0KSkgKw0KICBnZW9tX2hpc3RvZ3JhbShiaW53aWR0aCA9IDAuMDIpICsNCiAgbGFicygNCiAgICB4ID0gInBfaGF0IChEb2Vzbid0IGJlbmVmaXQpIiwNCiAgICB0aXRsZSA9ICJTYW1wbGluZyBkaXN0cmlidXRpb24gb2YgcF9oYXQiLA0KICAgIHN1YnRpdGxlID0gIlNhbXBsZSBzaXplID0gNTAsIE51bWJlciBvZiBzYW1wbGVzID0gMTUwMDAiDQogICkNCmBgYA0KDQpgYGB7cn0NCiMjIFRoZXJlIGFyZSA2IGVsZW1lbnRzIGluICJzYW1wbGVfcHJvc2U1MCIgYmVpbmcgdXNlZCB0byBwcm9kdWNlIHRoZSBkZXNpcmVkIHJlc3VsdHMuIFRoZSBwaWN0dXJlZCBzYW1wbGluZyBkaXN0cmlidXRpb24gZGlzcGxheXMgYSBzdGFuZGFyZCBiZWxsIGN1cnZlIHRoYXQgaXMgc2xpZ2h0bHkgc2tld2VkIHJpZ2h0LiANCmBgYA0KDQojIyMgRXhlcmNpc2UgNQ0KDQpgYGB7cn0NCnNhbXBsZV9wcm9wc19zbWFsbCA8LSBnbG9iYWxfbW9uaXRvciAlPiUNCiAgcmVwX3NhbXBsZV9uKHNpemUgPSAxMCwgcmVwcyA9IDI1LCByZXBsYWNlID0gVFJVRSkgJT4lDQogIGNvdW50KHNjaWVudGlzdF93b3JrKSAlPiUNCiAgbXV0YXRlKHBfaGF0ID0gbiAvc3VtKG4pKSAlPiUNCiAgZmlsdGVyKHNjaWVudGlzdF93b3JrID09ICJEb2Vzbid0IGJlbmVmaXQiKQ0KYGBgDQoNCmBgYHtyfQ0KIyMgSW4gdGhlIG9iamVjdCAic2FtcGxlX3Byb3BzX3NtYWxsIiB0aGVyZSBhcmUgMjUgb2JzZXJ2YXRpb25zLCB0aG91Z2ggdXBvbiBpbml0aWFsbHkgcnVubmluZyB0aGUgY29kZSwgdGhlcmUgd2VyZSBvbmx5IDIzLiBJIGJlbGlldmUgdGhpcyBpcyBiZWNhdXNlIDIgb2YgdGhlIHNhbXBsZXMgd2VyZSBkdXBsaWNhdGVzIG9mIHByaW9yIG9uZXMsIHRodXMgdGhleSB3ZXJlIGNvbnNvbGlkYXRlZCBpbnRvIGEgc2luZ2xlIG9ic2VydmF0aW9uLiBUaGVyZWZvcmUsIGVhY2ggb2JzZXJ2YXRpb24gcmVwcmVzZW50cyBhIHVuaXF1ZSBzYW1wbGUgb2YgMTAgaW5kaXZpZHVhbHMgYW5kIHRoZWlyIHJlc3BlY3RpdmUgcHJvcG9ydGlvbnMuDQpgYGANCg0KIyMjIEV4ZXJjaXNlIDYNCg0KYGBge3J9DQpnZ3Bsb3QoZGF0YSA9IHNhbXBsZV9wcm9wczUwLCBhZXMoeCA9IHBfaGF0KSkgKw0KICBnZW9tX2hpc3RvZ3JhbShiaW53aWR0aCA9IDAuMDIpDQpgYGANCg0KYGBge3J9DQojIyBFYWNoIG9ic2VydmF0aW9uIGluIHRoZSBzYW1wbGluZyBkaXN0cmlidXRpb24gcmVwcmVzZW50cyB0aGUgcGVyY2VudGFnZSBvZiBwZW9wbGUgd2hvIGRvIG5vdCBiZWxpZXZlIHRoYXQgdGhlIHdvcmsgb2Ygc2NpZW50aXN0cyBiZW5lZml0cyB0aGVtIHdpdGhpbiBhIHNpbmdsZSBwb3B1bGF0aW9uLiBBcyB0aGUgc2FtcGxlIHNpemUgaW5jcmVhc2VzLCB0aGUgc3RhbmRhcmQgZXJyb3IgYW5kIHdpZHRoIG9mIHRoZSBzYW1wbGluZyBkaXN0cmlidXRpb24gZGVjcmVhc2UuIFRoaXMgaXMgYmVjYXVzZSBpbmNyZWFzaW5nIHNhbXBsZSBzaXplIGltcHJvdmVzIGFjY3VyYWN5LCBsZXNzZW5pbmcgdGhlIGVycm9yIHZhbHVlIGFuZCBjcmVhdGluZyBhIHNtYWxsZXIgY29uZmlkZW5jZSBpbnRlcnZhbCwgY3JlYXRpbmcgYSBtb3JlIG5hcnJvdyB2aXN1YWwuIFRoZSBtZWFuLCBob3dldmVyLCBkb2VzIG5vdCBjaGFuZ2UgbmVhcmx5IGFzIGRyYXN0aWNhbGx5IGFzIHRoZSBvdGhlciB2YWx1ZXMuIFRoZSBtZWFuIG9mIHRoZSBzYW1wbGluZyBkaXN0cmlidXRpb24gb25seSByZWFsbHkgY2hhbmdlZCB3aGVuIHRoZSBzYW1wbGUgc2l6ZSB3YXMgdmVyeSBzbWFsbCwgdGhpcyBiZWluZyBiZWNhdXNlIGhhdmluZyBmZXdlciBzYW1wbGVzIHRvIGF2ZXJhZ2UgdWx0aW1hdGVseSBjb21lcyB3aXRoIHRoZXJlIGJlaW5nIGdyZWF0ZXIgdmFyaWV0eSBiZXR3ZWVuIHRoZW0uDQpgYGANCg==