Final Exam
Matthew Hayden
2024-04-26
if (!require("tidyverse")) install.packages("tidyverse")## Loading required package: tidyverse## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.4 ✔ readr 2.1.5
## ✔ forcats 1.0.0 ✔ stringr 1.5.1
## ✔ ggplot2 3.4.4 ✔ tibble 3.2.1
## ✔ lubridate 1.9.3 ✔ tidyr 1.3.1
## ✔ purrr 1.0.2
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errorsif (!require("tidycensus")) install.packages("tidycensus")## Loading required package: tidycensusif (!require("sf")) install.packages("sf")## Loading required package: sf
## Linking to GEOS 3.11.0, GDAL 3.5.3, PROJ 9.1.0; sf_use_s2() is TRUEif (!require("mapview")) install.packages("mapview")## Loading required package: mapviewlibrary(tidyverse)
library(tidycensus)
library(sf)
library(mapview)
census_api_key("f47d2ea953fa8297dad3dc44e5ac87f39e113b79")## To install your API key for use in future sessions, run this function with `install = TRUE`.DetailedTables <- load_variables(2022, "acs5", cache = TRUE)
SubjectTables <- load_variables(2022, "acs5/subject", cache = TRUE)
ProfileTables <- load_variables(2022, "acs5/profile", cache = TRUE)
All_ACS_Variables <- bind_rows(DetailedTables, ProfileTables)
All_ACS_Variables <- bind_rows(All_ACS_Variables, SubjectTables)
rm (DetailedTables, SubjectTables, ProfileTables)
VariableList =
c(Estimate_ = "DP04_0047P")
mydata <- get_acs(
geography = "county",
state = "TN",
variables = VariableList,
year = 2022,
survey = "acs5",
output = "wide",
geometry = TRUE)## Getting data from the 2018-2022 5-year ACS
## Downloading feature geometry from the Census website. To cache shapefiles for use in future sessions, set `options(tigris_use_cache = TRUE)`.
## Using the ACS Data Profile##
|
| | 0%
|
| | 1%
|
|= | 1%
|
|= | 2%
|
|== | 2%
|
|== | 3%
|
|=== | 4%
|
|==== | 5%
|
|==== | 6%
|
|===== | 7%
|
|====== | 9%
|
|======= | 10%
|
|======== | 11%
|
|========= | 13%
|
|=========== | 15%
|
|=========== | 16%
|
|============ | 17%
|
|============ | 18%
|
|============= | 18%
|
|============= | 19%
|
|============== | 20%
|
|=============== | 21%
|
|=============== | 22%
|
|================ | 22%
|
|================ | 23%
|
|================= | 24%
|
|================= | 25%
|
|==================== | 28%
|
|==================== | 29%
|
|===================== | 29%
|
|===================== | 30%
|
|====================== | 31%
|
|====================== | 32%
|
|======================= | 32%
|
|======================= | 33%
|
|======================= | 34%
|
|======================== | 34%
|
|========================= | 35%
|
|========================= | 36%
|
|========================== | 37%
|
|========================== | 38%
|
|=========================== | 38%
|
|=========================== | 39%
|
|============================ | 40%
|
|============================= | 42%
|
|============================== | 42%
|
|============================== | 43%
|
|=============================== | 44%
|
|=============================== | 45%
|
|================================ | 46%
|
|================================= | 47%
|
|====================================== | 55%
|
|======================================= | 55%
|
|======================================= | 56%
|
|======================================== | 57%
|
|======================================== | 58%
|
|========================================= | 58%
|
|========================================= | 59%
|
|========================================== | 60%
|
|========================================== | 61%
|
|=========================================== | 61%
|
|=========================================== | 62%
|
|============================================ | 62%
|
|============================================ | 63%
|
|============================================ | 64%
|
|============================================= | 64%
|
|============================================= | 65%
|
|============================================== | 65%
|
|============================================== | 66%
|
|=============================================== | 67%
|
|=============================================== | 68%
|
|================================================ | 68%
|
|================================================ | 69%
|
|================================================= | 70%
|
|================================================== | 71%
|
|================================================== | 72%
|
|==================================================== | 75%
|
|===================================================== | 75%
|
|===================================================== | 76%
|
|=============================================================== | 90%
|
|======================================================================| 100%mydata <-
separate_wider_delim(mydata,
NAME,
delim = ", ",
names = c("County", "State"))
mydata <- mydata %>%
filter(
County == "Cheatham County"|
County == "Davidson County"|
County == "Robertson County"|
County == "Rutherford County"|
County == "Sumner County"|
County == "Williamson County"|
County == "Wilson County")
mapdata <- mydata %>%
rename(Estimate = Estimate_E, Estimate_MOE = Estimate_M)
mapdata <- st_as_sf(mapdata)
mapviewOptions(basemaps.color.shuffle = FALSE)
mapview(mapdata, zcol = "Estimate",
layer.name = "Estimate",
popup = TRUE)Summary The map shows that Davidson county has the highest percent of renters at 45.8. A basic look at a map shows that this accounts for Nashville which tend to have less house owners in “tourist” type cities.
PART 2
if (!require("tidyverse"))
install.packages("tidyverse")
library(tidyverse)
mydata <- read.csv("https://raw.githubusercontent.com/drkblake/Data/main/SocialData.csv")
head(mydata,10)## ID Type Impressions
## 1 1 Photo 695
## 2 2 Text 940
## 3 3 Photo 1196
## 4 4 Photo 936
## 5 5 Photo 1389
## 6 6 Photo 857
## 7 7 Text 797
## 8 8 Photo 1810
## 9 9 Photo 1086
## 10 10 Video 1416mydata$DV <- mydata$Impressions
mydata$IV <- mydata$Type
Type <- group_by(mydata, IV) %>%
summarise(mean = mean(DV, na.rm = TRUE))
ggplot(mydata, aes(x = DV)) +
geom_histogram() +
facet_grid(IV ~ .) +
geom_histogram(color = "black", fill = "#1f78b4") +
geom_vline(data = Type, aes(xintercept = mean, ))## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
group_by(mydata, IV) %>%
summarise(
count = n(),
mean = mean(DV, na.rm = TRUE),
sd = sd(DV, na.rm = TRUE),
min = min(DV, na.rm = TRUE),
max = max(DV, na.rm = TRUE))## # A tibble: 3 × 6
## IV count mean sd min max
## <chr> <int> <dbl> <dbl> <int> <int>
## 1 Photo 58 1035. 297. 397 1810
## 2 Text 43 999. 278. 515 1746
## 3 Video 39 1370. 307. 829 1952options(scipen = 999)
oneway.test(mydata$DV ~ mydata$IV,
var.equal = FALSE)##
## One-way analysis of means (not assuming equal variances)
##
## data: mydata$DV and mydata$IV
## F = 19.119, num df = 2.000, denom df = 85.525, p-value = 0.000000137anova_1 <- aov(mydata$DV ~ mydata$IV)
TukeyHSD(anova_1)## Tukey multiple comparisons of means
## 95% family-wise confidence level
##
## Fit: aov(formula = mydata$DV ~ mydata$IV)
##
## $`mydata$IV`
## diff lwr upr p adj
## Text-Photo -36.35605 -176.6202 103.9081 0.8126345
## Video-Photo 334.87710 190.5414 479.2128 0.0000005
## Video-Text 371.23315 217.1076 525.3587 0.0000002Summary: This parts code is to find which source of media is performing the best. Based on the statistics provided, video is clear cut number 1 over photo and or text
PART 3
if (!require("tidyverse")) install.packages("tidyverse")
if (!require("tidytext")) install.packages("tidytext")## Loading required package: tidytextlibrary(tidyverse)
library(tidytext)
mydata <- read.csv("https://raw.githubusercontent.com/drkblake/Data/main/WhiteHouse.csv")
tidy_text <- mydata %>%
unnest_tokens(word,Full.Text) %>%
count(word, sort = TRUE)
data("stop_words")
tidy_text <- tidy_text %>%
anti_join(stop_words)## Joining with `by = join_by(word)`my_stopwords <- tibble(word = c("https",
"t.co",
"rt"))
tidy_text <- tidy_text %>%
anti_join(my_stopwords)## Joining with `by = join_by(word)`searchterms <- "Biden|Joe|president|administration"
mydata$Biden <- ifelse(grepl(searchterms,
mydata$Full.Text,
ignore.case = TRUE),1,0)
sum(mydata$Biden)## [1] 3391Summary: The final part code was set to find which words are used the most by the White House offical twitter page. Not shockingly the words president and biden lead the charge by over 1,000 times. Another thing was seeing the most random words and lets just say somehow my expectations were not even close to what I saw with foreign characters and random letters.