R Project Portfolio
Trevor South
2024-12-10
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.5.1 ✔ 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: mapviewif (!require("gtExtras"))
install.packages("gtExtras")## Loading required package: gtExtras
## Loading required package: gtlibrary(tidyverse)
library(tidycensus)
library(sf)
library(mapview)
library(gtExtras)
# Transmitting API key
census_api_key("16e35e5fa544d9e0253998884e6b633f82399b63")## 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)
Codebook <- DetailedTables %>%
select(name, label, concept)
Codebook <- bind_rows(Codebook,SubjectTables)
Codebook <- bind_rows(Codebook,ProfileTables)
Codebook <- Codebook %>%
distinct(label, .keep_all = TRUE)
rm(DetailedTables,
SubjectTables,
ProfileTables)
# Filtering the codebook
MyVars <- Codebook %>%
filter(grepl("GRAPI", label) &
grepl("Percent!!", label))
# Making a table of the filtered variables
MyVarsTable <- gt(MyVars) %>%
tab_header("Variables") %>%
cols_align(align = "left") %>%
gt_theme_538
# Displaying the table
MyVarsTable| Variables | ||
| name | label | concept |
|---|---|---|
| DP04_0136P | Percent!!GROSS RENT AS A PERCENTAGE OF HOUSEHOLD INCOME (GRAPI)!!Occupied units paying rent (excluding units where GRAPI cannot be computed) | Selected Housing Characteristics |
| DP04_0137P | Percent!!GROSS RENT AS A PERCENTAGE OF HOUSEHOLD INCOME (GRAPI)!!Occupied units paying rent (excluding units where GRAPI cannot be computed)!!Less than 15.0 percent | Selected Housing Characteristics |
| DP04_0138P | Percent!!GROSS RENT AS A PERCENTAGE OF HOUSEHOLD INCOME (GRAPI)!!Occupied units paying rent (excluding units where GRAPI cannot be computed)!!15.0 to 19.9 percent | Selected Housing Characteristics |
| DP04_0139P | Percent!!GROSS RENT AS A PERCENTAGE OF HOUSEHOLD INCOME (GRAPI)!!Occupied units paying rent (excluding units where GRAPI cannot be computed)!!20.0 to 24.9 percent | Selected Housing Characteristics |
| DP04_0140P | Percent!!GROSS RENT AS A PERCENTAGE OF HOUSEHOLD INCOME (GRAPI)!!Occupied units paying rent (excluding units where GRAPI cannot be computed)!!25.0 to 29.9 percent | Selected Housing Characteristics |
| DP04_0141P | Percent!!GROSS RENT AS A PERCENTAGE OF HOUSEHOLD INCOME (GRAPI)!!Occupied units paying rent (excluding units where GRAPI cannot be computed)!!30.0 to 34.9 percent | Selected Housing Characteristics |
| DP04_0142P | Percent!!GROSS RENT AS A PERCENTAGE OF HOUSEHOLD INCOME (GRAPI)!!Occupied units paying rent (excluding units where GRAPI cannot be computed)!!35.0 percent or more | Selected Housing Characteristics |
| DP04_0143P | Percent!!GROSS RENT AS A PERCENTAGE OF HOUSEHOLD INCOME (GRAPI)!!Occupied units paying rent (excluding units where GRAPI cannot be computed)!!Not computed | Selected Housing Characteristics |
# Defining the variable to retrieve
VariableList =
c(Estimate_ = "DP04_0142P")
# Fetching data
AllData <- get_acs(
geography = "state legislative district (lower chamber)",
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% | |== | 3% | |==== | 6% | |======= | 10% | |========= | 13% | |=========== | 16% | |============= | 19% | |================ | 22% | |================== | 25% | |==================== | 29% | |====================== | 32% | |=========================== | 38% | |============================= | 41% | |================================= | 48% | |===================================== | 53% | |============================================ | 63% | |============================================== | 66% | |================================================ | 69% | |=================================================== | 72% | |======================================================= | 79% | |========================================================= | 82% | |============================================================== | 88% | |================================================================== | 95% | |======================================================================| 100%# Mutating, selecting and sorting the data
AllData <- AllData %>%
mutate(
District = NAME,
Estimate = Estimate_E,
Estimate_MOE = Estimate_M,
From = round(Estimate - Estimate_MOE, 2),
To = round(Estimate + Estimate_MOE, 2)
) %>%
select(District, Estimate, Estimate_MOE, From, To, geometry) %>%
arrange(desc(Estimate))
# Filtering for Rutherford County districts
MyData <- AllData %>%
filter(
District == "State House District 13 (2022), Tennessee" |
District == "State House District 37 (2022), Tennessee" |
District == "State House District 49 (2022), Tennessee" |
District == "State House District 48 (2022), Tennessee" |
District == "State House District 34 (2022), Tennessee"
)
# Producing a map
MapData <- st_as_sf(MyData)
MyMap <- mapview(MapData,
zcol = "Estimate",
layer.name = "Estimate",
popup = TRUE)
#Displaying the map
MyMap# Producing a table
TableData <- st_drop_geometry(MapData)
MyTable <- gt(TableData) %>%
tab_header("Estimate by district") %>%
cols_align(align = "left") %>%
gt_theme_538
# Displaying the table
MyTable| Estimate by district | ||||
| District | Estimate | Estimate_MOE | From | To |
|---|---|---|---|---|
| State House District 13 (2022), Tennessee | 42.9 | 7.7 | 35.2 | 50.6 |
| State House District 37 (2022), Tennessee | 40.3 | 5.5 | 34.8 | 45.8 |
| State House District 34 (2022), Tennessee | 35.9 | 4.8 | 31.1 | 40.7 |
| State House District 49 (2022), Tennessee | 35.7 | 5.6 | 30.1 | 41.3 |
| State House District 48 (2022), Tennessee | 34.4 | 5.9 | 28.5 | 40.3 |
if (!require("tidyverse"))
install.packages("tidyverse")
if (!require("mapview"))
install.packages("mapview")
if (!require("sf"))
install.packages("sf")
if (!require("leaflet"))
install.packages("leaflet")## Loading required package: leafletif (!require("leaflet.extras2"))
install.packages("leaflet.extras2")## Loading required package: leaflet.extras2if (!require("plotly"))
install.packages("plotly")## Loading required package: plotly##
## Attaching package: 'plotly'## The following object is masked from 'package:ggplot2':
##
## last_plot## The following object is masked from 'package:stats':
##
## filter## The following object is masked from 'package:graphics':
##
## layoutlibrary(tidyverse)
library(mapview)
library(sf)
library(leaflet)
library(leafpop)
library(readxl)
library(plotly)
# Download and import election data
# from TN Secretary of State web site:
# https://sos.tn.gov/elections/results
download.file(
"https://sos-prod.tnsosgovfiles.com/s3fs-public/document/20221108AllbyPrecinct.xlsx",
"RawElectionData.xlsx",
quiet = TRUE,
mode = "wb"
)
RawElectionData <- read_xlsx("RawElectionData.xlsx", sheet = "SOFFICELso")
# Filter, calculate, and select
# to get data of interest
# then store results in MyData dataframe
MyData <- RawElectionData %>%
filter(COUNTY == "Rutherford", CANDGROUP == "1") %>%
mutate(
Lee = PVTALLY1,
Martin = PVTALLY2,
Total = PVTALLY1 + PVTALLY2,
Lee_Pct = round(PVTALLY1 / (PVTALLY1 + PVTALLY2), 2),
Martin_Pct = round(PVTALLY2 / (PVTALLY1 + PVTALLY2), 2),
Winner = case_when(
PVTALLY1 > PVTALLY2 ~ "Lee (R)",
PVTALLY2 > PVTALLY1 ~ "Martin (D)",
.default = "Tie"
)
) %>%
select(COUNTY, PRECINCT, Total, Lee, Martin, Lee_Pct, Martin_Pct, Winner)
# Download and unzip a precinct map to pair with the vote data
download.file("https://github.com/drkblake/Data/raw/main/Voting_Precincts_5_31_24.zip","TNVotingPrecincts.zip")
unzip("TNVotingPrecincts.zip")
All_Precincts <- read_sf("Voting_Precincts_5_31_24.shp")
# Filter for particular county precincts
County_Precincts <- All_Precincts %>%
filter(COUNTY == 149) %>%
rename(PRECINCT = NEWVOTINGP)
# Merge election data and map file
MergeFile <- merge(MyData, County_Precincts, by = "PRECINCT", all.x = TRUE)
# Drop unneeded columns from MergeFile
MergeFile <- MergeFile %>%
select(PRECINCT,
Total,
Lee,
Martin,
Lee_Pct,
Martin_Pct,
Winner,
geometry)
# Format MergeFile as a map, and
# call the map MyMap
MyMapFile <- st_as_sf(MergeFile)
mypalette = colorRampPalette(c('blue', 'red'))
MyMap <- mapview(
MyMapFile,
zcol = "Lee_Pct",
col.regions = mypalette, at = seq(0, 1, .2),
map.types = ("OpenStreetMap"),
layer.name = "Pct. for Lee",
popup = popupTable(
MyMapFile,
feature.id = FALSE,
row.numbers = FALSE,
zcol = c(
"PRECINCT",
"Lee",
"Martin",
"Total",
"Lee_Pct",
"Martin_Pct",
"Winner"
)
)
)# Required packages
if (!require("tidyverse"))
install.packages("tidyverse")
if (!require("sf"))
install.packages("sf")
if (!require("mapview"))
install.packages("mapview")
if (!require("leaflet"))
install.packages("leaflet")
if (!require("leaflet.extras2"))
install.packages("leaflet.extras2")
library(tidyverse)
library(sf)
library(mapview)
library(leaflet)
library(leaflet.extras2)
library(leafpop)
mapviewOptions(basemaps.color.shuffle = FALSE)
# Load the address and lat/long data
Addresses_gc <- read_csv("https://raw.githubusercontent.com/drkblake/Data/refs/heads/main/EarlyVotingLocations_gc.csv")
# Add MTSU
long <- -86.361861
lat <- 35.848997
Addresses_gc <- Addresses_gc %>%
add_row(Location = "MTSU",
long = long,
lat = lat) %>%
mutate(Point = case_when(Location == "MTSU" ~ "MTSU",
TRUE ~ "Early vote here"))
MapData <- st_as_sf(Addresses_gc,
coords = c("long", "lat"),
crs = 4326)
# Make the map
MyMap <- mapview(MapData,
zcol = "Point",
layer.name = "Point",
col.regions = c("orange", "blue"),
map.types = c("OpenStreetMap","Esri.WorldImagery"),
popup = popupTable(
MapData,
feature.id = FALSE,
row.numbers = FALSE,
zcol = c("Location",
"Address",
"Week",
"Weekend")))
# Show the map
Required packages
if (!require(“tidyverse”)) install.packages(“tidyverse”) if (!require(“sf”)) install.packages(“sf”) if (!require(“mapview”)) install.packages(“mapview”) if (!require(“leaflet”)) install.packages(“leaflet”) if (!require(“leaflet.extras2”)) install.packages(“leaflet.extras2”)
library(tidyverse) library(sf) library(mapview) library(leaflet) library(leaflet.extras2) library(leafpop)
mapviewOptions(basemaps.color.shuffle = FALSE)
Load the address and lat/long data
Addresses_gc <- read_csv(“https://raw.githubusercontent.com/drkblake/Data/refs/heads/main/EarlyVotingLocations_gc.csv”)
Add MTSU
long <- -86.361861 lat <- 35.848997
Addresses_gc <- Addresses_gc %>% add_row(Location = “MTSU”, long = long, lat = lat) %>% mutate(Point = case_when(Location == “MTSU” ~ “MTSU”, TRUE ~ “Early vote here”))
MapData <- st_as_sf(Addresses_gc, coords = c(“long”, “lat”), crs = 4326)
Make the map
MyMap <- mapview(MapData, zcol = “Point”, layer.name = “Point”, col.regions = c(“orange”, “blue”), map.types = c(“OpenStreetMap”,“Esri.WorldImagery”), popup = popupTable( MapData, feature.id = FALSE, row.numbers = FALSE, zcol = c(“Location”, “Address”, “Week”, “Weekend”))) # Show the map
if (!require("tidyverse"))
install.packages("tidyverse")
if (!require("foreign"))
install.packages("foreign")## Loading required package: foreignif (!require("sf"))
install.packages("sf")
if (!require("scales"))
install.packages("scales")## Loading required package: scales##
## Attaching package: 'scales'## The following object is masked from 'package:purrr':
##
## discard## The following object is masked from 'package:readr':
##
## col_factorif (!require("mapview"))
install.packages("mapview")
if (!require("leaflet"))
install.packages("leaflet")
if (!require("leaflet.extras2"))
install.packages("leaflet.extras2")
library(tidyverse)
library(foreign)
library(sf)
library(scales)
library(mapview)
library(leaflet)
library(leafpop)
# Fetch and unzip the early voting files
download.file("https://github.com/drkblake/Data/raw/refs/heads/main/DailyEVFiles.zip","DailyEVFiles.zip")
unzip("DailyEVFiles.zip")
# Read the first daily voting file
AddData <- read.dbf("10162024.dbf")
AllData <- AddData
# Add each day's file name to this list, then run
datafiles <- c("10172024.dbf",
"10182024.dbf",
"10192024.dbf",
"10212024.dbf",
"10222024.dbf",
"10232024.dbf",
"10242024.dbf",
"10252024.dbf",
"10262024.dbf",
"10282024.dbf",
"10292024.dbf",
"10302024.dbf",
"10312024.dbf")
for (x in datafiles) {
AddData <- read.dbf(x, as.is = FALSE)
AllData <- rbind(AllData, AddData)
}
# Save AllData file as .csv
write_csv(AllData,"EarlyVoterData2024.csv")
# Get total votes so far
TotalVotes <- nrow(AllData)
PctVotes <- round((TotalVotes / 224746)*100, digits = 0)
VotesByDay <- AllData %>%
group_by(VOTEDDATE) %>%
summarize(Votes = n()) %>%
rename(Date = VOTEDDATE) %>%
mutate(Date = (str_remove(Date,"2024-")))
# "#2C7865" is a green shade
chart = ggplot(data = VotesByDay,
aes(x = Date,
y = Votes))+
geom_bar(stat="identity", fill = "#41B3A2") +
geom_text(aes(label=comma(Votes)),
vjust=1.6,
color="black",
size=3.5)+
theme(
axis.title.x = element_blank(),
axis.ticks.y = element_blank(),
axis.title.y = element_blank(),
axis.text.y = element_blank(),
panel.background = element_blank())
chart
### Precinct-level map of early voting turnout ***
# Aggregate early voting data by precinct
PrecinctData <- AllData %>%
group_by(PCT_NBR) %>%
summarize(Votes = n()) %>%
rename(Precinct = PCT_NBR)
# Download and unzip a precinct map to pair with the vote data
download.file("https://github.com/drkblake/Data/raw/main/Voting_Precincts_5_31_24.zip","TNVotingPrecincts.zip")
unzip("TNVotingPrecincts.zip")
All_Precincts <- read_sf("Voting_Precincts_5_31_24.shp")
# Filter for RuCo precincts and
# strip dash from precinct numbers
County_Precincts <- All_Precincts %>%
filter(COUNTY == 149) %>%
rename(Precinct = NEWVOTINGP) %>%
mutate(Precinct = (str_remove(Precinct,"-")))
MapData <- left_join(PrecinctData, County_Precincts, by = "Precinct")
RegData <- read_csv("https://raw.githubusercontent.com/drkblake/Data/refs/heads/main/RegVotersRuCo.csv") %>%
mutate(Precinct = as.character(Precinct))## Rows: 33 Columns: 2## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## dbl (2): Precinct, RegVoters
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.MapData <- left_join(MapData, RegData, by = "Precinct")
MapData <- MapData %>%
mutate(Percent = round((Votes/RegVoters)*100), digits = 0) %>%
rename(Voters = RegVoters) %>%
select(Precinct, Votes, Voters, Percent, geometry)
MapData_sf <- st_as_sf(MapData)
Map <- mapview(
MapData_sf,
zcol = "Percent",
layer.name = "Pct. early voted",
popup = popupTable(
MapData_sf,
feature.id = FALSE,
row.numbers = FALSE,
zcol = c(
"Precinct",
"Votes",
"Voters",
"Percent"
)
)
)
MapMinTurnout <- min(MapData$Percent)
MaxTurnout <- max(MapData$Percent)
MedianTurnout <- median(MapData$Percent)
MeanTurnout <- mean(MapData$Percent)if (!require("tidyverse"))
install.packages("tidyverse")
if (!require("plotly"))
install.packages("plotly")
library(tidyverse)
library(plotly)
# Defining date range
startdate <- "20240429"
enddate <- "20241112"
### Trump
# Defining query
# Note:
# In queries, use %20 to indicate a space
# Example: "Donald%20Trump" is "Donald Trump"
# Use parentheses and %20OR%20 for "either/or" queries
# Example: "(Harris%20OR%20Walz)" is "(Harris OR Walz)"
query <- "Donald%20Trump"
# Building the volume dataframe
vp1 <- "https://api.gdeltproject.org/api/v2/tv/tv?query="
vp2 <- "%20market:%22National%22&mode=timelinevol&format=csv&datanorm=raw&startdatetime="
vp3 <- "000000&enddatetime="
vp4 <- "000000"
text_v_url <- paste0(vp1, query, vp2, startdate, vp3, enddate, vp4)
v_url <- URLencode(text_v_url)
v_url## [1] "https://api.gdeltproject.org/api/v2/tv/tv?query=Donald%20Trump%20market:%22National%22&mode=timelinevol&format=csv&datanorm=raw&startdatetime=20240429000000&enddatetime=20241112000000"Trump <- read_csv(v_url)## Rows: 1494 Columns: 3
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (1): Series
## dbl (1): Value
## date (1): Date (Daily +00:00: 04/29/2024 - 11/12/2024)
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.Trump <- Trump %>%
rename(Date = 1, Trump = 3)
### Biden
# Defining query
query <- "Joe%20Biden"
# Building the volume dataframe
vp1 <- "https://api.gdeltproject.org/api/v2/tv/tv?query="
vp2 <- "%20market:%22National%22&mode=timelinevol&format=csv&datanorm=raw&startdatetime="
vp3 <- "000000&enddatetime="
vp4 <- "000000"
text_v_url <- paste0(vp1, query, vp2, startdate, vp3, enddate, vp4)
v_url <- URLencode(text_v_url)
v_url## [1] "https://api.gdeltproject.org/api/v2/tv/tv?query=Joe%20Biden%20market:%22National%22&mode=timelinevol&format=csv&datanorm=raw&startdatetime=20240429000000&enddatetime=20241112000000"Biden <- read_csv(v_url)## Rows: 1494 Columns: 3
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (1): Series
## dbl (1): Value
## date (1): Date (Daily +00:00: 04/29/2024 - 11/12/2024)
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.Biden <- Biden %>%
rename(Date = 1, Biden = 3)
AllData <- left_join(Trump, Biden)## Joining with `by = join_by(Date, Series)`### Harris
# Defining query
query <- "Kamala%20Harris"
# Building the volume dataframe
vp1 <- "https://api.gdeltproject.org/api/v2/tv/tv?query="
vp2 <- "%20market:%22National%22&mode=timelinevol&format=csv&datanorm=raw&startdatetime="
vp3 <- "000000&enddatetime="
vp4 <- "000000"
text_v_url <- paste0(vp1, query, vp2, startdate, vp3, enddate, vp4)
v_url <- URLencode(text_v_url)
v_url## [1] "https://api.gdeltproject.org/api/v2/tv/tv?query=Kamala%20Harris%20market:%22National%22&mode=timelinevol&format=csv&datanorm=raw&startdatetime=20240429000000&enddatetime=20241112000000"Harris <- read_csv(v_url)## Rows: 1494 Columns: 3
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (1): Series
## dbl (1): Value
## date (1): Date (Daily +00:00: 04/29/2024 - 11/12/2024)
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.Harris <- Harris %>%
rename(Date = 1, Harris = 3)
AllData <- left_join(AllData, Harris)## Joining with `by = join_by(Date, Series)`### Graphic
AllData <- AllData %>%
arrange(Date)
# Add "WeekOf" variable to the data frame
if (!require("lubridate"))
install.packages("lubridate")
library(lubridate)
AllData$WeekOf <- round_date(AllData$Date,
unit = "week",
week_start = getOption("lubridate.week.start", 1))
CombinedCoverage <- AllData %>%
group_by(WeekOf) %>%
summarize(
Trump = sum(Trump, na.rm = TRUE),
Biden = sum(Biden, na.rm = TRUE),
Harris = sum(Harris, na.rm = TRUE)
)
fig <- plot_ly(
CombinedCoverage,
x = ~ WeekOf,
y = ~ Trump,
name = 'Trump',
type = 'scatter',
mode = 'none',
stackgroup = 'one',
fillcolor = '#B8001F')
fig <- fig %>% add_trace(y = ~ Biden,
name = 'Biden',
fillcolor = '#507687')
fig <- fig %>% add_trace(y = ~ Harris,
name = 'Harris',
fillcolor = '#384B70')
fig <- fig %>% layout(
title = 'Segment counts, by topic and week',
xaxis = list(title = "Week of", showgrid = FALSE),
yaxis = list(title = "Count", showgrid = TRUE)
)
fig### Results for MSNBC, CNN, and Fox News, separately
# MSNBC
MSNBC <- AllData %>%
filter(Series == "MSNBC")
figMSNBC <- plot_ly(
MSNBC,
x = ~ WeekOf,
y = ~ Trump,
name = 'Trump',
type = 'scatter',
mode = 'none',
stackgroup = 'one',
fillcolor = '#B8001F')
figMSNBC <- figMSNBC %>% add_trace(y = ~ Biden,
name = 'Biden',
fillcolor = '#507687')
figMSNBC <- figMSNBC %>% add_trace(y = ~ Harris,
name = 'Harris',
fillcolor = '#384B70')
figMSNBC <- figMSNBC %>% layout(
title = 'Segment counts, MSNBC, by topic and week',
xaxis = list(title = "Week of", showgrid = FALSE),
yaxis = list(title = "Count", showgrid = TRUE)
)
figMSNBC# CNN
CNN <- AllData %>%
filter(Series == "CNN")
figCNN <- plot_ly(
CNN,
x = ~ WeekOf,
y = ~ Trump,
name = 'Trump',
type = 'scatter',
mode = 'none',
stackgroup = 'one',
fillcolor = '#B8001F')
figCNN <- figCNN %>% add_trace(y = ~ Biden,
name = 'Biden',
fillcolor = '#507687')
figCNN <- figCNN %>% add_trace(y = ~ Harris,
name = 'Harris',
fillcolor = '#384B70')
figCNN <- figCNN %>% layout(
title = 'Segment counts, CNN, by topic and week',
xaxis = list(title = "Week of", showgrid = FALSE),
yaxis = list(title = "Count", showgrid = TRUE)
)
figCNN#Fox News
FoxNews <- AllData %>%
filter(Series == "FOXNEWS")
figFox <- plot_ly(
FoxNews,
x = ~ WeekOf,
y = ~ Trump,
name = 'Trump',
type = 'scatter',
mode = 'none',
stackgroup = 'one',
fillcolor = '#B8001F')
figFox <- figFox %>% add_trace(y = ~ Biden,
name = 'Biden',
fillcolor = '#507687')
figFox <- figFox %>% add_trace(y = ~ Harris,
name = 'Harris',
fillcolor = '#384B70')
figFox <- figFox %>% layout(
title = 'Segment counts, Fox News, by topic and week',
xaxis = list(title = "Week of", showgrid = FALSE),
yaxis = list(title = "Count", showgrid = TRUE)
)if (!require("tidyverse"))
install.packages("tidyverse")
if (!require("tidycensus"))
install.packages("tidycensus")
if (!require("sf"))
install.packages("sf")
if (!require("mapview"))
install.packages("mapview")
if (!require("DataEditR"))
install.packages("DataEditR")## Loading required package: DataEditRif (!require("leaflet"))
install.packages("leaflet")
if (!require("leaflet.extras2"))
install.packages("leaflet.extras2")
if (!require("plotly"))
install.packages("plotly")
library(tidyverse)
library(tidycensus)
library(sf)
library(mapview)
library(DataEditR)
library(leaflet)
library(leafpop)
library(plotly)
# Getting a U.S.map shapefile
# Note: Provide your Census API key in the line below
census_api_key("16e35e5fa544d9e0253998884e6b633f82399b63")## To install your API key for use in future sessions, run this function with `install = TRUE`.# U.S. Map
omit <- c("Alaska", "Puerto Rico", "Hawaii")
USMap <- get_acs(
geography = "state",
variables = "DP02_0154P",
year = 2022,
survey = "acs5",
output = "wide",
geometry = TRUE) %>%
filter(!(NAME %in% omit)) %>%
mutate(Full = NAME) %>%
select(GEOID, Full, geometry)## 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% | |=== | 4% | |======= | 10% | |=========== | 15% | |============ | 17% | |============== | 20% | |================== | 25% | |===================== | 31% | |====================== | 32% | |========================= | 36% | |=========================== | 39% | |============================== | 43% | |================================= | 47% | |===================================== | 52% | |======================================== | 58% | |============================================ | 63% | |=============================================== | 67% | |=================================================== | 72% | |======================================================= | 78% | |========================================================== | 83% | |=========================================================== | 84% | |============================================================ | 86% | |=============================================================== | 90% | |=================================================================== | 96% | |==================================================================== | 97% | |======================================================================| 100%st_write(USMap,"USMap.shp", append = FALSE)## Deleting layer `USMap' using driver `ESRI Shapefile'
## Writing layer `USMap' to data source `USMap.shp' using driver `ESRI Shapefile'
## Writing 49 features with 2 fields and geometry type Multi Polygon.# Data file
USData <- read_csv("https://raw.githubusercontent.com/drkblake/Data/refs/heads/main/ElectoralVotesByState2024.csv")## Rows: 51 Columns: 6## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (2): Full, State
## dbl (4): Votes.to.allocate, Unallocated, Harris, Trump
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.# Edit / update election data
USData <- data_edit(USData)## Loading required package: shiny
##
## Listening on http://127.0.0.1:3759write_csv(USData,"ElectoralVotesByState2024.csv")
write_csv(USData,"ElectoralVotesByState2024_latest.csv")
# Merge election and map data
USWinners <- merge(USMap,USData) %>%
mutate(Winner = (case_when(
Harris > Trump ~ "Harris",
Trump > Harris ~ "Trump",
.default = "Counting"))) %>%
mutate(Votes = Votes.to.allocate) %>%
select(State, Votes, Harris, Trump, Winner, geometry)
# Make the election map
USpalette = colorRampPalette(c("darkblue","darkred"))
BigMap <- mapview(USWinners, zcol = "Winner",
col.regions = USpalette,
alpha.regions = .8,
layer.name = "Winner",
popup = popupTable(
USWinners,
feature.id = FALSE,
row.numbers = FALSE,
zcol = c(
"State",
"Votes",
"Harris",
"Trump",
"Winner")))
# Showing the map
BigMap# Make the electoral vote tracker
# Loading the data from a local .csv file
AllData <- read.csv("ElectoralVotesByState2024.csv")
AllData <- AllData %>%
arrange(State)
# Formatting and transforming the data for plotting
MyData <- AllData %>%
select(State, Votes.to.allocate,
Unallocated, Harris, Trump) %>%
arrange(State)
MyData <- MyData %>%
pivot_longer(cols=c(-State),names_to="Candidate")%>%
pivot_wider(names_from=c(State)) %>%
filter(Candidate == "Harris" |
Candidate == "Trump" |
Candidate == "Unallocated") %>%
arrange(Candidate)
MyData <- MyData %>%
mutate(total = rowSums(.[2:52]))
# Formatting a horizontal line for the plot
hline <- function(y = 0, color = "darkgray") {
list(
type = "line",
x0 = 0,
x1 = 1,
xref = "paper",
y0 = y,
y1 = y,
line = list(color = color)
)
}
# Producing the plot
fig <- plot_ly(
MyData,
x = ~ Candidate,
y = ~ AK,
legend = FALSE,
marker = list(color = c("384B70", "B8001F", "gray")),
type = 'bar',
name = 'AK'
) %>%
add_annotations(
visible = "legendonly",
x = ~ Candidate,
y = ~ (total + 20),
text = ~ total,
showarrow = FALSE,
textfont = list(size = 50)
)
fig <- fig %>% add_trace(y = ~ DE, name = 'DE')
fig <- fig %>% add_trace(y = ~ DC, name = 'DC')
fig <- fig %>% add_trace(y = ~ MT, name = 'MT')
fig <- fig %>% add_trace(y = ~ ND, name = 'ND')
fig <- fig %>% add_trace(y = ~ SD, name = 'SD')
fig <- fig %>% add_trace(y = ~ VT, name = 'VT')
fig <- fig %>% add_trace(y = ~ WY, name = 'WY')
fig <- fig %>% add_trace(y = ~ HI, name = 'HI')
fig <- fig %>% add_trace(y = ~ ID, name = 'ID')
fig <- fig %>% add_trace(y = ~ ME, name = 'ME')
fig <- fig %>% add_trace(y = ~ NH, name = 'NH')
fig <- fig %>% add_trace(y = ~ RI, name = 'RI')
fig <- fig %>% add_trace(y = ~ NE, name = 'NE')
fig <- fig %>% add_trace(y = ~ NM, name = 'NM')
fig <- fig %>% add_trace(y = ~ WV, name = 'WV')
fig <- fig %>% add_trace(y = ~ AR, name = 'AR')
fig <- fig %>% add_trace(y = ~ IA, name = 'IA')
fig <- fig %>% add_trace(y = ~ KS, name = 'KS')
fig <- fig %>% add_trace(y = ~ MS, name = 'MS')
fig <- fig %>% add_trace(y = ~ NV, name = 'NV')
fig <- fig %>% add_trace(y = ~ UT, name = 'UT')
fig <- fig %>% add_trace(y = ~ CT, name = 'CT')
fig <- fig %>% add_trace(y = ~ OK, name = 'OK')
fig <- fig %>% add_trace(y = ~ OR, name = 'OR')
fig <- fig %>% add_trace(y = ~ KY, name = 'KY')
fig <- fig %>% add_trace(y = ~ LA, name = 'LA')
fig <- fig %>% add_trace(y = ~ AL, name = 'AL')
fig <- fig %>% add_trace(y = ~ CO, name = 'CO')
fig <- fig %>% add_trace(y = ~ SC, name = 'SC')
fig <- fig %>% add_trace(y = ~ MD, name = 'MD')
fig <- fig %>% add_trace(y = ~ MN, name = 'MN')
fig <- fig %>% add_trace(y = ~ MO, name = 'MO')
fig <- fig %>% add_trace(y = ~ WI, name = 'WI')
fig <- fig %>% add_trace(y = ~ AZ, name = 'AZ')
fig <- fig %>% add_trace(y = ~ IN, name = 'IN')
fig <- fig %>% add_trace(y = ~ MA, name = 'MA')
fig <- fig %>% add_trace(y = ~ TN, name = 'TN')
fig <- fig %>% add_trace(y = ~ WA, name = 'WA')
fig <- fig %>% add_trace(y = ~ VA, name = 'VA')
fig <- fig %>% add_trace(y = ~ NJ, name = 'NJ')
fig <- fig %>% add_trace(y = ~ NC, name = 'NC')
fig <- fig %>% add_trace(y = ~ GA, name = 'GA')
fig <- fig %>% add_trace(y = ~ MI, name = 'MI')
fig <- fig %>% add_trace(y = ~ OH, name = 'OH')
fig <- fig %>% add_trace(y = ~ IL, name = 'IL')
fig <- fig %>% add_trace(y = ~ PA, name = 'PA')
fig <- fig %>% add_trace(y = ~ FL, name = 'FL')
fig <- fig %>% add_trace(y = ~ NY, name = 'NY')
fig <- fig %>% add_trace(y = ~ TX, name = 'TX')
fig <- fig %>% add_trace(y = ~ CA, name = 'CA')
fig <- fig %>% layout(yaxis = list(title = 'Electoral votes'),
barmode = 'stack',
showlegend = FALSE,
shapes = list(hline(270)))
# Showing the plotif (!require("tidyverse"))
install.packages("tidyverse")
if (!require("mapview"))
install.packages("mapview")
if (!require("sf"))
install.packages("sf")
if (!require("leaflet"))
install.packages("leaflet")
if (!require("leaflet.extras2"))
install.packages("leaflet.extras2")
if (!require("plotly"))
install.packages("plotly")
if (!require("tidycensus"))
install.packages("tidycensus")
library(tidyverse)
library(mapview)
library(sf)
library(leaflet)
library(leafpop)
library(readxl)
library(plotly)
library(tidycensus)
# Go ahead and transmit your Census API key
# so you don't forget to do it later when getting
# the map you will need:
census_api_key("16e35e5fa544d9e0253998884e6b633f82399b63")## To install your API key for use in future sessions, run this function with `install = TRUE`.# Download and import election data
# from TN Secretary of State web site:
# https://sos.tn.gov/elections/results
# Get 2016 data
download.file(
"https://sos-tn-gov-files.s3.amazonaws.com/StateGeneralbyPrecinctNov2016.xlsx",
"RawElectionData2016.xlsx",
quiet = TRUE,
mode = "wb"
)
RawElectionData2016 <- read_xlsx("RawElectionData2016.xlsx")
# Filter, calculate, and select
# to get data of interest
# then store results in MyData dataframe
MyData2016 <- RawElectionData2016%>%
filter(OFFICENAME == "United States President",
CANDGROUP == "1") %>%
mutate(
Rep16 = PVTALLY1,
Dem16 = PVTALLY2,
Total16 = Rep16 + Dem16) %>%
select(COUNTY, PRECINCT, OFFICENAME, Rep16, Dem16, Total16)
CountyData2016 <- MyData2016 %>%
select(COUNTY, Rep16, Dem16, Total16) %>%
group_by(COUNTY) %>%
summarize(across(everything(), sum))
# Get 2020 data
download.file(
"https://sos-tn-gov-files.tnsosfiles.com/Nov2020PrecinctDetail.xlsx",
"RawElectionData2020.xlsx",
quiet = TRUE,
mode = "wb"
)
RawElectionData2020 <- read_xlsx("RawElectionData2020.xlsx", sheet = "SOFFICEL")
# Filter, calculate, and select
# to get data of interest
# then store results in MyData dataframe
MyData2020 <- RawElectionData2020%>%
filter(OFFICENAME == "United States President",
CANDGROUP == "1") %>%
mutate(
Rep20 = PVTALLY1,
Dem20 = PVTALLY2,
Total20 = Rep20 + Dem20) %>%
select(COUNTY, PRECINCT, OFFICENAME, Rep20, Dem20, Total20)
MyData2020 <- MyData2020 %>%
mutate(COUNTY = case_when(COUNTY == "Dekalb" ~ "DeKalb",
TRUE ~ COUNTY))
CountyData2020 <- MyData2020%>%
select(COUNTY, Rep20, Dem20, Total20) %>%
group_by(COUNTY) %>%
summarize(across(everything(), sum))
# Get 2024 data
CountyData2024 <- read_csv("https://raw.githubusercontent.com/drkblake/Data/refs/heads/main/CountyData2024.csv")## Rows: 95 Columns: 4## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (1): COUNTY
## dbl (3): Rep24, Dem24, Total24
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.# Merge Data Files
AllData <- left_join(CountyData2016, CountyData2020, by = "COUNTY")
AllData <- left_join(AllData, CountyData2024, by = "COUNTY")
AllData <- AllData %>%
mutate(
Rep16to20 = Rep20-Rep16,
Dem16to20 = Dem20-Dem16,
Rep20to24 = Rep24-Rep20,
Dem20to24 = Dem24-Dem20,
Rep20finish = case_when(
Rep16to20 < 0 ~ "Loss",
Rep16to20 > 0~ "Gain",
TRUE ~ "No change"),
Dem20finish = case_when(
Dem16to20 < 0 ~ "Loss",
Dem16to20 > 0~ "Gain",
TRUE ~ "No change"),
Rep24finish = case_when(
Rep20to24 < 0 ~ "Loss",
Rep20to24 > 0~ "Gain",
TRUE ~ "No change"),
Dem24finish = case_when(
Dem20to24 < 0 ~ "Loss",
Dem20to24 > 0~ "Gain",
TRUE ~ "No change"))
# Get a county map
CountyMap <- get_acs(geography = "county",
state = "TN",
variables = c(Japanese_ = "DP05_0048"),
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% | |===== | 7% | |====== | 8% | |======= | 10% | |======== | 11% | |========= | 13% | |========== | 14% | |=========== | 16% | |============ | 17% | |============= | 19% | |============== | 20% | |=============== | 21% | |=============== | 22% | |================ | 23% | |================= | 25% | |================== | 26% | |=================== | 27% | |=================== | 28% | |==================== | 28% | |==================== | 29% | |===================== | 30% | |====================== | 32% | |======================= | 33% | |======================== | 35% | |========================= | 36% | |=========================== | 38% | |============================ | 39% | |============================= | 41% | |============================== | 42% | |=============================== | 44% | |================================ | 45% | |================================= | 47% | |================================== | 49% | |=================================== | 50% | |==================================== | 52% | |===================================== | 53% | |====================================== | 55% | |======================================= | 56% | |======================================== | 58% | |========================================== | 59% | |=========================================== | 61% | |============================================ | 63% | |============================================= | 64% | |============================================== | 65% | |=============================================== | 67% | |================================================ | 68% | |================================================= | 70% | |================================================== | 71% | |=================================================== | 73% | |==================================================== | 75% | |===================================================== | 76% | |====================================================== | 78% | |======================================================= | 79% | |======================================================== | 81% | |========================================================== | 82% | |=========================================================== | 84% | |============================================================ | 85% | |============================================================= | 87% | |============================================================== | 88% | |=============================================================== | 90% | |================================================================ | 92% | |================================================================= | 93% | |================================================================== | 95% | |=================================================================== | 96% | |==================================================================== | 98% | |======================================================================| 99% | |======================================================================| 100%CountyMap <- CountyMap %>%
mutate(COUNTY = (str_remove(NAME," County, Tennessee"))) %>%
left_join(AllData, CountyMap, by = "COUNTY") %>%
select(COUNTY,
Rep16, Dem16, Total16,
Rep20, Dem20, Total20,
Rep24, Dem24, Total24,
Rep16to20, Dem16to20,
Rep20to24, Dem20to24,
Rep20finish,Dem20finish,
Rep24finish,Dem24finish,
geometry)
# 2020 Map
Map16to20Rep <- mapview(
CountyMap,
zcol = "Rep20finish",
col.regions = "red",
layer.name = "Rep 2020",
popup = popupTable(
CountyMap,
feature.id = FALSE,
row.numbers = FALSE,
zcol = c("COUNTY", "Rep16", "Rep20", "Rep16to20")
)
)
mypalette = colorRampPalette(c('blue', 'lightblue'))
Map16to20Dem <- mapview(
CountyMap,
zcol = "Dem20finish",
col.regions = mypalette,
layer.name = "Dem 2020",
popup = popupTable(
CountyMap,
feature.id = FALSE,
row.numbers = FALSE,
zcol = c("COUNTY", "Dem16", "Dem20", "Dem16to20")
)
)
Map16to20Dem | Map16to20Rep# 2024 Map
mypalette = colorRampPalette(c('red', 'pink'))
Map20to24Rep <- mapview(
CountyMap,
zcol = "Rep24finish",
col.regions = mypalette,
layer.name = "Rep 2024",
popup = popupTable(
CountyMap,
feature.id = FALSE,
row.numbers = FALSE,
zcol = c("COUNTY", "Rep20", "Rep24", "Rep20to24")
)
)
mypalette = colorRampPalette(c('blue', 'lightblue'))
Map20to24Dem <- mapview(
CountyMap,
zcol = "Dem24finish",
col.regions = mypalette,
layer.name = "Dem 2024",
popup = popupTable(
CountyMap,
feature.id = FALSE,
row.numbers = FALSE,
zcol = c("COUNTY", "Dem20", "Dem24", "Dem20to24")
)
)