Final Exam
Tiffany Haynes
2024-04-26
##################################################################
#County subdivision level, Nashville MSA
##################################################################
# Installing and loading required packages
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)
# Transmitting API key
census_api_key("52305352bea0573e1c055abddf678de757cba3e7")## To install your API key for use in future sessions, run this function with `install = TRUE`.# Fetching ACS codebooks
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)
# Specify a variable to estimate
VariableList =
c(Estimate_ = "DP02_0154P")
# Fetching data
mydata <- get_acs(
geography = "county subdivision",
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%
|
|== | 2%
|
|== | 3%
|
|=== | 4%
|
|==== | 5%
|
|==== | 6%
|
|===== | 7%
|
|====== | 8%
|
|======= | 9%
|
|======= | 11%
|
|======== | 12%
|
|========= | 13%
|
|========== | 14%
|
|========== | 15%
|
|============ | 17%
|
|============== | 20%
|
|================ | 22%
|
|================= | 24%
|
|================== | 26%
|
|=================== | 27%
|
|==================== | 28%
|
|===================== | 31%
|
|====================== | 32%
|
|======================= | 33%
|
|======================== | 35%
|
|========================== | 37%
|
|=========================== | 38%
|
|=========================== | 39%
|
|============================ | 40%
|
|============================== | 42%
|
|============================== | 43%
|
|================================ | 45%
|
|================================= | 48%
|
|================================== | 49%
|
|=================================== | 50%
|
|==================================== | 51%
|
|==================================== | 52%
|
|====================================== | 54%
|
|====================================== | 55%
|
|======================================= | 56%
|
|========================================= | 58%
|
|=========================================== | 61%
|
|======================================================== | 79%
|
|======================================================================| 100%# Reformatting data
mydata <-
separate_wider_delim(mydata,
NAME,
delim = ", ",
names = c("District", "County", "State"))
# Filtering data
mydata <- mydata %>%
filter(County == "Davidson County"|
County == "Cheatham County"|
County == "Robertson County"|
County == "Rutherford County"|
County == "Sumner County"|
County == "Williamson County"|
County == "Wilson County")
# Mapping data
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)# Exporting data in .csv format
CSVdata <- st_drop_geometry(mapdata)
write.csv(CSVdata, "mydata.csv", row.names = FALSE)From the map it seems that almost all of these counties are renters. The more outward ypu get from Nashville, it doesn’t have as high of a renting percentage.
# Installing required packages
if (!require("tidyverse"))
install.packages("tidyverse")
if (!require("gmodels"))
install.packages("gmodels")## Loading required package: gmodelslibrary(gmodels)
library(tidyverse)
mydata <- read.csv("https://raw.githubusercontent.com/drkblake/Data/main/SocialData.csv")
# Specify V1
mydata$V1 <- mydata$Impressions #Edit YOURDVNAME
# Look at V1
ggplot(mydata, aes(x = V1)) +
geom_bar(fill = "royalblue")
# Make the crosstab table
CrossTable(
mydata$V1,
prop.chisq = FALSE,
prop.t = FALSE,
prop.r = FALSE)##
##
## Cell Contents
## |-------------------------|
## | N |
## |-------------------------|
##
##
## Total Observations in Table: 140
##
##
## | 397 | 515 | 532 | 577 | 619 |
## |-----------|-----------|-----------|-----------|-----------|
## | 1 | 1 | 1 | 1 | 1 |
## | 0.007 | 0.007 | 0.007 | 0.007 | 0.007 |
## |-----------|-----------|-----------|-----------|-----------|
##
##
## | 624 | 650 | 662 | 663 | 668 |
## |-----------|-----------|-----------|-----------|-----------|
## | 1 | 1 | 1 | 1 | 1 |
## | 0.007 | 0.007 | 0.007 | 0.007 | 0.007 |
## |-----------|-----------|-----------|-----------|-----------|
##
##
## | 685 | 694 | 695 | 703 | 723 |
## |-----------|-----------|-----------|-----------|-----------|
## | 1 | 1 | 1 | 1 | 1 |
## | 0.007 | 0.007 | 0.007 | 0.007 | 0.007 |
## |-----------|-----------|-----------|-----------|-----------|
##
##
## | 729 | 740 | 754 | 755 | 758 |
## |-----------|-----------|-----------|-----------|-----------|
## | 1 | 1 | 1 | 1 | 1 |
## | 0.007 | 0.007 | 0.007 | 0.007 | 0.007 |
## |-----------|-----------|-----------|-----------|-----------|
##
##
## | 762 | 769 | 771 | 775 | 788 |
## |-----------|-----------|-----------|-----------|-----------|
## | 1 | 1 | 1 | 1 | 1 |
## | 0.007 | 0.007 | 0.007 | 0.007 | 0.007 |
## |-----------|-----------|-----------|-----------|-----------|
##
##
## | 791 | 797 | 826 | 827 | 829 |
## |-----------|-----------|-----------|-----------|-----------|
## | 1 | 2 | 1 | 1 | 1 |
## | 0.007 | 0.014 | 0.007 | 0.007 | 0.007 |
## |-----------|-----------|-----------|-----------|-----------|
##
##
## | 830 | 837 | 839 | 842 | 846 |
## |-----------|-----------|-----------|-----------|-----------|
## | 2 | 1 | 1 | 1 | 1 |
## | 0.014 | 0.007 | 0.007 | 0.007 | 0.007 |
## |-----------|-----------|-----------|-----------|-----------|
##
##
## | 854 | 857 | 876 | 879 | 885 |
## |-----------|-----------|-----------|-----------|-----------|
## | 1 | 1 | 1 | 1 | 1 |
## | 0.007 | 0.007 | 0.007 | 0.007 | 0.007 |
## |-----------|-----------|-----------|-----------|-----------|
##
##
## | 902 | 931 | 934 | 936 | 937 |
## |-----------|-----------|-----------|-----------|-----------|
## | 1 | 1 | 1 | 1 | 1 |
## | 0.007 | 0.007 | 0.007 | 0.007 | 0.007 |
## |-----------|-----------|-----------|-----------|-----------|
##
##
## | 940 | 947 | 951 | 966 | 975 |
## |-----------|-----------|-----------|-----------|-----------|
## | 2 | 1 | 2 | 1 | 1 |
## | 0.014 | 0.007 | 0.014 | 0.007 | 0.007 |
## |-----------|-----------|-----------|-----------|-----------|
##
##
## | 980 | 989 | 999 | 1001 | 1017 |
## |-----------|-----------|-----------|-----------|-----------|
## | 1 | 1 | 1 | 1 | 1 |
## | 0.007 | 0.007 | 0.007 | 0.007 | 0.007 |
## |-----------|-----------|-----------|-----------|-----------|
##
##
## | 1025 | 1036 | 1076 | 1080 | 1083 |
## |-----------|-----------|-----------|-----------|-----------|
## | 1 | 1 | 1 | 1 | 1 |
## | 0.007 | 0.007 | 0.007 | 0.007 | 0.007 |
## |-----------|-----------|-----------|-----------|-----------|
##
##
## | 1086 | 1088 | 1090 | 1111 | 1116 |
## |-----------|-----------|-----------|-----------|-----------|
## | 1 | 1 | 1 | 1 | 1 |
## | 0.007 | 0.007 | 0.007 | 0.007 | 0.007 |
## |-----------|-----------|-----------|-----------|-----------|
##
##
## | 1120 | 1125 | 1130 | 1135 | 1146 |
## |-----------|-----------|-----------|-----------|-----------|
## | 1 | 1 | 1 | 1 | 1 |
## | 0.007 | 0.007 | 0.007 | 0.007 | 0.007 |
## |-----------|-----------|-----------|-----------|-----------|
##
##
## | 1147 | 1151 | 1154 | 1161 | 1167 |
## |-----------|-----------|-----------|-----------|-----------|
## | 1 | 1 | 1 | 1 | 1 |
## | 0.007 | 0.007 | 0.007 | 0.007 | 0.007 |
## |-----------|-----------|-----------|-----------|-----------|
##
##
## | 1168 | 1173 | 1174 | 1176 | 1185 |
## |-----------|-----------|-----------|-----------|-----------|
## | 1 | 1 | 1 | 1 | 1 |
## | 0.007 | 0.007 | 0.007 | 0.007 | 0.007 |
## |-----------|-----------|-----------|-----------|-----------|
##
##
## | 1192 | 1196 | 1203 | 1206 | 1212 |
## |-----------|-----------|-----------|-----------|-----------|
## | 2 | 1 | 1 | 1 | 1 |
## | 0.014 | 0.007 | 0.007 | 0.007 | 0.007 |
## |-----------|-----------|-----------|-----------|-----------|
##
##
## | 1214 | 1223 | 1225 | 1234 | 1240 |
## |-----------|-----------|-----------|-----------|-----------|
## | 1 | 1 | 1 | 1 | 1 |
## | 0.007 | 0.007 | 0.007 | 0.007 | 0.007 |
## |-----------|-----------|-----------|-----------|-----------|
##
##
## | 1247 | 1253 | 1258 | 1267 | 1269 |
## |-----------|-----------|-----------|-----------|-----------|
## | 1 | 1 | 1 | 1 | 1 |
## | 0.007 | 0.007 | 0.007 | 0.007 | 0.007 |
## |-----------|-----------|-----------|-----------|-----------|
##
##
## | 1281 | 1282 | 1285 | 1302 | 1307 |
## |-----------|-----------|-----------|-----------|-----------|
## | 1 | 1 | 1 | 1 | 1 |
## | 0.007 | 0.007 | 0.007 | 0.007 | 0.007 |
## |-----------|-----------|-----------|-----------|-----------|
##
##
## | 1314 | 1337 | 1342 | 1361 | 1371 |
## |-----------|-----------|-----------|-----------|-----------|
## | 1 | 1 | 1 | 1 | 1 |
## | 0.007 | 0.007 | 0.007 | 0.007 | 0.007 |
## |-----------|-----------|-----------|-----------|-----------|
##
##
## | 1374 | 1378 | 1381 | 1389 | 1406 |
## |-----------|-----------|-----------|-----------|-----------|
## | 1 | 1 | 1 | 1 | 1 |
## | 0.007 | 0.007 | 0.007 | 0.007 | 0.007 |
## |-----------|-----------|-----------|-----------|-----------|
##
##
## | 1416 | 1443 | 1449 | 1489 | 1508 |
## |-----------|-----------|-----------|-----------|-----------|
## | 1 | 2 | 1 | 1 | 1 |
## | 0.007 | 0.014 | 0.007 | 0.007 | 0.007 |
## |-----------|-----------|-----------|-----------|-----------|
##
##
## | 1509 | 1515 | 1557 | 1559 | 1564 |
## |-----------|-----------|-----------|-----------|-----------|
## | 1 | 1 | 1 | 1 | 1 |
## | 0.007 | 0.007 | 0.007 | 0.007 | 0.007 |
## |-----------|-----------|-----------|-----------|-----------|
##
##
## | 1587 | 1601 | 1615 | 1620 | 1714 |
## |-----------|-----------|-----------|-----------|-----------|
## | 1 | 1 | 1 | 1 | 1 |
## | 0.007 | 0.007 | 0.007 | 0.007 | 0.007 |
## |-----------|-----------|-----------|-----------|-----------|
##
##
## | 1724 | 1746 | 1753 | 1807 | 1810 |
## |-----------|-----------|-----------|-----------|-----------|
## | 1 | 1 | 1 | 1 | 1 |
## | 0.007 | 0.007 | 0.007 | 0.007 | 0.007 |
## |-----------|-----------|-----------|-----------|-----------|
##
##
## | 1856 | 1889 | 1934 | 1952 |
## |-----------|-----------|-----------|-----------|
## | 1 | 1 | 1 | 1 |
## | 0.007 | 0.007 | 0.007 | 0.007 |
## |-----------|-----------|-----------|-----------|
##
##
##
## # Run the chi-squared test
test <- chisq.test(table(mydata$V1))## Warning in chisq.test(table(mydata$V1)): Chi-squared approximation may be
## incorrecttest##
## Chi-squared test for given probabilities
##
## data: table(mydata$V1)
## X-squared = 5.4857, df = 133, p-value = 1From the results it seems that it mainly stays between the 1000-1500 catagory and 1.0. Some get to 2.0.
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")
# Extract individual words to a "tidytext" data frame
tidy_text <- mydata %>%
unnest_tokens(word,Full.Text) %>%
count(word, sort = TRUE)
# Delete standard stop words
data("stop_words")
tidy_text <- tidy_text %>%
anti_join(stop_words)## Joining with `by = join_by(word)`# Delete custom stop words
my_stopwords <- tibble(word = c("https",
"t.co",
"rt"))
tidy_text <- tidy_text %>%
anti_join(my_stopwords)## Joining with `by = join_by(word)`searchterms <- "rule|abortion|schools|gun"
mydata$rule <- ifelse(grepl(searchterms,
mydata$Full.Text,
ignore.case = TRUE),1,0)
sum(mydata$rule)## [1] 231It seems that the hot topics currently do nto appear much from the White House Twitter page. It’s mostly what the presidents think in that moment about something happening that day.