Project Overview

This project uses the same COVID Impact Survey data as our Shiny app, which we chose for the ability to explore relationships between different variables in a deeper and more meaningful way. The survey was administered by the Data Foundation, a non-governmental organization, and focuses on physical health, economic and food security, and unemployment. This survey included 2,047 adults was conducted from May 30th to June 8th using a sample drawn from NORC’s probability-based AmeriSpeak Panel, which is designed to be representative of the U.S. population. The data, and more information about the COVID Impact Survey, is available here.

In order to expand our Shiny app analysis, we wanted to explore more holistic relationships in the data by making complex comparisons between multiple variables at once. First, we used k-means clustering to form groupings in the data based on similarities in a few variables. We then continued our analysis by determining whether these clusters could predict the values of other variables. Because the clusters were designed to group respondents by the degree to which they had felt particular impacts of the pandemic, we explored the relationship between cluster assignment and both demographic and economic health variables. This allowed us to further explore which variables in the dataset best predict impacts of COVID-19 on individual economic health.

K-Means Clustering

One of the first steps we took was determining which variables would be best to use to form our clusters. We had two primary requirements in mind: (a) variables have to be numeric and ordinal, and (b) variables should have enough variation to form clusters that are sufficiently different from each other. Because our data was based on a survey, almost all the variables were categorical. We chose variables that could be coerced into a numeric format, either because the question required the respondent to rate themselves on a scale or because the question had a set of other ordered, categorical answers. The variables we ended up including in our clustering analysis were:

• Age (which has seven answers each of which included a range)
• Household Income (which is structured similar to age with nine categories)
• Education (which has seven answers related to various levels of schooling)
• Short-Term Employment Confidence (the respondent’s level of confidence that they would be employed in 30 days)
• Long-Term Employment Confidence (the respondent’s level of confidence that they would be employed in three months)
  • Note: both the Employment Confidence variables required the respondent rate themselves on a scale from one to five, with one being “Extremely likely”

Next, we created an elbow plot to compare the number of clusters with inter-cluster variation. We were looking for an “elbow” in the graph’s line where there would be a sharp decrease in the change in inter-cluster variation as the number of clusters increases. The point where this elbow occurs signals the optimal number of clusters for the data.

kmeans_data <- read.csv("~/Desktop/DataScience/git/Blog-Girls-Who-Code/kmeans_data.csv") 

# Creating elbow plot

fig <- matrix(NA, nrow=15, ncol=2)

set.seed(75)
for (i in 1:15){
  fig[i,1] <- i
  fig[i,2] <- kmeans(kmeans_data
                    , centers=i
                    , nstart=20)$tot.withinss
}

ggplot(data = as.data.frame(fig), aes(x = V1, y = V2)) +
  geom_point() + 
  geom_line() +
  scale_x_continuous(breaks=c(1:15)) +
  labs(x = "K", y = expression("Total W"[k]))

# Performing kmeans clustering analysis with various numbers of centroids

set.seed(23)
km2_out <- kmeans(kmeans_data, centers = 2, nstart = 20)
km2_out$centers

##     ECON4A   ECON4B HHINCOME EDUCATION     AGE7
## 1 1.535917 1.486547 6.399654  4.550481 3.444335
## 2 4.514916 4.309987 4.590143  3.873541 5.058042

kmeans_data2 <- kmeans_data %>%
  mutate(clust2 = as.character(km2_out$cluster))

set.seed(23)
km4_out <- kmeans(kmeans_data, centers = 4, nstart = 20)
km4_out$centers

##     ECON4A   ECON4B HHINCOME EDUCATION     AGE7
## 1 1.417180 1.414281 7.428779  5.023197 3.674520
## 2 4.667752 4.497557 2.727199  3.159609 5.186482
## 3 2.043822 1.841144 3.503956  3.234327 2.825320
## 4 4.748173 4.560797 6.962791  4.868439 5.583389

kmeans_data2 <- kmeans_data2 %>%
  mutate(clust4 = as.character(km4_out$cluster))

set.seed(23)
km5_out <- kmeans(kmeans_data, centers = 5, nstart = 20)
km5_out$centers

##     ECON4A   ECON4B HHINCOME EDUCATION     AGE7
## 1 1.810420 1.685239 6.318379  3.401592 3.105644
## 2 1.340618 1.368870 7.755330  5.669510 3.842217
## 3 4.775312 4.599168 7.000000  4.907767 5.650485
## 4 2.094926 1.877250 2.717676  3.330606 2.882160
## 5 4.685078 4.526793 2.790602  3.211871 5.261336

kmeans_data2 <- kmeans_data2 %>%
  mutate(clust5 = as.character(km5_out$cluster))

set.seed(23)
km7_out <- kmeans(kmeans_data, centers = 7, nstart = 20)
km7_out$centers

##     ECON4A   ECON4B HHINCOME EDUCATION     AGE7
## 1 1.327539 1.346752 7.692589  5.572736 4.877402
## 2 3.920255 3.462520 2.548644  2.732057 2.188198
## 3 1.522472 1.452809 2.952809  3.651685 3.305618
## 4 4.812224 4.655376 7.053019  4.926362 5.691458
## 5 1.704520 1.566703 6.447630  2.776185 3.593164
## 6 1.599190 1.580567 7.274494  5.441296 2.399190
## 7 4.708293 4.568780 2.962927  3.315122 5.810732

kmeans_data2 <- kmeans_data2 %>%
  mutate(clust7 = as.character(km7_out$cluster))

set.seed(23)
km11_out <- kmeans(kmeans_data, centers = 11, nstart = 20)
km11_out$centers

##      ECON4A   ECON4B HHINCOME EDUCATION     AGE7
## 1  1.270492 1.312500 7.443648  5.540984 2.419057
## 2  1.701375 1.583497 3.343811  3.565815 4.893910
## 3  1.319108 1.343356 7.716780  5.650824 4.862270
## 4  3.878486 3.452191 2.223108  2.396414 2.213147
## 5  1.406077 1.348066 6.701657  2.819061 3.812155
## 6  4.826855 4.731449 2.547703  2.427562 5.772085
## 7  3.686316 3.250526 6.871579  4.284211 2.440000
## 8  1.570288 1.476038 3.212460  3.744409 2.060703
## 9  4.821138 4.725203 6.185366  3.452033 6.019512
## 10 4.822604 4.659514 7.656652  5.798283 5.861230
## 11 4.643204 4.427184 3.196602  5.237864 5.584951

kmeans_data2 <- kmeans_data2 %>%
  mutate(clust11 = as.character(km11_out$cluster))

As we can see, there’s not a clear elbow in the plot for our data. While the decrease in inter-cluster variation definitely isn’t constant, the change decreases fairly steadily. We decided to perform the rest of our analysis using four clusters because the change in inter-cluster variation seems to decrease more noticeably after that point and the centroids of the clusters are more varied than the centroids of larger numbers of clusters.

We then created a pairs diagram to examine the differences between the clusters. Unfortunately, it’s difficult to determine a clear pattern in the scatter and density plots.

As we can see, there is not a clear elbow in the plot for our data. While the decrease in inter-cluster variation is not constant, this decrease changes fairly steadily. We decided to perform the rest of our analysis using four clusters for two reasons:

1. The change in inter-cluster variation seems to decrease more slowly after the use of four clusters.
2. The centroids of our four cluster k-means analysis are more varied than the centroids of our k-means analyses with larger numbers of clusters.

Pairs Diagram

We then created a pairs diagram to examine differences between the clusters. Unfortunately, it is difficult to determine a clear pattern in the scatter and density plots. In order to better understand the variables driving cluster formation, we created separate density plots to simplify the pairs diagram.

# Creating pairs diagram 

vars <- c("ECON4A", "ECON4B", "HHINCOME", "EDUCATION", "AGE7")

ggpairs(data = kmeans_data2
        , aes(color = clust4) 
        , columns = vars
        , upper = list(continuous = "blank"))

While the original pairs diagram did not contain a lot of helpful information about the clusters, it was clear that income and age were driving variables in the cluster assignment. The variation between clusters was most clear in the density plots for these variables.

Density Plots

In order to further explore the patterns observed from our pairs diagram, we created the following density plots. These plots show the distribution of responses to the age and income questions across clusters.

# Adding cluster assignments to dataset with all variables of interest (relevant later)

post_cluster_vars <- read.csv("~/Desktop/DataScience/git/Blog-Girls-Who-Code/post_cluster_data.csv")
  
alL_vars_data <- post_cluster_vars %>% 
  left_join(kmeans_data2, by = "AGE7") 

# Creating density plots

ggplot(alL_vars_data, aes(x = HHINCOME, group = clust4, fill = clust4)) +
    geom_density(adjust=3) + 
  labs(title = "Distribution of Income by Cluster", 
       x = "Income", 
       y = "Density",
       fill = "Cluster Assignment") + 
  facet_wrap(~clust4)

As we can see, clusters one and four are fairly similar, they both contain respondents that have higher incomes. Clusters two and three contain respondents with lower incomes, with cluster three containing a wider variation.

ggplot(alL_vars_data, aes(x = AGE7, group = clust4, fill = clust4)) +
    geom_density(adjust=3) +
  labs(title = "Distribution of Age by Cluster", 
       x = "Age Group", 
       y = "Density",
       fill = "Cluster Assignment") +
  facet_wrap(~clust4)

With the age distribution, the similar cluster pairs change. Clusters one and three seem to be closely related, with cluster three containing a slightly higher number of young respondents. On the other hand, clusters two and four contain older respondents.

ggplot(data = alL_vars_data, aes(x=ECON4A, group = clust4, fill=clust4)) +
  geom_density(adjust = 5) +
  labs(title = "Distribution of 30-day Employment Confidence by Cluster", 
       x = "30-day employment confidence", 
       y = "Density",
       fill = "Cluster Assignment") +
  facet_wrap(~clust4)

ggplot(data = alL_vars_data, aes(x=ECON4B, group = clust4, fill=clust4)) +
  geom_density(adjust = 5) +
  labs(title = "Distribution of Three-Month Employment Confidence Answers by Cluster", 
       x = "Three month employment confidence", 
       y = "Density",
       fill = "Cluster Assignment") +
  facet_wrap(~clust4)

In the density plot comparing cluster assignment and both of the employment likelihood variables, it’s clear that clusters one and three are quite similar, as are clusters two and four. Clusters two and four are less confident as whole about their future employment, whereas clusters one and three are more confident. One notable difference between clusters one and three, in the graph for 30 day employment confidence, is that cluster three is more spread out across the variable, whereas cluster one contains more confident respondents.

In the density plots comparing cluster assignment and both of the employment likelihood variables, it is clear that clusters one and three are quite similar, as are clusters two and four. Clusters two and four are less confident as whole about their future employment, whereas clusters one and three are less confident. In the graph for 30 day employment confidence, one notable difference between clusters one and three is that cluster three is more spread out across the variable, whereas cluster one contains more confident respondents.

Demographic Variables

First, we examined the proportions of categorical demographic variable responses across clusters. The following demographic variables were used in this investigation:

• Gender: Male or Female
• Racial Background: Black (non-Hispanic), Hispanic, Other (non-Hispanic), White (non-Hispanic)
• Population Density: Rural, Suburban, Urban

Shown in the plots below, the proportions of both gender and population density responses did not differ substantially across clusters. In other words, all four clusters were made up of a similar proportion of male and female respondents; approximately 40% of respondents were male and approximately 60% of respondents were female across all clusters. Additionally, all four clusters were made up of a similar proportion of respondents from rural, suburban, and urban environments; approximately 75% of respondents lived in an urban environment, approximately 20% of respondents lived in a suburban environment, and approximately 5% of respondents lived in a rural environment across all clusters. Therefore, these visualizations demonstrate that cluster assignment does not predict responses to gender and population density questions well.

ggplot(alL_vars_data, aes(x = clust4, fill = GENDER2)) +
  geom_bar(position = "fill") +
  labs(title = "Gender Proportions by Cluster Assignment", 
       x = "Cluster Assignment", 
       y = "Proportion",
       fill = "Gender") 

ggplot(alL_vars_data, aes(x = clust4, fill = P_DENSE2)) +
  geom_bar(position = "fill") +
  labs(title = "Population Density Proportions by Cluster Assignment", 
       x = "Cluster Assignment", 
       y = "Proportion",
       fill = "Population Density")

Unlike the plots above, the plot below shows how the proportions of reported racial background differed across clusters. For instance, the red, green and blue bars are similar and thicker in clusters one and three than in clusters two and four. These findings suggest that respondents from clusters one and three reported a Black-non-Hispanic background, a Hispanic background, or another non-Hispanic background at a higher rate than participants in clusters two and four. Additionally, the purple bars are similar and thicker in clusters two and four than in clusters one and three. This result implies that respondents in clusters two and four reported a White, non-Hispanic background at a higher rate than respondents in clusters one and three. As different patterns in the proportions of reported racial background emerged, this visualization demonstrates that cluster assignment can predict differences in reported racial background. It also shows that respondents from clusters one and three reported similar racial backgrounds and that respondents from clusters two and four reported similar racial backgrounds.

ggplot(alL_vars_data, aes(x = clust4, fill = RACETH2)) +
  geom_bar(position = "fill") +
  labs(title = "Racial Background Proportions by Cluster Assignment", 
       x = "Cluster Assignment", 
       y = "Proportion",
       fill = "Racial Background")

Economic Health Variables

After exploring the relationship between our categorical demographic variables and cluster assignment, we investigated the proportions of responses to individual economic health questions across clusters. We used the following economic health variables in this investigation:

• Unemployment Insurance
  • Question: In the past 7 days, have you either received, applied for, or tried to apply for any of the following forms of income or assistance, or not?
• TANF (Temporary Assistance for Needy Families)
  • Question: In the past 7 days, have you either received, applied for, or tried to apply for any of the following forms of income or assistance, or not?
• Food Security
  • Question: Please indicate whether the following statement was often true, sometimes true, or never true for you or your household over the past 30 days, “The food that we bought just didn’t last, and we didn’t have money to get more.”

The plot below shows the proportion of responses to the TANF status question across clusters.

ggplot(alL_vars_data, aes(x = clust4, fill = ECON6C_2)) +
  geom_bar(position = "fill") +
  labs(title = "Proportions of TANF Status by Cluster Assignment", 
       x = "Cluster Assignment", 
       y = "Proportion",
       fill = "TANF Status")

A majority of respondents reported that they did not apply for TANF across all four clusters. As a result, it is hard to visualize the proportions of respondents who may have applied for, tried to apply for, or received TANF in the plot above. For this reason, we also created the table below to analyze differences in proportions of responses to the TANF question. As over 97% of participants reported that they did not apply for TANF across all four clusters, cluster assignment does not predict very interesting or relevant variation in responses to the TANF status question. However, this table shows that respondents in clusters one and three reported that they tried to apply for or received TANF at a higher rate than respondents in clusters two and four.

knitr::kable(TANF_data, col.names = c("Cluster Assignmnet", 
                                      "Applied", 
                                      "Did Not Apply", 
                                      "Recieved", 
                                      "Tried to Appy")) %>% 
  kableExtra::kable_styling(position = "center", row_label_position = "c", 
                            latex_options = "hold_position")

The next visualization, presented below, demonstrates how the proportion of responses to the unemployment insurance questions change across clusters. The blue bars are larger in clusters one and three than in clusters two and four. This finding indicates that clusters one and three received unemployment insurance at a higher rate than respondents in clusters two and four. The purple bar is also largest in cluster three, indicating that respondents in cluster three tried to apply for unemployment insurance at a higher rate than respondents in the other clusters. However, as approximately 90% of respondents in each cluster did not apply for unemployment insurance, cluster assignment does not predict very interesting or relevant patterns of responses to the unemployment insurance status question.

ggplot(alL_vars_data, aes(x = clust4, fill = ECON6A_2)) +
  geom_bar(position = "fill") +
  labs(title = "Proportions of Unemployment Insurance Status by Cluster
       Assignment", 
       x = "Cluster Assignment", 
       y = "Proportion",
       fill = "Unemployment Insurance Status")

Our final visualization illustrates the relationship between cluster assignment and the proportions of reported levels of food security. As can be seen below, the blue and green bars are thicker in clusters one and three and the red bars are thicker in clusters two and four. This variance in proportion of reported food security levels suggests that respondents in clusters one and three ran out of food due to financial problems at a higher rate than participants in clusters two and four. Therefore, cluster assignment is able to predict interesting differences in the responses to the question about food security.

ggplot(alL_vars_data, aes(x = clust4, fill = ECON5A_B2)) +
  geom_bar(position = "fill") +
  labs(title = "Proportions of Food Security Levels Status by Cluster Assignment", 
       x = "Cluster Assignment", 
       y = "Proportion",
       fill = "Level of Food Security")