Math2270 Assignment2

Deconstruct, Reconstruct Web Report"

Original Data Visualisation

Source: reddit r/dataisbeautiful (2022)

Reference Lindelof, V. (2022). Heatmap showing US performance in 16 different areas ordered by percentage of people voting for the GOP in the 2020 election. Retrieved April 15, 2022 from: https://www.reddit.com/r/dataisbeautiful/comments/udv8r1/oc_heatmap_showing_us_states_performance_in_16/?utm_source=share&utm_medium=web2x&context=3)

Objective & target audience

The target audience for this data visualisation is American voters. The data is being used to try to suggest that states that demonstrate a lower quality of life and performance (in terms of socio-economic metrics) is correlated with the population that voted for Donald Trump in the 2020 election.

The visualisation chosen had the following three main issues:

References are not to the original data source, and some of the original data sources are not able to be verified.
Colour blindness – the use of the colour scale (red, yellow, green) doesn’t allow interpretation by people with colour blindness.
Legend – There is no legend to indicate the scale for each of the variables, and all the variables are on different scales, which is not immediately evident.

Code to reconstruct data visualisation

The following code was used to fix the issues identified in the original Note: data that the original source could not be found or verified has been omitted.

# Load the necessary packages required to reproduce the report.
library(ggplot2)

## Warning: package 'ggplot2' was built under R version 4.1.3

library(colourpicker)

## Warning: package 'colourpicker' was built under R version 4.1.3

library(magrittr) 
library(dplyr)

## 
## Attaching package: 'dplyr'

## The following objects are masked from 'package:stats':
## 
##     filter, lag

## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union

library(maps)

## Warning: package 'maps' was built under R version 4.1.3

library(ggeasy)

## Warning: package 'ggeasy' was built under R version 4.1.3

# Load US state map data
States <- map_data("state")
df <- read.csv("DataIsUgly.csv", header=TRUE)
df$Trump..of.2020.vote <- df$Trump..of.2020.vote*100
df$STATE <- tolower(df$STATE)
df2 <- full_join(States,df, by = c("region"="STATE"))

#Votes
votes<- ggplot()+ 
  geom_polygon(data = df2, aes(x=long, y=lat, group = group, fill=Trump..of.2020.vote), colour="white") +
  labs(x="",y="", title = "2020 election votes for Trump (%)") +
  coord_map() +
  theme_classic() + 
  theme(text=element_text(size=7),axis.ticks.y = element_blank(), axis.text.y = element_blank(), axis.ticks.x =element_blank(), axis.text.x = element_blank()) +
  theme(legend.title = element_blank(), legend.key.size = unit(1, 'cm'), legend.key.height = unit(0.5, 'cm'), legend.key.width = unit(0.1, 'cm')) +
  scale_fill_gradient(name="Trump..of.2020.vote",low="blue",high="red") +ggeasy::easy_center_title()

#Healthcare
health<- ggplot()+ 
  geom_polygon(data = df2, aes(x=long, y=lat, group = group, fill=HEALTHCARE..RANK), colour="white") +
  labs(x="",y="", title = "2020 Healthcare Rank by State") +
  coord_map() +
  theme_classic() + 
  theme(text=element_text(size=7), axis.ticks.y = element_blank(), axis.text.y = element_blank(), axis.ticks.x =element_blank(), axis.text.x = element_blank(), legend.title = element_blank())+
  theme(legend.title = element_blank(), legend.key.size = unit(1, 'cm'), legend.key.height = unit(0.5, 'cm'), legend.key.width = unit(0.1, 'cm')) +
  scale_fill_gradient(name="HEALTHCARE..RANK",low="blue",high="red") + ggeasy::easy_center_title()

#Covid death rate
covid<- ggplot()+ 
  geom_polygon(data = df2, aes(x=long, y=lat, group = group, fill=Covid.death.rater.per.100.000.people), colour="white") +
  labs(x="",y="", title = "Covid Death rate/100k people as of 2022") +
  coord_map() +
  theme_classic() + 
  theme(text=element_text(size=7), axis.ticks.y = element_blank(), axis.text.y = element_blank(), axis.ticks.x =element_blank(), axis.text.x = element_blank(), legend.title = element_blank())+
  theme(legend.title = element_blank(), legend.key.size = unit(1, 'cm'), legend.key.height = unit(0.5, 'cm'), legend.key.width = unit(0.1, 'cm')) +
  scale_fill_gradient(name="Covid.death.rater.per.100.000.people",low="blue",high="red") + ggeasy::easy_center_title()

#Vaccination rate
vacc<- ggplot()+ 
  geom_polygon(data = df2, aes(x=long, y=lat, group = group, fill=Vaccination.rate), colour="white") +
  labs(x="",y="", title = "2021 Covid Vaccination Rate (%)") +
  coord_map() +
  theme_classic() + 
  theme(text=element_text(size=7), axis.ticks.y = element_blank(), axis.text.y = element_blank(), axis.ticks.x =element_blank(), axis.text.x = element_blank(), legend.title = element_blank())+
  theme(legend.title = element_blank(), legend.key.size = unit(1, 'cm'), legend.key.height = unit(0.5, 'cm'), legend.key.width = unit(0.1, 'cm')) +
  scale_fill_gradient(name="Vaccination.rate",low="blue",high="red") + ggeasy::easy_center_title()

#Life expectancy
life<- ggplot()+ 
  geom_polygon(data = df2, aes(x=long, y=lat, group = group, fill=Life.expectancy.in.years), colour="white") +
  labs(x="",y="", title = "2019 Life Expectancy (years)") +
  coord_map() +
  theme_classic() + 
  theme(text=element_text(size=7), axis.ticks.y = element_blank(), axis.text.y = element_blank(), axis.ticks.x =element_blank(), axis.text.x = element_blank(), legend.title = element_blank())+
  theme(legend.title = element_blank(), legend.key.size = unit(1, 'cm'), legend.key.height = unit(0.5, 'cm'), legend.key.width = unit(0.1, 'cm')) +
  scale_fill_gradient(name="Life.expectancy.in.years",low="blue",high="red") +ggeasy::easy_center_title()

#Emotional wellbeing
wellness<- ggplot()+ 
  geom_polygon(data = df2, aes(x=long, y=lat, group = group, fill=Emotional...physical.Well.being.score), colour="white") +
  labs(x="",y="", title = "2021 Happiness score") +
  coord_map() +
  theme_classic() + 
  theme(text=element_text(size=7), axis.ticks.y = element_blank(), axis.text.y = element_blank(), axis.ticks.x =element_blank(), axis.text.x = element_blank(), legend.title = element_blank())+
  theme(legend.title = element_blank(), legend.key.size = unit(1, 'cm'), legend.key.height = unit(0.5, 'cm'), legend.key.width = unit(0.1, 'cm')) +
  scale_fill_gradient(name="Emotional...physical.Well.being.score",low="blue",high="red") +ggeasy::easy_center_title()

#Suicide mortality 
suicide <- ggplot()+ 
  geom_polygon(data = df2, aes(x=long, y=lat, group = group, fill=X.Suicide.mortality.per.100.000.people), colour="white") +
  labs(x="",y="", title = "2020 Suicide Mortality /100k") +
  coord_map() +
  theme_classic() + 
  theme(text=element_text(size=7), axis.ticks.y = element_blank(), axis.text.y = element_blank(), axis.ticks.x =element_blank(), axis.text.x = element_blank(), legend.title = element_blank())+
  theme(legend.title = element_blank(), legend.key.size = unit(1, 'cm'), legend.key.height = unit(0.5, 'cm'), legend.key.width = unit(0.1, 'cm')) +
  scale_fill_gradient(name="X.Suicide.mortality.per.100.000.people",low="blue",high="red") +ggeasy::easy_center_title()

#Income per capita
income <- ggplot()+ 
  geom_polygon(data = df2, aes(x=long, y=lat, group = group, fill=INCOME.PER.CAPITA), colour="white") +
  labs(x="",y="", title = "2020 Income per Capita") +
  coord_map() +
  theme_classic() + 
  theme(text=element_text(size=7), axis.ticks.y = element_blank(), axis.text.y = element_blank(), axis.ticks.x =element_blank(), axis.text.x = element_blank(), legend.title = element_blank())+
  theme(legend.title = element_blank(), legend.key.size = unit(1, 'cm'), legend.key.height = unit(0.3, 'cm'), legend.key.width = unit(0.1, 'cm')) +
  scale_fill_gradient(name="INCOME.PER.CAPITA",low="blue",high="red") +ggeasy::easy_center_title()

#Poverty
poverty <- ggplot()+ 
  geom_polygon(data = df2, aes(x=long, y=lat, group = group, fill=Poverty.Rate), colour="white") +
  labs(x="",y="", title = "2019 Poverty Rate (%)") +
  coord_map() +
  theme_classic() + 
  theme(text=element_text(size=7), axis.ticks.y = element_blank(), axis.text.y = element_blank(), axis.ticks.x =element_blank(), axis.text.x = element_blank(), legend.title = element_blank())+
  theme(legend.title = element_blank(), legend.key.size = unit(1, 'cm'), legend.key.height = unit(0.3, 'cm'), legend.key.width = unit(0.1, 'cm')) +
  scale_fill_gradient(name="Poverty.Rate",low="blue",high="red") +ggeasy::easy_center_title()

#Working conditions
work <- ggplot()+ 
  geom_polygon(data = df2, aes(x=long, y=lat, group = group, fill=Working.conditions.score), colour="white") +
  labs(x="",y="", title = "2020 Working Conditions Score") +
  coord_map() +
  theme_classic() + 
  theme(text=element_text(size=7), axis.ticks.y = element_blank(), axis.text.y = element_blank(), axis.ticks.x =element_blank(), axis.text.x = element_blank(), legend.title = element_blank())+
  theme(legend.title = element_blank(), legend.key.size = unit(1, 'cm'), legend.key.height = unit(0.3, 'cm'), legend.key.width = unit(0.1, 'cm')) +
  scale_fill_gradient(name="Working.conditions.score",low="blue",high="red") +ggeasy::easy_center_title()

#Public schooling
school <- ggplot()+ 
  geom_polygon(data = df2, aes(x=long, y=lat, group = group, fill=PUBLIC.SCHOOL.RANKINGS), colour="white") +
  labs(x="",y="", title = "2021 Public School Ranking") +
  coord_map() +
  theme_classic() + 
  theme(text=element_text(size=7), axis.ticks.y = element_blank(), axis.text.y = element_blank(), axis.ticks.x =element_blank(), axis.text.x = element_blank(), legend.title = element_blank())+
  theme(legend.title = element_blank(), legend.key.size = unit(1, 'cm'), legend.key.height = unit(0.3, 'cm'), legend.key.width = unit(0.1, 'cm')) +
  scale_fill_gradient(name="PUBLIC.SCHOOL.RANKINGS",low="blue",high="red") +ggeasy::easy_center_title()

#Teen Pregnancy
pregnancy <- ggplot()+ 
  geom_polygon(data = df2, aes(x=long, y=lat, group = group, fill=Teen.pregnancy.rate.per.100.000.people), colour="white") +
  labs(x="",y="", title = "2020 Teen Pregnancy Rate /100k") +
  coord_map() +
  theme_classic() + 
  theme(text=element_text(size=7), axis.ticks.y = element_blank(), axis.text.y = element_blank(), axis.ticks.x =element_blank(), axis.text.x = element_blank(), legend.title = element_blank())+
  theme(legend.title = element_blank(), legend.key.size = unit(1, 'cm'), legend.key.height = unit(0.3, 'cm'), legend.key.width = unit(0.1, 'cm')) +
  scale_fill_gradient(name="Teen.pregnancy.rate.per.100.000.people",low="blue",high="red") +ggeasy::easy_center_title()

#Homicide rate 
homicide <- ggplot()+ 
  geom_polygon(data = df2, aes(x=long, y=lat, group = group, fill=Homiciderate.per.100.000.people), colour="white") +
  labs(x="",y="", title = "2020 Homicide Rate /100k") +
  coord_map() +
  theme_classic() + 
  theme(text=element_text(size=7), axis.ticks.y = element_blank(), axis.text.y = element_blank(), axis.ticks.x =element_blank(), axis.text.x = element_blank(), legend.title = element_blank())+
  theme(legend.title = element_blank(), legend.key.size = unit(1, 'cm'), legend.key.height = unit(0.3, 'cm'), legend.key.width = unit(0.1, 'cm')) +
  scale_fill_gradient(name="Homiciderate.per.100.000.people",low="blue",high="red") +ggeasy::easy_center_title()

#Incarceration rate
incarceration <- ggplot()+ 
  geom_polygon(data = df2, aes(x=long, y=lat, group = group, fill=Incarceration.rate.per.100.000.people), colour="white") +
  labs(x="",y="", title = "2019 Incarceration Rate /100k") +
  coord_map() +
  theme_classic() + 
  theme(text=element_text(size=7), axis.ticks.y = element_blank(), axis.text.y = element_blank(), axis.ticks.x =element_blank(), axis.text.x = element_blank(), legend.title = element_blank())+
  theme(legend.title = element_blank(), legend.key.size = unit(1, 'cm'), legend.key.height = unit(0.3, 'cm'), legend.key.width = unit(0.1, 'cm')) +
  scale_fill_gradient(name="Incarceration.rate.per.100.000.people",low="blue",high="red") +ggeasy::easy_center_title()

#Firearm mortality
firearm <- ggplot()+ 
  geom_polygon(data = df2, aes(x=long, y=lat, group = group, fill=Firearm.mortality.per.100.000.people), colour="white") +
  labs(x="",y="", title = "2020 Firearm Mortality /100k") +
  coord_map() +
  theme_classic() + 
  theme(text=element_text(size=7), axis.ticks.y = element_blank(), axis.text.y = element_blank(), axis.ticks.x =element_blank(), axis.text.x = element_blank(), legend.title = element_blank())+
  theme(legend.title = element_blank(), legend.key.size = unit(1, 'cm'), legend.key.height = unit(0.3, 'cm'), legend.key.width = unit(0.1, 'cm')) +
  scale_fill_gradient(name="Firearm.mortality.per.100.000.people",low="blue",high="red") +ggeasy::easy_center_title()

fig.cap="US performance in health related metrics according to state with reference to Trump voters in the 2020 election"
fig1 <- ggpubr::ggarrange(votes,  health, covid, vacc, life, suicide, ncol =2, nrow = 3)

fig.cap="US performance in economic metrics according to state with reference to Trump voters in the 2020 election"
fig2 <- ggpubr::ggarrange(votes, income, poverty, work, school, pregnancy, ncol =2, nrow = 3)

fig.cap="US performance in crime related metrics according to state with reference to Trump voters in the 2020 election"
fig3 <- ggpubr::ggarrange(votes, homicide, incarceration, firearm, ncol = 2, nrow = 2)

Reconstructed Visualisations

US performance in health related metrics according to state with reference to Trump voters in the 2020 election

US performance in economic metrics according to state with reference to Trump voters in the 2020

US performance in crime related metrics according to state with reference to Trump voters in the 2020 election

References

AMERICA, O. 2020. Best and Worst States to Work in America 2020 [Online]. Oxfam. Available: https://www.oxfamamerica.org/explore/countries/united-states/poverty-in-the-us/best-and-worst-states-work-america-2020/ [Accessed 2022].
FRY, E. & RAPP, N. 2021. America won’t make Biden’s July 4 COVID vaccine goal. See which states will. Fortune.
MCCANN, A. 2021a. Happiest States in America [Online]. Wallet Hub. Available: https://wallethub.com/edu/happiest-states/6959 [Accessed 2022].
MCCANN, A. 2021b. States with the best & worst school systems [Online]. WallettHub. Available: https://wallethub.com/edu/e/states-with-the-best-schools/5335#methodology [Accessed 2022].
US NEWS, Health Care Quality Rankings [Online]. U.S.News & World Report. Available: https://www.usnews.com/news/best-states/rankings/health-care/healthcare-quality [Accessed 2022].
RATLEY, G. 2022. States Ranked by Age-Adjusted COVID Deaths [Online]. The Bioinformatics CRO. Available: https://www.bioinformaticscro.com/blog/states-ranked-by-age-adjusted-covid-deaths/ [Accessed 2022].
NATIONAL CENTER FOR HEALTH STATISTICS. 2019a. Life Expectancy at Birth by State [Online]. Centers for Disease Control and Prevention. Available: https://www.cdc.gov/nchs/pressroom/sosmap/life_expectancy/life_expectancy.htm [Accessed 2022].
NATIONAL CENTER FOR HEALTH STATISTICS. 2020a. Firearm Mortality by State [Online]. Centers for Disease Control and Prevention. Available: https://www.cdc.gov/nchs/pressroom/sosmap/firearm_mortality/firearm.htm [Accessed 2022].
NATIONAL CENTER FOR HEALTH STATISTICS. 2020b. Homicide Mortality by State [Online]. Centers for Disease Control and Prevention. Available: https://www.cdc.gov/nchs/pressroom/sosmap/homicide_mortality/homicide.htm [Accessed 2020].
NATIONAL CENTER FOR HEALTH STATISTICS. 2020c. Suicide Mortality by State [Online]. Centers for Disease Control and Prevention. Available: https://www.cdc.gov/nchs/pressroom/sosmap/suicide-mortality/suicide.htm [Accessed 2022].
NATIONAL CENTER FOR HEALTH STATISTICS. 2020d. Teen Birth Rate by State [Online]. Centers for DiseaeControl and Prevention. Available: https://www.cdc.gov/nchs/pressroom/sosmap/teen-births/teenbirths.htm [Accessed 2022].
US BUREAU OF JUSTICE STATISTICS. 2019b. State Imprisonment Rate [Online]. Sentencing Project. Available: https://www.sentencingproject.org/the-facts/#rankings [Accessed 2022].
UNKNOWN. 2021. Per capita personal income in the United States in 2020, by state [Online]. Statista Research Department. Available: https://www.statista.com/statistics/303555/us-per-capita-personal-income/ [Accessed 2022].
WASSERMAN, D., ANDREWS, S., SAENGER, L., COHEN, L., FLINN, A. & TATARSKY, G. 2020. 2020 National Popular Vote Tracker [Online]. The Cook Political Report. Available: https://www.cookpolitical.com/2020-national-popular-vote-tracker [Accessed 2022].