Introduction to Data Science

Introduction

Mon, 25 Aug 2025 00:00:00 +0000

Regression 2

Mon, 25 Aug 2025 00:00:00 +0000

Regression 3

Mon, 25 Aug 2025 00:00:00 +0000

Classfication 1

Mon, 25 Aug 2025 00:00:00 +0000

Classfication 2

Mon, 25 Aug 2025 00:00:00 +0000

Clustering

Mon, 25 Aug 2025 00:00:00 +0000

Introduction to R

Mon, 25 Aug 2025 00:00:00 +0000

Data Visualization

Mon, 25 Aug 2025 00:00:00 +0000

Data Wrangling

Mon, 25 Aug 2025 00:00:00 +0000

Multivariate 1

Mon, 25 Aug 2025 00:00:00 +0000

Multivariate 2

Mon, 25 Aug 2025 00:00:00 +0000

Uncertainty 1

Mon, 25 Aug 2025 00:00:00 +0000

Uncertainty 2

Mon, 25 Aug 2025 00:00:00 +0000

Regression 1

Mon, 25 Aug 2025 00:00:00 +0000

Binary Predictors and Multiple Regression

Mon, 01 Jan 0001 00:00:00 +0000

Introduction

In this section we’re going to continue fitting regressions to the training data and testing the predictions against the testing data. We’ll include additional continuous variables. We’re also going to add some new elements. In particular, We’ll be using independent variables or predictor variables that are binary or categorical.

We’ll need the same libraries as last week:

library(tidyverse)
library(plotly)
library(scales)

And the same dataset, which includes data on movies released since 1980.

mv<-readRDS(url("https://github.com/rweldzius/PSC4175/raw/main/static/data/mv.Rds")) %>%
  filter(!is.na(budget))%>%
  mutate(log_gross=log(gross),
         log_budget = log(budget))%>%
  mutate(bechdel_bin=ifelse(bechdel_score==3,1,0))%>%
  mutate(bechdel_factor=recode_factor(bechdel_bin,
                                      `1`="Pass",
                                      `0`="Fail",
                                      ))

A Brief Digression: The Bechdel Test

The Bechdel test was first made famous by Alison Bechdel in 1985– Bechdel credited the idea to Liz Wallace and her reading of Virginia Woolf. It asks three questions about a movie:

Does it have two women in it?
Who talk to each other?
About something other than a man?

The test sets an unbelievably low bar, and yet a remarkable number of movies don’t pass it. One excuse sometimes used by filmmakers is that movie audiences tend to be young and male, and so favor movies that don’t necessarily pass this test. However, a study by CAA and shift7 called this logic into question:

A study indicates that female-led movies make more money thatn those that are not.

And here’s the study.

Let’s see if we can replicate their results in this data. First of all, what proportion of these movies made since 2000 pass the Bechdel test?

mv%>%
  group_by(bechdel_bin)%>%
  count()

## # A tibble: 3 × 2
## # Groups:   bechdel_bin [3]
##   bechdel_bin     n
##         <dbl> <int>
## 1           0   873
## 2           1  1186
## 3          NA  1132

A majority, but 873 (873!!) movies did not have two female characters that spoke to each other about anything other than a man.

Let’s see if the contention of movie execs about earning power holds up.

mv%>%
  mutate(budget_level=ntile(budget,n=5))%>%
  group_by(budget_level,bechdel_factor)%>%
  summarize(mean_gross=mean(gross,na.rm=TRUE))%>%
  drop_na()%>%
  ggplot(aes(x=budget_level,y=mean_gross,fill=bechdel_factor))+
  geom_col(position="dodge")+
  scale_y_continuous(labels=dollar_format())+
  ylab("Gross Earnings")+xlab("Size of Movie Budget")+
  scale_fill_discrete(name="Passed Bechdel Test")+
  theme_minimal()+
  theme(legend.position = "bottom")

Nope. At every budget level, movies that pass the Bechdel test make more money, not less.

Regression with a binary variable

Let’s see if we can use regression to obtain a similar result. The next variable I want to include is the Bechdel variable, which is a binary variable set to “1” if the movie passes the Bechdel test.

mv%>%
  group_by(bechdel_bin)%>%
  summarize(count=n())%>%
  mutate(`Proportion`=count/sum(count))%>%
  arrange(-Proportion)

## # A tibble: 3 × 3
##   bechdel_bin count Proportion
##         <dbl> <int>      <dbl>
## 1           1  1186      0.372
## 2          NA  1132      0.355
## 3           0   873      0.274

Regression

Next, I add the variable bechdel_factor to the formula. Recall from the previous lecture that we ended with a multiple regression model in which we predicted gross by the budget and the IMDB score.

mBech <- lm(log_gross ~ log_budget + score + bechdel_factor,mv)
summary(mBech)

## 
## Call:
## lm(formula = log_gross ~ log_budget + score + bechdel_factor, 
##     data = mv)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -8.6909 -0.4825  0.1423  0.6341  8.0510 
## 
## Coefficients:
##                    Estimate Std. Error t value Pr(>|t|)    
## (Intercept)         0.47383    0.39162   1.210    0.226    
## log_budget          0.92779    0.01955  47.464  < 2e-16 ***
## score               0.26226    0.02827   9.278  < 2e-16 ***
## bechdel_factorFail -0.21934    0.05160  -4.251 2.23e-05 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.143 on 2054 degrees of freedom
##   (1133 observations deleted due to missingness)
## Multiple R-squared:  0.5303,	Adjusted R-squared:  0.5296 
## F-statistic: 772.9 on 3 and 2054 DF,  p-value: < 2.2e-16

The variable bechdel_factor is now added to our formula. Note that, because it is a binary categorical variable, we only have one value for it. This is because the regression is comparing a movie that fails the Bechdel test to one that passes it. Thus we can think of the coefficient -0.219 as the difference between a movie that passes and fails the test – i.e., movies that fail the test gross less than those that pass it. Note that this relationship holds even AFTER controlling for budget and IMDB score.

Calculating model fit with RMSE

Recall how to calculate the root mean square error (RMSE). We: 1. Estimate our model 2. Calculate predicted outcomes 3. Calculate errors (predicted - true values) 4. Square the errors 5. Take the average of the squared errors 6. Take the square root of this average

e <- resid(mBech)
se <- e^2
mse <- mean(se)
rmse <- sqrt(mse)
rmse

## [1] 1.141396

But we don’t want to calculate this on the full data. Instead, we rely on cross validation to get a more accurate measure of our model’s fit. Also! Remember that we are interested in comparing how good our model performs with different combinations of predictors. Does the Bechdel data actually help us?

set.seed(123)
mvAnalysis <- mv %>%
  select(bechdel_factor,score,log_budget,log_gross) %>%
  drop_na()

cvRes <- NULL

for(i in 1:100) {
  inds <- sample(1:nrow(mvAnalysis),size = round(nrow(mvAnalysis)*.75),replace = F) # Set training to 75% of the data
  train <- mvAnalysis %>% slice(inds)
  test <- mvAnalysis %>% slice(-inds)
  
  # Three models of increasing complexity
  m1 <- lm(log_gross ~ log_budget,train)
  m2 <- lm(log_gross ~ log_budget + score,train)
  m3 <- lm(log_gross ~ log_budget + score + bechdel_factor,train)
  
  # Calculate RMSE for each
  cvRes <- test %>%
    mutate(pred1 = predict(m1,newdata = test),
           pred2 = predict(m2,newdata = test),
           pred3 = predict(m3,newdata = test)) %>%
    summarise(rmse1 = sqrt(mean((log_gross - pred1)^2,na.rm=T)),
              rmse2 = sqrt(mean((log_gross - pred2)^2,na.rm=T)),
              rmse3 = sqrt(mean((log_gross - pred3)^2,na.rm=T))) %>%
    mutate(cvIndex = i) %>%
    bind_rows(cvRes)
  
}

cvRes %>%
  select(-cvIndex) %>%
  summarise_all(mean) %>%
  gather(model,rmse) %>%
  ggplot(aes(x = rmse,y = reorder(model,rmse))) + 
  geom_bar(stat = 'identity')

cvRes %>%
  select(-cvIndex) %>%
  gather(model,rmse) %>%
  ggplot(aes(x = rmse,fill = model)) + 
  geom_density(alpha = .3)

cvRes %>%
  summarise(diff12 = round(mean(rmse1 > rmse2),3),
            diff13 = round(mean(rmse1 > rmse3),3),
            diff23 = round(mean(rmse2 > rmse3),3)) %>%
  as.data.frame()

##   diff12 diff13 diff23
## 1      1      1   0.87

So we improve the model fit by adding the Bechdel test scores. We are 99.9% certain that model 2 is an improvement over model 1, 99.9% sure that model 3 is an improvement over model 1, and 87% sure that model 3 is an improvement over model 2.

Regression with a categorical variable

We can also include categorical variables (not just binary variables) in our model using much the same process. Let’s see if a movie’s MPAA Rating is related to its gross.

What numbers of movies have different ratings?

mv%>%
  group_by(rating)%>%
  count()

## # A tibble: 9 × 2
## # Groups:   rating [9]
##   rating        n
##   <chr>     <int>
## 1 G            54
## 2 NC-17         6
## 3 Not Rated    37
## 4 PG          434
## 5 PG-13      1249
## 6 R          1392
## 7 TV-MA         2
## 8 Unrated       7
## 9 <NA>         10

Regressing + Model Test

Let’s analyze!

summary(m2 <- lm(log_gross ~ log_budget + score + rating,mv))

## 
## Call:
## lm(formula = log_gross ~ log_budget + score + rating, data = mv)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -7.1259 -0.5786  0.1573  0.7163  8.0714 
## 
## Coefficients:
##                 Estimate Std. Error t value Pr(>|t|)    
## (Intercept)      1.62557    0.39228   4.144 3.50e-05 ***
## log_budget       0.85421    0.01842  46.373  < 2e-16 ***
## score            0.33985    0.02256  15.064  < 2e-16 ***
## ratingNC-17     -1.18817    0.51972  -2.286  0.02231 *  
## ratingNot Rated -2.33824    0.26865  -8.704  < 2e-16 ***
## ratingPG        -0.24143    0.17397  -1.388  0.16530    
## ratingPG-13     -0.43612    0.16768  -2.601  0.00934 ** 
## ratingR         -0.93461    0.16874  -5.539 3.30e-08 ***
## ratingTV-MA     -2.26996    0.86839  -2.614  0.00899 ** 
## ratingUnrated   -2.36506    0.48738  -4.853 1.28e-06 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.205 on 3164 degrees of freedom
##   (17 observations deleted due to missingness)
## Multiple R-squared:  0.5352,	Adjusted R-squared:  0.5339 
## F-statistic: 404.8 on 9 and 3164 DF,  p-value: < 2.2e-16

How to interpret this output? Again, we want to be aware of which category is not being included, which is the reference to the rest of the rating categories. As you can see, this is the “G” movie rating (i.e., general audiences). As we can see, G-rated movies earn more than EVERY OTHER TYPE OF MOVIE.

Note that we might want to drop certain rarely occurring categories. For example, we know from above that there are only 6 NC-17 movies, 2 TV-MA movies, and 7 Unrated movies. Furthermore, we can change the reference category to something different with the factor() command. Let’s do this now:

mvAnalysis <- mv %>%
  select(log_gross,log_budget,score,rating) %>%
  filter(!rating %in% c('NC-17','TV-MA','Unrated')) %>%
  drop_na() %>%
  mutate(rating = factor(rating,levels = c('R','PC-13','PG','G','Not Rated')))

summary(m3 <- lm(log_gross ~ log_budget + score + rating,mvAnalysis))

## 
## Call:
## lm(formula = log_gross ~ log_budget + score + rating, data = mvAnalysis)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -6.8665 -0.6266  0.1777  0.7816  7.9003 
## 
## Coefficients:
##                 Estimate Std. Error t value Pr(>|t|)    
## (Intercept)      0.99416    0.46538   2.136   0.0328 *  
## log_budget       0.82891    0.02495  33.220  < 2e-16 ***
## score            0.35852    0.03220  11.136  < 2e-16 ***
## ratingPG         0.72476    0.07763   9.336  < 2e-16 ***
## ratingG          0.96838    0.18522   5.228  1.9e-07 ***
## ratingNot Rated -1.44571    0.23159  -6.242  5.3e-10 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.317 on 1904 degrees of freedom
##   (1249 observations deleted due to missingness)
## Multiple R-squared:  0.5032,	Adjusted R-squared:  0.5018 
## F-statistic: 385.6 on 5 and 1904 DF,  p-value: < 2.2e-16

As we can see, every type of movie earns more than rated-R movies with the exception of Not Rated movies, which earn less.

Let’s evaluate RMSE again via cross validation.

cvRes2 <- NULL

for(i in 1:100) {
  inds <- sample(1:nrow(mvAnalysis),size = round(nrow(mvAnalysis)*.75),replace = F) # Set training to 75% of the data
  train <- mvAnalysis %>% slice(inds)
  test <- mvAnalysis %>% slice(-inds)
  
  # Three models of increasing complexity
  m1 <- lm(log_gross ~ log_budget,train)
  m2 <- lm(log_gross ~ log_budget + score,train)
  m3 <- lm(log_gross ~ log_budget + score + rating,train)
  
  # Calculate RMSE for each
  cvRes2 <- test %>%
    mutate(pred1 = predict(m1,newdata = test),
           pred2 = predict(m2,newdata = test),
           pred3 = predict(m3,newdata = test)) %>%
    summarise(rmse1 = sqrt(mean((log_gross - pred1)^2,na.rm=T)),
              rmse2 = sqrt(mean((log_gross - pred2)^2,na.rm=T)),
              rmse3 = sqrt(mean((log_gross - pred3)^2,na.rm=T))) %>%
    mutate(cvIndex = i) %>%
    bind_rows(cvRes2)
  
}

cvRes2 %>%
  select(-cvIndex) %>%
  summarise_all(mean) %>%
  gather(model,rmse) %>%
  ggplot(aes(x = rmse,y = reorder(model,rmse))) + 
  geom_bar(stat = 'identity')

cvRes2 %>%
  select(-cvIndex) %>%
  gather(model,rmse) %>%
  ggplot(aes(x = rmse,fill = model)) + 
  geom_density(alpha = .3)

cvRes2 %>%
  summarise(diff12 = mean(rmse1 > rmse2),
            diff13 = mean(rmse1 > rmse3),
            diff23 = mean(rmse2 > rmse3))

## # A tibble: 1 × 3
##   diff12 diff13 diff23
##    <dbl>  <dbl>  <dbl>
## 1      1   0.07   0.01

We are now finding that adding the rating reduces the fit of our model, as evidence by a higher RMSE! Why might this be the case?

Last Note

Remember that we need to carefully distinguish between categorical variables and continuous variables when including them in our models. If we’re using categorical variables we’ll need to pre-process the data in order to let the model know that these variables should be included as categorical variables, with an excluded reference category.

Research Exercise 1: Write a short plan for your final project. First, be sure to state what you are testing, what’s your data, and what do you hope to do/show with this data? Next, provide a timeline for completing these tasks using the rubric below. That’s it!

Week 11 (Nov. 10):
Week 12 (Nov. 17):
Week 13 (Nov. 24; includes Thanksgiving):
Week 14 (Dec. 1):
Week 15 (Dec. 8; presentations will begin):

Clustering Part 1

Mon, 01 Jan 0001 00:00:00 +0000

NB: You will have to Knit this as a HTML file since Plotly does not work when knitted as a PDF. After you knit your HTML, open the file and then print as a PDF. Now onto the homework!

The last few times we have been talking about using a regression to characterize a relationship between variables. As we saw, by making a few assumptions, we can use either linear or logistic regression to summarize not only how variables are related to one another, but also how to use that relationship to predict out-of-sample (or future) observations.

We are now going to introduce a different algorithm - the kmeans algorithm. This specific algorithm is part of a larger class of algorithms/models that have been designed to identify relationships within the data. This is sometimes called “clustering” or “segmentation”. The goal is to figure out clusters/segments of data that are “similar” based on observable features.

The goal is to therefore try to figure out an underlying structure in our data. That is, we want to use the data to learn about which observations are more or less similar. Because I do not know what the true relationship is, what we are doing is sometimes called “Unsupervised” learning. In contrast, “supervised” learning is when we are actively bringing information in and “supervising” the characterization being done. We will see an example of this in a few lectures, but for now we are going to start with an unsupervised approach.

Efforts to characterize the relationship within data to determine which observations cluster together (or are segmented) is often an important first step for determining the empirical regularity of interest.

This is what dating sites (e.g., e-harmony) do when they try to figure out which individuals are more or less similar. This is what Facebook and Tik-Tok does when it tries to determine what to show you in your feed. This is what Netflix does when recommending your next series to watch. Personality tests and profiles are another example of this. These tools are also used in marketing to identify likely consumers and by political campaigns to figure out which voters should be targeted and perhaps even how. What they actually do is obviously more complicated, but the basic idea is very, very similar to what we are going to learn today.

Measurement is Sometimes Discovery

One thing that will become quickly apparent is that how we measure something can have profound implications on what it means - especially if we have no theory to guide us in the organization/analysis of data. Sometimes data exploration = measurement = discovery.

It is also important to note that nothing we are doing is causal – the algorithm is silent as to why the relationships exist. It is equally important to note that the analysis is descriptive, not predictive. This is a critical point with profound implications – if you identify segments in your data and they take proactive steps using that information, the steps you take may affect how future data is clustered.

Clustering algorithm: discover groups of observations ``similar” to each other.
Unsupervised learning vs. Supervised learning.
Descriptive and exploratory data analysis.

The algorithm we are going to use is one of the earliest implementations of clustering and it is very simple in what it does. There are many more complicated procedures and models, but for the purposes of illustrating the general idea (and also the generic limitations of this kind of “unsupervised learning”) it is easiest to start with what is perhaps one of the simplest clustering methods.

The procedure used by the k-means clustering algorithm consists of several steps”

The data scientist chooses the number of clusters/segments they wish to identify in the data of interest. The number of clusters is given by K – hence the name kmeans.
The computer randomly chooses initial centroids of K clusters in the multidimensional space (where the number of dimensions is the number of variables).
Given the choice of K centroids, the computer assigns each observation to the cluster whose centroid is the closest (in terms of Euclidian distance).
Given that assignment, the computer computes a new centroid for each cluster using the within-cluster mean of the corresponding variable.
Repeat Steps 3 and 4 until the cluster assignments no longer change.

So, if there are two variables, say $X$ and $Y$ and we are fitting 2 centroids, the computer will begin by randomly choosing a “centroid” for each cluster – which is simply a point in $(x,y)$. Say $(x_1,y_1)$ for cluster 1 and $(x_2,y_2)$ for cluster 2. Then given this choice, the computer figures out which centroid is “closest” to each data point. So for data point $i$ that is located at $(x_i,y_i$) the computer computes the distance from each.

Given this, the Euclidean distance to cluster 1 is simply: \[ (x_1 -x_i)^2 + (y_1 - y_i)^2 \] And the Euclidean distance to cluster 2: \[ (x_2 -x_i)^2 + (y_2 - y_i)^2 \] (Note that if we have more variables we just include them in a similar fashion.) Having calculcated the distance to each of the $K$ centroids – here 2 – we now assign each datapoint to either cluster “1” or “2” depending on which is smaller. After doing this for every data point, we then calculate a new centroid by taking the average of all of the points in each cluster in each variable. So if there are $n_1$ observations allocated to cluster 1 and $n_2$ observations allocated to cluster 2 we would compute the new centroids using:

\[x_1 = \sum_i^{n_1} \frac{x_i}{n_1}\] \[y_1 = \sum_i^{n_1} \frac{y_i}{n_1}\] \[x_2 = \sum_i^{n_2} \frac{x_i}{n_2}\] \[y_2 = \sum_i^{n_2} \frac{y_i}{n_2}\]

Now, using these new values for $(x_1,y_1)$ for the centroid of cluster 1 and $(x_2,y_2)$ for the centroid of cluster 2 we reclassify all the observations to allocate each observation to the cluster with the closest centroid. We then recalculate the centroid for each cluster after this reallocation and then we iterate over these two steps until no data points change their cluster assignment.

Given this, how sensitive is this to the scale of the variables? What does that imply?

Applications to Elections and Election Night

Predicting elections requires using votes that are counted to make predictions for “similar counties.” There are lots of ways to determine similarity based on past voting behavior (and demographics).

Entire books have been written that try to determine how many “Americas” there are. For example…

And many “quizzes” are produced to determine what type of voter you are (more on this later!). For example: quiz from the NY Times.

These are all products that are based on various types of clustering analyses that try to detect pattern in data.

So let’s start simple and think about the task of predicting what is going to happen in a state on Election Night. To do so we want to segment the state into different politically relevant regions so that we can track how well candidates are doing. Or, if you are working for a candidate, which counties should be targeted in get-out-the-vote efforts.

We are going to be working with two datasets. A dataset of votes cast in Florida counties in the 2016 election (FloridaCountyData.Rds) and also a dataset of the percentage of votes cast for Democratic and Republican presidential candidates in counties (or towns) for the 2004, 2008, 2012, 2016, and 2020 elections (CountyVote2004_2020.Rds).

To begin, let’s start with Florida in 2016.

library(tidyverse)
library(tidymodels)
library(plotly)

dat <- read_rds(file="https://github.com/rweldzius/PSC4175/raw/main/static/data/FloridaCountyData.Rds")
glimpse(dat)

## Rows: 67
## Columns: 15
## $ fips_code          <int> 12001, 12003, 12005, 12007, 12009, 12011, 12013, 12…
## $ county_name        <chr> "Alachua", "Baker", "Bay", "Bradford", "Brevard", "…
## $ eligible_voters    <int> 173993, 15092, 118344, 16163, 411191, 1141360, 8620…
## $ party_stratum      <int> 2, 5, 5, 5, 4, 1, 5, 5, 5, 5, 5, 5, 1, 5, 5, 3, 4, …
## $ party_stratum_name <chr> "Mod Democrat", "High Republican", "High Republican…
## $ geo_stratum_name   <chr> "North/Panhandle", "North/Panhandle", "North/Panhan…
## $ Trump              <int> 46834, 10294, 62194, 8913, 181848, 260951, 4655, 60…
## $ Clinton            <int> 75820, 2112, 21797, 2924, 119679, 553320, 1241, 334…
## $ Johnson            <int> 4059, 169, 2652, 177, 9451, 11078, 124, 1946, 1724,…
## $ Stein              <int> 1507, 30, 562, 47, 2708, 5094, 25, 567, 480, 571, 7…
## $ geo_strata         <fct> North/Panhandle, North/Panhandle, North/Panhandle, …
## $ Total2012          <int> 128569, 12634, 87449, 12098, 314744, 831950, 6081, …
## $ Total2016          <int> 128220, 12605, 87205, 12061, 313686, 830443, 6045, …
## $ PctTrump           <dbl> 0.3652628, 0.8166601, 0.7131931, 0.7389934, 0.57971…
## $ PctClinton         <dbl> 0.5913274, 0.1675526, 0.2499513, 0.2424343, 0.38152…

The first task that we face as data scientists is to determine which variables are relevant for clustering. Put differently, which variables define the groups we are trying to find. kmeans is a very simple algorithm and it assumes that every included variable is equally important for the clustering that is recovered. As a result, if you include only garbage/irrelevant data the relationships you find will also be garbage. The alogorithm is unsupervised in that it has no idea which variables are more or less valuable to what you are trying to find. It is simply trying to find how the data clusters together given the data you have given it! It cannot evaluate the quality of the data you provide.

As a result, when doing kmeans we often start with simple visualization around data that we think is likely to be of interest. To make it interactive we can again use plotly package and include some text information in the ggplot aesthetic. We will also clean up the labels and override the default of scientific notation. We will also change the name of the legend to make it descriptive and interpretable.

gg<- dat %>%
    ggplot(aes(x = Trump, y = Clinton, color = geo_strata,
               text=paste(county_name))) +
  geom_point(alpha = 0.3) +
  scale_x_continuous(labels=comma) +
  scale_y_continuous(labels=comma) +
  labs(x="Number of Trump Votes",
       y="Number of Clinton Votes",
       title="Florida County Votes in 2016",
       color = "Region")
  
ggplotly(gg,tooltip = "text")

So this suggests that counties with more Clinton votes tend to covary with counties with more Trump voters. Obviously. So we have discovered that there are more votes for both candidates in larger counties. So if we were to cluster based on this we would essentially find groups based on population size. Not useful.

So maybe we should look at the percentage of votes rather than the number of votes. Let’s see. Again let’s improve the labels and axes and make it interactive using plotly to show how the code differs from the default syntax above.

gg <- dat %>% 
  ggplot(aes(PctTrump, PctClinton, color = geo_strata,
               text=paste(county_name))) +
  geom_point(alpha = 0.3) +
  scale_y_continuous(limits = c(0,1),labels = scales::percent_format(accuracy = 1)) + 
  scale_x_continuous(limits = c(0,1),labels = scales::percent_format(accuracy = 1)) + 
  labs(x="Pct of Trump Votes",
       y="Pct of Clinton Votes",
       title="Florida County Vote Share in 2016",
       color = "Region")

ggplotly(gg,tooltip = "text")

So now we see that places with a higher percentage of support for Clinton have a lower support for Trump. That seems useful if we are interested in characterizing the political context of a county.

But those are highly correlated? Do we need both percentage that support Clinton and also the percentage that support Trump? It seems like that is the same information being “double-counted.” What if we include something like the number of eligible voters?

gg <- dat %>% 
  ggplot(aes(PctTrump, eligible_voters, color = geo_strata,
               text=paste(county_name))) +
  geom_point(alpha = 0.3) +
  scale_y_continuous(label=comma, breaks=seq(0,2000000,by=125000)) + 
  scale_x_continuous(limits = c(0,1),labels = scales::percent_format(accuracy = 1)) + 
  labs(x="Pct of Trump Votes",
       y="Number of Eligible Voters",
       main="Florida County Election Results in 2016",
       color = "Region")

ggplotly(gg,tooltip = "text")

## Ignoring unknown labels:
## • main : "Florida County Election Results in 2016"

Now things get trickier. Do we want to segment based on the number of eligible voters? Or is it more useful to focus on support for Clinton and Trump? This decision is hugely consequential for the groups kmeans will recover. This again highlights the role of the data scientist – you need to make a decision and justify it because the decision will be consequential!

To start let’s characterize counties by support for Clinton and Trump.

rawvote <- dat %>%
  select(c(PctTrump,PctClinton)) %>%
  drop_na()

Now we run by providing the data frame of all numeric data and the number of clusters – here centers that we want the algorithm to find for us.

fl.cluster1 <- kmeans(rawvote, centers=2)

Now call the object to see what we have just created and all of the objects that we can now work with.

fl.cluster1

## K-means clustering with 2 clusters of sizes 46, 21
## 
## Cluster means:
##    PctTrump PctClinton
## 1 0.6967974  0.2778255
## 2 0.4576118  0.5139091
## 
## Clustering vector:
##  [1] 2 1 1 1 1 2 1 1 1 1 1 1 2 1 1 2 1 1 1 2 1 1 1 1 1 2 1 1 2 1 1 1 2 1 1 1 2 1
## [39] 1 2 2 1 1 2 1 1 1 2 2 2 1 2 2 1 1 2 1 2 2 1 1 1 1 2 1 1 1
## 
## Within cluster sum of squares by cluster:
## [1] 0.5035231 0.3448239
##  (between_SS / total_SS =  65.7 %)
## 
## Available components:
## 
## [1] "cluster"      "centers"      "totss"        "withinss"     "tot.withinss"
## [6] "betweenss"    "size"         "iter"         "ifault"

Alternatively, we can also call the tidy function to produce a tibble of the overall fit:

clusters <- tidy(fl.cluster1)
clusters

## # A tibble: 2 × 5
##   PctTrump PctClinton  size withinss cluster
##      <dbl>      <dbl> <int>    <dbl> <fct>  
## 1    0.697      0.278    46    0.504 1      
## 2    0.458      0.514    21    0.345 2

In this object you can see the mean value for each variable in each cluster – i.e., the centroid – as well as the number of observations (here counties) belonging to each cluster, and also the within sum of squares for each cluster. Recall that the centroid for each cluster is simply the average value of the variable for all counties that are assigned to that cluster. (This is the same as the $x_1$, $y_1$, $x_2$, and $y_2$ defined above.)

The values associated with withinss are the within sum of squares for all observations in a cluster. This is the sum of the squared distances between each data point in the cluster and the centorid of that cluster. So if $T_i$ denotes the value of PctTrump for county $i$ and $C_i$ denotes the value of PctClinton for county $i$ the within sum of squares for the $n_1$ counties that belong to cluster $1$ is given by:

\[\sum_i^{n_1} (\bar{T}_1 - T_i)^2 + (\bar{C}_1 - C_i)^2\]

if we use $\bar{T}_1$ to denote the mean of support for Trump in the $n_1$ counties allocated to cluster 1 and $\bar{C}_1$ to denote the mean support for Clinton in those $n_1$ counties. We will return to this later.

One important thing to note is that kmeans starts the algorithm by randomly choosing a centroid for each cluster and then iterating until no classifications change cluster. As a result, the clusters we identify can depend on the initial choices and there is nothing to ensure that this results in an “optimal” in a global sense. The classification is conditional on the initial start and the optimization is “local” and relative to that initial choice. So make sure you always set a seed!

Quick Exercise 1 Do a new clustering with 4 centroids called florida.me and look at the contests of each cluster using tidy:

# INSERT CODE HERE

Because kmeans is choosing random start values to start the classification the start values will matter, especially when you are fitting a lot of clusters to a high dimensional dataset (i.e., lots of variables). Even when you are fitting a model with few clusters and few variables the start values may impact the clustering that is found.

To illustrate this lets analyze the same data using the same number of clusters using a different seed value.

set.seed(13469) # set new seed value
fl.cluster2 <- kmeans(rawvote,centers=2) # new clustering

Now lets compare how the clusters found in fl.cluster1 compare to the clusters found in the new clustering (fl.cluster2) using thetable function.

table(fl.cluster1$cluster,fl.cluster2$cluster) # compare clusters

##    
##      1  2
##   1  4 42
##   2 21  0

So we can see the classification is exactly flipped. The observations are still largely clustered into the same clustering, but the labels of those clusters is changed. Even though the same information is recovered in both clusterings, the labels of the clusters has changed. This point is essential for replication!

Typically the information we are most interested in is how the observations are clustered – i.e., the labels contained in the cluster variable. So how do we get this information back to our original tibble? Thankfully there is a function for that. The augment function will add the cluster variable from the kmeans clustering onto a tibble containing the data used in the clustering.

dat.cluster <- augment(fl.cluster1,dat)

With this new augmented tibble – dat.cluster – we can now visualize how well the recovered clusters correspond with the underlying data. While this can be more challenging when we are working with high-dimensional data (i.e.., lots of variables) in this case we can visualize the relationship because we have used only two variables in the clustering to characterize the political leanings of counties in Florida.

If I want to plot the points using the cluster label, I can use the geom_text code to include the label passed to the ggplot aesthetic.

dat.cluster %>%
  ggplot(aes(x = PctTrump, y = PctClinton, label = .cluster)) +
  geom_text() + 
  scale_y_continuous(limits = c(0,1),labels = scales::percent_format(accuracy = 1)) + 
  scale_x_continuous(limits = c(0,1),labels = scales::percent_format(accuracy = 1)) + 
  labs(title = "Florida Counties: 2016",
       x = "% Trump in 2016",
       y = "% Clinton in 2016")

But maybe that is too messy. The overlapping numbers is a bit distracting.

So let’s switch to colored points and add in the location of the centroids. This is useful for reminding us of what kmeans is actually doing. Let us pull this information from the clusters object we created using the tidy() function applied to our kmeans object. Recall that the location of the centroid is just the average of every variable being analyzed. NOTE: what happens if we replace color with fill?

gg <- ggplot() +
  geom_point(data=dat.cluster, aes(x = PctTrump, y = PctClinton, color = .cluster,
                                   text=paste(county_name))) + 
  geom_point(data=clusters, aes(x = PctTrump, y = PctClinton), size = 10, shape = "+") + 
  labs(color = "Cluster",
    title = "Florida Counties: 2016",
       x = "% Trump in 2016",
       y = "% Clinton in 2016") +
  scale_y_continuous(limits = c(0,1),labels = scales::percent_format(accuracy = 1)) + 
  scale_x_continuous(limits = c(0,1),labels = scales::percent_format(accuracy = 1))

## Warning in geom_point(data = dat.cluster, aes(x = PctTrump, y = PctClinton, :
## Ignoring unknown aesthetics: text

ggplotly(gg,tooltip = "text")

Recall that there is no global minimization being done in this algorithm – all we are doing is starting with a randomly chosen centroid and then doing a (local) minimization given those start values. As a result, you can get different classifications with different start values. Here is a simple example that again shows the sensitivity to start values.

set.seed(42)
fl.cluster1 <- kmeans(rawvote,centers=2)

set.seed(13469)
fl.cluster2 <- kmeans(rawvote,centers=2)

table(fl.cluster1$cluster,fl.cluster2$cluster)

##    
##      1  2
##   1 21  0
##   2  4 42

But we can use nstart to try multiple initial configurations and use the one that produces the best total within sum of squares given the number of centers being chosen. Given that we are only classifying based on two variables let’s try 25 different start values.

set.seed(42)
fl.cluster1 <- kmeans(rawvote,centers=2,nstart=25)

set.seed(13469)
fl.cluster2 <- kmeans(rawvote,centers=2,nstart=25)

table(fl.cluster1$cluster,fl.cluster2$cluster)

##    
##      1  2
##   1  0 21
##   2 46  0

So now you can see that using multiple start values eliminates the classification differences based on the initial start value! Now the clusters have the same counties in each – although with different names. What nstart is doing is having the algorithm try a bunch of different start values and then choose the centroid that has the lowest within sum of squares as the starting value. So while this is not doing a search over every possible start value, it chooses the “best” start value among the set of values it generates.

Now think about doing a kmeans for three clusters. Based on the figure we just created, where do you think the three clusters will be located.

Quick Exercise 2 Now implement this! What do you observe? Were you correct?

# INSERT CODE HERE

The variables you use matter!

So what if we did cluster based on the number of votes cast? How would that affect the conclusions we get? Instead of clustering based on PctTrump and PctClinton do the clustering using Trump and Clinton. Can you predict what will happen before you do it?

rawvote <- dat %>%
  select(c(Trump,Clinton)) %>%
  drop_na()

fl.cluster1.count <- kmeans(rawvote, centers=2)

dat.cluster2 <- augment(fl.cluster1.count,dat)
clusters <- tidy(fl.cluster1.count)

clusters

## # A tibble: 2 × 5
##     Trump Clinton  size      withinss cluster
##     <dbl>   <dbl> <int>         <dbl> <fct>  
## 1 254330. 375619.     7 161451108936. 1      
## 2  47293.  31261.    60 226694181010. 2

Now graph the new clusters, labeling the county names.

gg <- ggplot() +
  geom_point(data=dat.cluster2, aes(x = Trump, y = Clinton, color = .cluster,
                                   text=paste(county_name))) + 
  geom_point(data=clusters, aes(x = Trump, y= Clinton), size = 10, shape = "+") + 
  labs(color = "Cluster",
       title = "Florida Counties",
       x = "Votes for Trump",
       y = "Votes for Clinton") +
  scale_y_continuous(label=comma) + 
  scale_x_continuous(label=comma)

## Warning in geom_point(data = dat.cluster2, aes(x = Trump, y = Clinton, color =
## .cluster, : Ignoring unknown aesthetics: text

ggplotly(gg,tooltip = "text")

And finally, how do the clusters compare to one another? If you do a table of the clusters against one another what do you observe?

table(ByPct = fl.cluster1$cluster,
      ByVote= fl.cluster1.count$cluster)

##      ByVote
## ByPct  1  2
##     1  7 14
##     2  0 46

The scale matters. What if we do a clustering using eligible voters, PctTrump and PctClinton. What do you observe for a clustering of these variables using k=2 clusters?

rawvote3 <- dat %>%
  select(c(eligible_voters,PctClinton,PctTrump))

cluster.mix <- kmeans(rawvote3,centers=2,nstart=25)
tidy(cluster.mix)

## # A tibble: 2 × 6
##   eligible_voters PctClinton PctTrump  size      withinss cluster
##             <dbl>      <dbl>    <dbl> <int>         <dbl> <fct>  
## 1         110305.      0.327    0.647    60 842735627916. 1      
## 2         893950       0.564    0.407     7 483680203618. 2

Now rescale the data being fit using the scale function to normalize the data to have mean 0 and variance 1. (Note that scale just normalizes a data.frame object.) Why is this important given the alogorithm being used? Now cluster the rescaled data. How do the resulting clusters compare to the unrescaled clusters and also our original scaling based on the percentages – fl.cluster1?

rawvote3.scale <- scale(rawvote3)
summary(rawvote3.scale)

##  eligible_voters      PctClinton          PctTrump       
##  Min.   :-0.67089   Min.   :-1.84762   Min.   :-2.29670  
##  1st Qu.:-0.62953   1st Qu.:-0.77653   1st Qu.:-0.50178  
##  Median :-0.35021   Median :-0.02995   Median : 0.06301  
##  Mean   : 0.00000   Mean   : 0.00000   Mean   : 0.00000  
##  3rd Qu.: 0.09304   3rd Qu.: 0.48713   3rd Qu.: 0.67141  
##  Max.   : 4.26751   Max.   : 2.42012   Max.   : 1.88340

cluster.mix2 <- kmeans(rawvote3.scale,centers=2,nstart=25)
tidy(cluster.mix2)

## # A tibble: 2 × 6
##   eligible_voters PctClinton PctTrump  size withinss cluster
##             <dbl>      <dbl>    <dbl> <int>    <dbl> <fct>  
## 1           0.984      1.21    -1.22     20     52.7 1      
## 2          -0.419     -0.515    0.518    47     33.7 2

How to compare? Start with the normalized vs. unnormalized clustering (i.e., same variables but different scale).

table(Normalized = cluster.mix2$cluster, 
      Unnormalized = cluster.mix$cluster)

##           Unnormalized
## Normalized  1  2
##          1 13  7
##          2 47  0

Now compare to the original clustering we did using vote share (i.e., different variables and different scale).

table(Normalized = cluster.mix2$cluster, 
      ByPct = fl.cluster1$cluster)

##           ByPct
## Normalized  1  2
##          1 18  2
##          2  3 44

This means…

More Data! More Clusters?

Perhaps we need more data. Lets get all of the county (or town) level data from 2004 up through 2020. Let’s focus on Florida again.

dat.all <- read_rds(file="https://github.com/rweldzius/PSC4175/raw/main/static/data/CountyVote2004_2020.Rds")

dat.fl <- dat.all %>%
  filter(state=="FL")

For now, let us work with pct_rep_2016 and pct_rep_2020 – but try replicating the results using a different choice to see what happens. Note that kmeans takes a data frame with all numeric columns so let’s start by creating a new tibble with just numeric data and no missingness.

rawvote <- dat.fl %>%
  select(c(pct_rep_2004,pct_rep_2008,pct_rep_2012,pct_rep_2016,pct_rep_2020)) %>%
  drop_na()

Again we can start by visualizing the relationship. Since we can only think in 2 dimensions, let’s look at some.

rawvote %>%
  ggplot(aes(x=pct_rep_2016, y=pct_rep_2020)) +
  geom_point() +
  labs(x="% Trump 2016", 
       y = "% Trump 2020", 
       title = "Trump Support in Florida Counties: 2016 & 2020") +
  geom_abline(intercept=0,slope=1) +
  scale_x_continuous(limits = c(0,1),labels = scales::percent_format(accuracy = 1)) + 
  scale_y_continuous(limits = c(0,1),labels = scales::percent_format(accuracy = 1))

What if we compare Republican vote share in 2004 and 2020. What does that show?

rawvote %>%
  ggplot(aes(x=pct_rep_2004, y=pct_rep_2020)) +
  geom_point() +
  labs(x="% Republican 2004", 
       y = "% Republican 2020", 
       title = "Republican Support in Florida Counties: 2004 & 2020") +
  geom_abline(intercept=0,slope=1) +
  scale_x_continuous(limits = c(0,1),labels = scales::percent_format(accuracy = 1)) + 
  scale_y_continuous(limits = c(0,1),labels = scales::percent_format(accuracy = 1))

How many clusters?

So a critical question is always – how many clusters should I use? An issue with answering this question is that there really isn’t a statistical theory to guide this determination. More clusters will always “explain” more variation, and if we choose the number of clusters equal to the number of data points we will perfectly “fit/explain” the data. But it will be a trivial explanation and not give us any real information. Recall that one of the goals is to use the clustering to reduce the dimensionality of the data in a way that recovers a “meaningful” representation of the underlying data.

So let us explore how the clustering changes for different numbers of centers. What we are going to do is to create a tibble called kcluster.fl that is going to contain the results of a kmeans clustering for 10 different choices of K that varies from 1 to 10.

kcluster.fl <- 
  tibble(K = 1:10) %>%   # define a sequence that we will use to denote k
  mutate(   # now we are going to create new variables in this tibble
    kcluster = map(K, ~kmeans(rawvote, .x, nstart = 25)),   # run a kmeans clustering using k
    tidysummary = map(kcluster, tidy), # run the tidy() function on the kcluster object
    augmented = map(kcluster, augment, rawvote), # save the cluster to the data
  )

The above code uses the map function which is how we can apply a function across an index. So in line 418 we are going to take map to apply the sequence of K values we defined running from 1 to 10 the kmeans() algorithm applied to the rawvotes tibble. The .x in the line reveals where we are going to substitute the value being mapped. So the object kcluster is going to be a list of 10 elements – each list element being a kmeans object associated with the choice of K centers.

We then map the tidy function to the list of kcluster we just created – creating a list called tidysummary where each element is the summary associated with the kth clustering. We next create a tibble that augments the original data being clustered – rawvotes with the cluster label associated with the kth clustering. (But remember that the meaning of those labels is not fixed!)

So let’s give in to see what we have just done. If we take a look at the first row of kcluster.fl we can see that it consists of a vector of the sequence of k’s we defined, and then the three list objects we created – kcluster, tidysummary, and augmented.

kcluster.fl[1,]

## # A tibble: 1 × 4
##       K kcluster tidysummary      augmented        
##   <int> <list>   <list>           <list>           
## 1     1 <kmeans> <tibble [1 × 8]> <tibble [67 × 6]>

But to work with these objects we need to extract these lists. Lists are a pain in R – especially when you are starting out – so do not think too hard about the following. What we are going to essentially do is to extract each of the list objects in kcluster.fl to a separate tibble.

clusters <- kcluster.fl %>%
  unnest(cols=c(tidysummary))

clusters

## # A tibble: 55 × 11
##        K kcluster pct_rep_2004 pct_rep_2008 pct_rep_2012 pct_rep_2016
##    <int> <list>          <dbl>        <dbl>        <dbl>        <dbl>
##  1     1 <kmeans>        0.595        0.581        0.595        0.620
##  2     2 <kmeans>        0.674        0.680        0.695        0.730
##  3     2 <kmeans>        0.519        0.484        0.499        0.514
##  4     3 <kmeans>        0.580        0.562        0.584        0.620
##  5     3 <kmeans>        0.462        0.420        0.425        0.416
##  6     3 <kmeans>        0.707        0.716        0.727        0.759
##  7     4 <kmeans>        0.531        0.495        0.511        0.533
##  8     4 <kmeans>        0.416        0.374        0.371        0.351
##  9     4 <kmeans>        0.712        0.724        0.734        0.765
## 10     4 <kmeans>        0.601        0.588        0.611        0.648
## # ℹ 45 more rows
## # ℹ 5 more variables: pct_rep_2020 <dbl>, size <int>, withinss <dbl>,
## #   cluster <fct>, augmented <list>

So clusters is a tibble that consists of the centroids associated with each of the centroids in each of the K clusterings we did.

We can also extract the clusters associated with each of the observations by doing a similar operation on the augmented list we created.

points <- kcluster.fl %>%
  unnest(cols=c(augmented))

points

## # A tibble: 670 × 9
##        K kcluster tidysummary      pct_rep_2004 pct_rep_2008 pct_rep_2012
##    <int> <list>   <list>                  <dbl>        <dbl>        <dbl>
##  1     1 <kmeans> <tibble [1 × 8]>        0.429        0.386        0.405
##  2     1 <kmeans> <tibble [1 × 8]>        0.777        0.784        0.789
##  3     1 <kmeans> <tibble [1 × 8]>        0.712        0.699        0.712
##  4     1 <kmeans> <tibble [1 × 8]>        0.696        0.697        0.706
##  5     1 <kmeans> <tibble [1 × 8]>        0.577        0.547        0.558
##  6     1 <kmeans> <tibble [1 × 8]>        0.346        0.324        0.323
##  7     1 <kmeans> <tibble [1 × 8]>        0.634        0.696        0.710
##  8     1 <kmeans> <tibble [1 × 8]>        0.557        0.531        0.567
##  9     1 <kmeans> <tibble [1 × 8]>        0.569        0.574        0.604
## 10     1 <kmeans> <tibble [1 × 8]>        0.762        0.711        0.725
## # ℹ 660 more rows
## # ℹ 3 more variables: pct_rep_2016 <dbl>, pct_rep_2020 <dbl>, .cluster <fct>

So now we can plot the results. To do so we are going to produce multiple plots by “facet-wrapping” using values K.

p1 <- 
  ggplot(points, aes(x = pct_rep_2004, y = pct_rep_2020)) +
  geom_point(aes(color = .cluster), alpha = 0.8) + 
  labs(x = "% Republican Vote 2004",
       y = "% Republican Vote 2020",
       color = "Cluster",
       title = "Clusters for Various Choices of K") + 
  facet_wrap(~ K) + 
  scale_x_continuous(limits = c(.25,1),labels = scales::percent_format(accuracy = 1)) + 
  scale_y_continuous(limits = c(.25,1),labels = scales::percent_format(accuracy = 1)) 

p1

Now let’s add in the centroids!

p1 + geom_point(data = clusters, size = 4, shape = "+")

How does Total Within Sum of squares change as clusters increase? Recall that the within sum of squares for each cluster is simply how far each data point in a cluster is from the centroid according to squared Euclidean distance. Thus, if $T$ denotes PctTrump and $C$ denotes PctClinton the within sum of squares for cluster $k$ using the $n$ counties that are allocated in cluster $k$ is given by:

\[WSS_k=\sum_i^n (\bar{T}_k - T_i)^2 + (\bar{C}_k - C_i)^2\]

Given this, the total within sum of squares is simply the sum of the within sum of squares across the k clusters. In other words, if we fit $K$ clusters, the total within sum of squares is:

\[ TSS = \sum_k^K WSS_k\]

Note that the total sum of squares will usually decrease as the number of clusters increase, Why? Because more clusters means more centroids which will mean smaller squared distances. If, for example, we fit a model with as many centroids as there are observations – i.e., $K==N$ – then the within sum of squares for every observation would be $0$ and the total sum of squares would also be $0$! Note that the total sum of squares will not always decrease depending on number of clusters because of the dependence on start values. Especially when analyzing many variables, the results become more sensitive it is to start values!

Too see what we have created, let us take a look within the tibble kcluster.fl and extract the second list item – which is the set of tibbles summarizing the overall fit.

fits <- kcluster.fl[[2]]

To extract the total within sum-of-squares from this we can write a loop to extract the information. Note that we are using [[]] to select an element from a list. Then we can plot the relationship.

tot.withinss <- NULL

for(i in 1:10){
  tot.withinss[i] <- fits[[i]]$tot.withinss
}

fit <- bind_cols(k = seq(1,10), tot.withinss = tot.withinss)

ggplot(fit, aes(x=k,y=tot.withinss)) + 
  geom_line() +
  scale_x_continuous(breaks=seq(1,10)) + 
  labs(x="Number of Clusters", y ="Total Within Sum of Squares")

Identifying the meaning of clusters

OK, so how do we interpret what this means? Or label the clusters sensibly? This again requires the data scientist to examine and mutate the data.

set.seed(13469)
fl.cluster <- kmeans(rawvote, centers=5, nstart = 25)
dat.cluster <- augment(fl.cluster,dat.fl)

tidy(fl.cluster) %>%
  arrange(-pct_rep_2020)

## # A tibble: 5 × 8
##   pct_rep_2004 pct_rep_2008 pct_rep_2012 pct_rep_2016 pct_rep_2020  size
##          <dbl>        <dbl>        <dbl>        <dbl>        <dbl> <int>
## 1        0.714        0.727        0.737        0.768        0.779    19
## 2        0.619        0.617        0.638        0.678        0.692    14
## 3        0.570        0.541        0.562        0.596        0.607    17
## 4        0.513        0.475        0.493        0.503        0.510     9
## 5        0.416        0.374        0.371        0.351        0.384     8
## # ℹ 2 more variables: withinss <dbl>, cluster <fct>

Now change the order of the factor so that it is ordered from most Trump supporting to most Clinton supporting. To do so we need to use the factor function to re-define the order of the levels.

dat.cluster <- dat.cluster %>%
  mutate(cluster = factor(.cluster, 
                          levels=c(3,5,2,4,1)))

Now let’s check that we did this correctly. Let’s see if the clusters are arranged by average Trump support.

dat.cluster %>%
  group_by(cluster) %>%
  summarize(PctTrump = mean(pct_rep_2020))

## # A tibble: 5 × 2
##   cluster PctTrump
##   <fct>      <dbl>
## 1 3          0.779
## 2 5          0.692
## 3 2          0.607
## 4 4          0.510
## 5 1          0.384

Yes, but the labels are weird and unintuitive. Let’s fix this by using the factor function to change the labels associated with each factor value.

dat.cluster <- dat.cluster %>%
  mutate(cluster = factor(cluster, 
                          labels=c("Very Strong Rep","Strong Rep","Rep","Toss Up","Strong Dem")))

Now confirm that we did not screw that up.

dat.cluster %>%
  group_by(cluster) %>%
  summarize(PctTrump = mean(pct_rep_2020))

## # A tibble: 5 × 2
##   cluster         PctTrump
##   <fct>              <dbl>
## 1 Very Strong Rep    0.779
## 2 Strong Rep         0.692
## 3 Rep                0.607
## 4 Toss Up            0.510
## 5 Strong Dem         0.384

This seems good to go.

fl.centers <- as.data.frame(fl.cluster$centers)

gg <- ggplot() +
  geom_point(data=dat.cluster, aes(x = pct_rep_2020, y = pct_rep_2004, color = cluster,
                                   text=paste(county.name)), alpha = 0.8) + 
  geom_point(data=fl.centers, aes(x = pct_rep_2020, y = pct_rep_2004), size = 6, shape = "+") + 
  labs(color = "Cluster",
       title = "Florida Counties",
       x = "Percentage Vote for Trump",
       y = "Percentage Vote for Clinton") +
  scale_y_continuous(limits = c(0,1),labels = scales::percent_format(accuracy = 1)) + 
  scale_x_continuous(limits = c(0,1),labels = scales::percent_format(accuracy = 1))

## Warning in geom_point(data = dat.cluster, aes(x = pct_rep_2020, y =
## pct_rep_2004, : Ignoring unknown aesthetics: text

ggplotly(gg,tooltip = "text")

So how well does our classification compare to the one that was used by the networks on Election Night?

table(dat.cluster$cluster,dat.cluster$party.strata)

##                  
##                   1--High Democrat 2--Mod Democrat 3--Middle 4--Mod Republican
##   Very Strong Rep                0               0         0                 0
##   Strong Rep                     0               0         0                 0
##   Rep                            0               0         0                 9
##   Toss Up                        0               0         7                 2
##   Strong Dem                     3               5         0                 0
##                  
##                   5--High Republican
##   Very Strong Rep                 19
##   Strong Rep                      14
##   Rep                              8
##   Toss Up                          0
##   Strong Dem                       0

Interesting….

It is often also useful to summarize the distribution of key variables by the clusters we have found to try to interpret their meaning. Here we can use a boxplot to describe how the county clusters vary in terms of the average support for President Trump.

dat.cluster %>%
  ggplot(aes(x=cluster, y=pct_rep_2020)) +
  geom_boxplot() + 
  labs(x="Cluster",
       y="Pct Trump",
       title="Support for Trump Across Counties in FL")

We could also merge in county-level demographic data (using Census fips_code) and see how things change if we cluster counties based on their demographic features. But the important thing to remember is that because this is an unsupervised method there is no way to determine if the clustering is what you want it to be. Also recall that the scale matters. The computer will always find the number of clusters you ask for, but whether those clusters mean anything is up to you, the data analyst to determine. This is where critical thinking is essential – what variables are appropriate to include? And how do you interpret the meaning of the clusters given the distribution of data within those clusters?

Even More Data! Even More Clusters?

What if we looked at all counties? Note we are going to drop some states that do not record vote by counties (e.g., Maine) as well as others for which we are lacking data for some years (e.g., Alaska). Let’s create a tibble containing just the data called rawdata and drop all missing data.

Do we need to standardize? Why or why not?

rawvote <- dat.all %>%
  select(c(pct_rep_2004,pct_rep_2008,pct_rep_2012,pct_rep_2016,pct_rep_2020)) %>%
  drop_na()

What if we compare Republican vote share in 2004 and 2020. What does that show? Let’s plot and see.

rawvote %>%
  ggplot(aes(x=pct_rep_2004, y=pct_rep_2020)) +
  geom_point(alpha=0.3) +
  labs(x="% Republican 2004", 
       y = "% Republican 2020", 
       title = "Republican Support in Counties: 2004 & 2020") +
  geom_abline(intercept=0,slope=1) +
  scale_x_continuous(limits = c(0,1),labels = scales::percent_format(accuracy = 1)) + 
  scale_y_continuous(limits = c(0,1),labels = scales::percent_format(accuracy = 1))

We begin by setting a seed to ensure replicability and then we fit K different clusters – one for each choice of K.

set.seed(42)
kcluster.us <- 
  tibble(K = 1:10) %>%   # define a sequence that we will use to denote k
  mutate(   # now we are going to create new variables in this tibble
    kcluster = map(K, ~kmeans(rawvote, .x, iter.max = 100)),   # run a kmeans clustering using k
    tidysummary = map(kcluster, tidy), # run the tidy() function on the kcluster object
    augmented = map(kcluster, augment, rawvote) # save the cluster to the data
  )

To plot this we want to extract the data points from kcluster.us using the unnest function to the tibble points.us and we want to extract the centroids of the clusters from the tidysummary for each cluster into the new tibble clusters.us by unnesting the summaries of each fit.

points.us <- kcluster.us %>%
  unnest(cols=c(augmented))

clusters.us <- kcluster.us %>%
  unnest(cols=c(tidysummary))

Now we can use these two new tibbles to plot.

points.us %>%
  ggplot(aes(x = pct_rep_2004, y = pct_rep_2020)) +
  geom_point(aes(color = .cluster), alpha = 0.8) + 
  labs(x = "% Republican Vote 2004",
       y = "% Republican Vote 2020",
       color = "Cluster",
       title = "Clusters for Various Choices of K") + 
  facet_wrap(~ K) + 
  scale_x_continuous(limits = c(.25,1),labels = scales::percent_format(accuracy = 1)) + 
  scale_y_continuous(limits = c(.25,1),labels = scales::percent_format(accuracy = 1)) + 
  geom_point(data = clusters.us, size = 4, shape = "+")

## Warning: Removed 2120 rows containing missing values or values outside the scale range
## (`geom_point()`).

## Warning: Removed 5 rows containing missing values or values outside the scale range
## (`geom_point()`).

So how many clusters? Here we can see what the total within sum of squares is for each set of clusters that we find for the various choices of k. To determine how many, we want to choose a value of k such that there is very little change from adding additional clusters. Note that more clusters will always do better, so the issue is to find out the point at which the improvement seems small. This is a judgment call.

So let’s extract the fits from the kcluster.us list and then loop over the k different fits to extract the total within sum of squares (tot.withinss) and then create a new tibble fit that contains the vector of cluster sizes and vector of total within sum of squares that we used the loop to extract (i.e., tot.withinss).

fits <- kcluster.us[[2]]
tot.withinss <- NULL

for(i in 1:10){
  tot.withinss[i] <- fits[[i]]$tot.withinss
}

fit <- bind_cols(k = seq(1,10), tot.withinss = tot.withinss)

Now plot to see where the line “bends”.

fit %>%
  ggplot(aes(x=k,y=tot.withinss)) + 
  geom_line() +
  scale_x_continuous(breaks=seq(1,10)) + 
  labs(x="Number of Clusters", 
       y ="Total Within Sum of Squares",
       title = "Fit by Number of Clusters")

So it seems like there are 4 or maybe 5 clusters that seem relevant?

Hey, guess what?! That’s it for new material. You’re done! Congratulations on making it this far!

College Admissions, Part 1

Mon, 01 Jan 0001 00:00:00 +0000

College Admissions: From the College’s View

All of you have quite recently gone through the stressful process of figuring out which college to attend. You most likely selected colleges you thought might be a good fit, sent off applications, heard back from them, and then weighed your options. Those around you probably emphasized what an important decision this is for you and for your future.

Colleges see this process from an entirely different point of view. A college needs students to enroll first of all in order to collect enough tuition revenues in order to keep the lights on, the faculty paid, and, in the case Villanova, purchase TWO campuses. Almost all private colleges receive most of their revenues from tuition, and public colleges receive about equal amounts of funding from tuition and state funds, with state funds based on how many students they enroll. Second, colleges want to enroll certain types of students; colleges base their reputation on which students enroll, with greater prestige associated with enrolling students with better demonstrated academic qualifications. The job of enrolling a class that provides enough revenue AND has certain characteristics falls to the Enrollment Management office on a campus. This office typically includes the admissions office as well as the financial aid office.

The College Admissions “Funnel”

The admissions funnel is a well-established metaphor for understanding the enrollment process from the college’s perspective. It begins with colleges identifying prospective students: those who might be interested in enrolling. This proceeds to “interested” students, who engage with the college via registering on the college website, sending test scores, visiting campus, or requesting other information. Some portion of these interested students will then apply. Applicants are then considered, and admissions decisions are made. From this group of admitted students a certain proportion will actually enroll. Here’s data from Villanova on their enrollment funnel.

Each stage in this process involves modeling and prediction: how can we predict which prospective students will end up being interested students? How many interested students will turn into applicants? And, most importantly, how many admitted students will actually show up in the fall?

Colleges aren’t powerless in this process. Instead, they execute a careful strategy to intervene at each stage to get both the number and type of students they want to convert to the next stage. These are the core functions of enrollment management. Why did you receive so many emails, brochures and maybe even text messages? Some model somewhere said that the intervention could convert you from a prospect to an interest, or from an interest to an applicant.

We’re going to focus on the very last step: from admitted students to what’s called a yield: a student who actually shows up and sits down for classes in the fall.

The stakes are large: if too few students show up, then the institutions will not have enough revenues to operate. If too many show up the institution will not have capacity for all of them. On top of this, enrollment managers are also tasked with the combined goals of increasing academic prestige (usually through test scores and GPA) and increasing the socioeconomic diversity of the entering class. As we’ll see, these are not easy tasks.

The Data

We’re going to be using a dataset that was constructed to resemble a typical admissions dataset. To be clear: this is not real data, but instead is based on the relationships we see in actual datasets. Using real data in this case would be a violation of privacy.

library(tidyverse)
library(scales)

ad<-read_rds("https://github.com/rweldzius/PSC4175/raw/main/static/data/admit_data.rds")%>%ungroup()

Codebook for admit_data.rds:

Variable Name	Description
ID	Student id
income	Family income (AGI)
sat	SAT/ACT score (ACT scores converted to SAT scale)
gpa	HS GPA, four point scale
visit	Did student visit campus?
legacy	Did student parent go to this college?
registered	Did student register on the website?
sent_scores	Did student send scores prior to applying?
distance	Distance from student home address to campus
tuition	Stated tuition: $45,000
need_aid	Need-based aid offered
merit_aid	Merit-based aid offered
net_price	Net Price: Tuition less aid received
yield	Student enrolled in classes in fall after admission

The Basics

## How many admitted students enroll?
ad%>%summarize(`Yield Rate`=percent(mean(yield)))

##   Yield Rate
## 1        68%

## Just for enrolled students
ad%>%filter(yield==1)%>%summarize(
               `Average  SAT Score`=number(mean(sat),accuracy=1,big.mark=""),
               `Average GPA`=number(mean(gpa),accuracy = 1.11),
               `Tuition`=dollar(mean(tuition)),
               `Average Net Price`=dollar(mean(net_price),accuracy = 1 ),
               `Total Tuition Revenues`=dollar(sum(net_price)),
               `Total 1st Year Enrollment`=comma(n(),big.mark=","))

##   Average  SAT Score Average GPA Tuition Average Net Price
## 1               1226        3.33 $45,000           $20,924
##   Total Tuition Revenues Total 1st Year Enrollment
## 1            $30,674,149                     1,466

So, a few things stand out right away, all of which are pretty common among private colleges. First, this is a moderately selective institution, with an average GPA of 3.33 (unweighted) and an average SAT of about 1200 (about a 25 on the ACT). The average net price is MUCH less than tuition, indicating that the campus is discounting heavily. Total revenues from tuition are about 30 million.

The Case

We’ve been hired as the data science team for a liberal arts college (this is a real thing).

The college president and the board of trustees have two strategic goals:

Increase the average SAT score to 1300
Admit at least 200 more students with incomes less than $50,000

Here’s the rub: they want to do this without allowing tuition revenues to drop below $30 million and without changing the size of the entering class, which should be about 1,500 students (plus or minus 50, nobody minds sleeping in Falvey, right?).

What we need to do is to figure out which students are most and least likely to enroll. We can then target our financial aid strategy to improve yield rates among certain groups.

This is a well-known problem known as price discrimination, which is applied in many industries, including airlines, hotels, and software. The idea is to charge the customers who are most willing/able to pay the most, while charging the customers who are least willing/able to pay the least.

To solve our problem we need to do the following:

Come up with a prediction algorithm that accurately establishes the relationship between student characteristics and the probability of attendance
Adjust policies in order to target those students who we want to attend, thereby increasing their probability of attendance.

Current Institutional Policies

Essentially every private college engages heavily in tuition discounting. This has two basic forms: need-based aid and merit-based aid. Need-based aid is provided on the basis of income, typically with some kind of income cap. Merit-based aid is based on demonstrated academic qualifications, again usually with some kind of minimum. Here’s this institution’s current policies.

The institution is currently awarding need-based aid for families making less than $100,0000 on the following formula:

$need_{aid}=500+(income/1000-100)*-425$

Translated, this means for every $1,000 the family makes less than $100,000 the student receives an additional 425 dollars. So for a family making $50,000, need-based aid will be $500+(50,000/1000-100)*-425= 500+ (-50*-425)$=$21,750. Need based aid is capped at total tuition.

ad%>%
  ggplot(aes(x=income,y=need_aid))+
  geom_point()

The institution is currently awarding merit-based aid for students with SAT scores above 1250 on the following formula:

$merit_{aid}=5000+(sat/100*250)$

Translated, this means that for every 10 points in SAT scores above 1250, the student will receive an additional $1,500. So for a student with 1400 SAT, merit based aid will be : $5000+ (1400/10 *250)= 500+(140*250)$

ad%>%
  ggplot(aes(x=sat,y=merit_aid))+
  geom_point()

As with need-based aid, merit-based aid is capped by total tuition.

Classification

Our core prediction problem is classification. There are two groups of individuals that constitute our outcome: those who attended and those who did not. In data science, predicting group membership is known as a classification problem. It occurs whenever the outcome is a set of discrete groupings. We’ll be working with the simplest type of classification problem, which has just two groups, but these problems can have multiple groups, essentially categorical variables.

Probability of Attendance

Remember: the mean of a binary variable is the same thing as the proportion of the sample with that characteristic. So, the mean of yield is the same thing as the proportion of admitted students who attend, or the probability of attendance.

ad%>%summarize(pr_attend=mean(yield))

##   pr_attend
## 1 0.6818605

Conditional Means

Let’s go back to our first algorithm for prediction: conditional means. Let’s start with the variable legacy which indicates whether or not the student has a parent who attended the same institution:

ad%>%
  group_by(legacy)%>%
  summarize(pr_attend=mean(yield))

## # A tibble: 2 × 2
##   legacy pr_attend
##    <dbl>     <dbl>
## 1      0     0.641
## 2      1     0.780

That’s a big difference! Legacy students are abut 14 percentage points more likely to yield than non-legacies.

Next, let’s look at SAT scores. This is a continuous variable, so we need to first break it up into a smaller number of groups. Let’s look at yield rates by quintile of SAT scores among admitted students:

ad%>%
  mutate(sat_quintile=ntile(sat,n=5))%>%
  group_by(sat_quintile)%>%
  summarize(min_sat=min(sat),
  pr_attend=mean(yield))

## # A tibble: 5 × 3
##   sat_quintile min_sat pr_attend
##          <int>   <dbl>     <dbl>
## 1            1   1000      0.440
## 2            2   1114.     0.533
## 3            3   1173.     0.691
## 4            4   1227.     0.828
## 5            5   1285.     0.919

So, it looks like yield steadily increases with SAT scores– a good sign for the institution as it seeks to increase SAT scores.

Quick Exercise 1 calculate yield by quintiles of net price: what do you see?

ad%>%
  mutate(...)%>%
  group_by(... = )%>%
  summarize(amount=min(...),
            pr_attend=mean(...))

## Error in group_by(., ... = ): '...' used in an incorrect context

Combining Conditional Means

Let’s look at yield rates by both sat quintile and legacy status. What type of plot do you think we’ll use? Remember from the lectures on multivariate visualization. If you have Categorical X Categorical X Continuous, then use a tile plot!

ad%>%
  mutate(sat_decile=ntile(sat,n=10))%>%
  group_by(sat_decile,legacy)%>%
  summarize(min_sat=min(sat),
  pr_attend=mean(yield))%>%
  ggplot(aes(y=as_factor(sat_decile),x=as_factor(legacy),fill=pr_attend))+
  geom_tile()+
  scale_fill_viridis_c()+
  ylab("SAT Score Decile")+xlab("Legacy Status")

## `summarise()` has grouped output by 'sat_decile'. You can override using the
## `.groups` argument.

Predictions based on conditional means

We can use this simple method to make predictions.

ad<-ad%>%
  mutate(sat_quintile=ntile(sat,n=10))%>%
  group_by(sat_quintile,legacy)%>%
  mutate(prob_attend=mean(yield))%>%
  mutate(pred_attend=ifelse(prob_attend>=.5,1,0))

Let’s compare this predicted with the actual:

ad%>%
  group_by(yield,pred_attend)%>%
  summarize(n())%>%
  rename(`Actually Attended`=yield,
         `Predicted to Attend`=pred_attend,
         `Number of Students`=`n()`)

## `summarise()` has grouped output by 'yield'. You can override using the
## `.groups` argument.

## # A tibble: 4 × 3
## # Groups:   Actually Attended [2]
##   `Actually Attended` `Predicted to Attend` `Number of Students`
##                 <int>                 <dbl>                <int>
## 1                   0                     0                  304
## 2                   0                     1                  380
## 3                   1                     0                  210
## 4                   1                     1                 1256

Acccuracy of Conditional Means

ad%>%
  group_by(yield)%>%
  mutate(total_attend=n())%>%
  group_by(yield,pred_attend)%>%
  summarize(n(),`Actual Group`=mean(total_attend))%>%
  mutate(Proportion=`n()`/`Actual Group`)%>%
  rename(`Actually Attended`=yield,
         `Predicted to Attend`=pred_attend,
         `Number of Students`=`n()`)

## `summarise()` has grouped output by 'yield'. You can override using the
## `.groups` argument.

## # A tibble: 4 × 5
## # Groups:   Actually Attended [2]
##   `Actually Attended` `Predicted to Attend` `Number of Students` `Actual Group`
##                 <int>                 <dbl>                <int>          <dbl>
## 1                   0                     0                  304            684
## 2                   0                     1                  380            684
## 3                   1                     0                  210           1466
## 4                   1                     1                 1256           1466
## # ℹ 1 more variable: Proportion <dbl>

Here’s how to read this: There were 304 students that our algorithm said would not attend who didn’t attend. This means out of the 684 students who were admitted but did not attend, our algorithm correctly classified 44 percent. There were 380 students who our model said would not attend who actually showed up (or 56 percent).

On the other side, there were 210 students who our model said would not show up, who actually attended. And last, there were 1256 students who our model said would attend who actually did; we correctly classified 85 percent of actual attendees. The overall accuracy of our model ends up being (304+1256)/2150 or 73 percent.

Question: is this a good model?

Prediction via Linear Regression: Wrong, but Useful!

We can use our standard tool of linear regression to build a model and make predictions, with just a few adjustments. This will be wrong, but useful.

We’ll use the wrong model, a linear regression. Running a linear regression with a binary dependent variable is called a linear probability model, which ironically it is not.

We’ll use a formula that includes the variables we’ve used so far.

admit_formula<-as.formula("yield~sat+net_price+legacy")

ad_analysis <- ad %>%
  ungroup() %>%
  select(yield,sat,net_price,legacy) %>%
  drop_na()

m <- lm(formula = admit_formula,data = ad_analysis)
summary(m)

## 
## Call:
## lm(formula = admit_formula, data = ad_analysis)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -1.1497 -0.3714  0.1338  0.3055  0.9392 
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)    
## (Intercept) -2.981e+00  1.514e-01 -19.696  < 2e-16 ***
## sat          2.842e-03  1.173e-04  24.222  < 2e-16 ***
## net_price    1.052e-05  7.447e-07  14.122  < 2e-16 ***
## legacy       9.502e-02  1.954e-02   4.863 1.24e-06 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.409 on 2146 degrees of freedom
## Multiple R-squared:  0.2302,	Adjusted R-squared:  0.2291 
## F-statistic: 213.9 on 3 and 2146 DF,  p-value: < 2.2e-16

Question: What do we make of these coefficients

To evaluate our model, we traditionally have relied on RMSE. However, this is less appropriate when using a binary dependent variable. Instead, we want to think about accuracy. Let’s start by getting the predictions, as always.

ad_analysis <- ad_analysis %>%
  mutate(preds = predict(m)) %>%
  mutate(errors = yield - preds)

Let’s take a look at these predictions

ad_analysis %>% select(yield,preds)

## # A tibble: 2,150 × 2
##    yield preds
##    <int> <dbl>
##  1     1 0.735
##  2     1 1.07 
##  3     1 0.245
##  4     0 0.683
##  5     1 0.589
##  6     0 0.358
##  7     1 0.559
##  8     1 0.757
##  9     0 0.366
## 10     0 0.698
## # ℹ 2,140 more rows

So these are probabilities. To complete the classification problem, we need to assign group labels to each case in the testing dataset. Let’s assume that a probability equal to or greater than .5 will be classified as a 1 and everything else as a 0.

ad_analysis<-ad_analysis%>%
  mutate(pred_attend=ifelse(preds>=.5,1,0))

ad_analysis%>%select(yield,preds,pred_attend)

## # A tibble: 2,150 × 3
##    yield preds pred_attend
##    <int> <dbl>       <dbl>
##  1     1 0.735           1
##  2     1 1.07            1
##  3     1 0.245           0
##  4     0 0.683           1
##  5     1 0.589           1
##  6     0 0.358           0
##  7     1 0.559           1
##  8     1 0.757           1
##  9     0 0.366           0
## 10     0 0.698           1
## # ℹ 2,140 more rows

Here’s the problem with using a linear regression in this case: there’s no guarantee that the results will be on the probability scale. So, we can find cases where our model predicted probabilities below 0 or above 1. Of course, these just get labeled as 1 or 0.

ad_analysis%>%
  filter(preds>1|preds<0)%>%
  select(yield,preds,pred_attend)

## # A tibble: 128 × 3
##    yield preds pred_attend
##    <int> <dbl>       <dbl>
##  1     1  1.07           1
##  2     1  1.06           1
##  3     1  1.02           1
##  4     1  1.10           1
##  5     1  1.03           1
##  6     1  1.12           1
##  7     1  1.18           1
##  8     1  1.49           1
##  9     1  1.15           1
## 10     1  1.11           1
## # ℹ 118 more rows

Accuracy of Linear Regression

ad_analysis%>%
  group_by(yield)%>%
  mutate(total_attend=n())%>%
  group_by(yield,pred_attend)%>%
  summarize(n(),`Actual Group`=mean(total_attend))%>%
  mutate(Proportion=`n()`/`Actual Group`)%>%
  rename(`Actually Attended`=yield,
         `Predicted to Attend`=pred_attend,
         `Number of Students`=`n()`)

## `summarise()` has grouped output by 'yield'. You can override using the
## `.groups` argument.

## # A tibble: 4 × 5
## # Groups:   Actually Attended [2]
##   `Actually Attended` `Predicted to Attend` `Number of Students` `Actual Group`
##                 <int>                 <dbl>                <int>          <dbl>
## 1                   0                     0                  282            684
## 2                   0                     1                  402            684
## 3                   1                     0                  113           1466
## 4                   1                     1                 1353           1466
## # ℹ 1 more variable: Proportion <dbl>

In this model, we correctly classified 282 out of 684 non-attendees or about 41 percent, and 1353 out of 1466 attendees or about 92 percent. The overall accuracy is (282+1353)/2150 or 76 percent. How are we doing?

Sensitivity

In the above table, the percent of 1s correctly identified is a measure known as sensitivity:

ad_analysis%>%
  group_by(yield)%>%
  mutate(total_attend=n())%>%
  group_by(yield,pred_attend)%>%
  summarize(n(),`Actual Group`=mean(total_attend))%>%
  mutate(Proportion=`n()`/`Actual Group`)%>%
  rename(`Actually Attended`=yield,
         `Predicted to Attend`=pred_attend,
         `Number of Students`=`n()`) %>%
  filter(`Actually Attended` == 1 & `Predicted to Attend` == 1)

## `summarise()` has grouped output by 'yield'. You can override using the
## `.groups` argument.

## # A tibble: 1 × 5
## # Groups:   Actually Attended [1]
##   `Actually Attended` `Predicted to Attend` `Number of Students` `Actual Group`
##                 <int>                 <dbl>                <int>          <dbl>
## 1                   1                     1                 1353           1466
## # ℹ 1 more variable: Proportion <dbl>

Specificity

The percent of 0s correctly identified is a measure known as specificity

ad_analysis%>%
  group_by(yield)%>%
  mutate(total_attend=n())%>%
  group_by(yield,pred_attend)%>%
  summarize(n(),`Actual Group`=mean(total_attend))%>%
  mutate(Proportion=`n()`/`Actual Group`)%>%
  rename(`Actually Attended`=yield,
         `Predicted to Attend`=pred_attend,
         `Number of Students`=`n()`) %>%
  filter(`Actually Attended` == 0 & `Predicted to Attend` == 0)

## `summarise()` has grouped output by 'yield'. You can override using the
## `.groups` argument.

## # A tibble: 1 × 5
## # Groups:   Actually Attended [1]
##   `Actually Attended` `Predicted to Attend` `Number of Students` `Actual Group`
##                 <int>                 <dbl>                <int>          <dbl>
## 1                   0                     0                  282            684
## # ℹ 1 more variable: Proportion <dbl>

Accuracy

ad_analysis%>%
  group_by(yield)%>%
  mutate(total_attend=n())%>%
  group_by(yield,pred_attend)%>%
  summarize(n(),`Actual Group`=mean(total_attend))%>%
  mutate(Proportion=`n()`/`Actual Group`)%>%
  rename(`Actually Attended`=yield,
         `Predicted to Attend`=pred_attend,
         `Number of Students`=`n()`) %>%
  filter(`Actually Attended` == `Predicted to Attend`) %>%
  ungroup() %>%
  summarise(Accuracy = sum(`Number of Students`) / sum(`Actual Group`))

## `summarise()` has grouped output by 'yield'. You can override using the
## `.groups` argument.

## # A tibble: 1 × 1
##   Accuracy
##      <dbl>
## 1    0.760

College Admissions, Part 2

Mon, 01 Jan 0001 00:00:00 +0000

College Admissions: From the College’s View [Recap]

Colleges see this process from an entirely different point of view. A college needs students to enroll first of all in order to collect enough tuition revenues in order to keep the lights on and the faculty paid. Almost all private colleges receive most of their revenues from tuition, and public colleges receive about equal amounts of funding from tuition and state funds, with state funds based on how many students they enroll. Second, colleges want to enroll certain types of students– colleges based their reputation based on which students enroll, with greater prestige associated with enrolling students with better demonstrated academic qualifications. The job of enrolling a class that provides enough revenue AND has certain characteristics falls to the Enrollment Management office on a campus. This office typically includes the admissions office as well as the financial aid office.

The College Admissions “Funnel”

We’re going to focus on the very last step: from admitted students to what’s called a yield: a student who actually shows up and sits down for classes in the fall.

The Data

library(tidyverse)
library(tidymodels)
library(scales)

ad<-read_rds("https://github.com/rweldzius/PSC4175/raw/main/static/data/admit_data.rds")%>%ungroup()

Codebook for admit_data.rds:

Variable Name	Description
ID	Student id
income	Family income (AGI)
sat	SAT/ACT score (ACT scores converted to SAT scale)
gpa	HS GPA, four point scale
visit	Did student visit campus?
legacy	Did student parent go to this college?
registered	Did student register on the website?
sent_scores	Did student send scores prior to applying?
distance	Distance from student home address to campus
tuition	Stated tuition: $45,000
need_aid	Need-based aid offered
merit_aid	Merit-based aid offered
net_price	Net Price: Tuition less aid received
yield	Student enrolled in classes in fall after admission

Logistic Regression

So far, we’ve been using tools we know for classification. While we can use conditional means or linear regression for classification, it’s better to use a tool that was created specifically for binary outcomes.

Logistic regression is set up to handle binary outcomes as the dependent variable. The downside to logistic regression is that it is modeling the log odds of the outcome, which means all of the coefficients are expressed as log odds, which (almost) no one understands intuitively.

Let’s take a look at a simple plot of our dependent variable as a function of one independent variable: SAT scores. I’m using geom_jitter to allow the points to “bounce” around a bit on the y axis so we can actually see them, but it’s important to note that they can only be 0s or 1s.

Yield as a Function of SAT Scores

ad%>%
  ggplot(aes(x=sat,y=yield))+
  geom_jitter(width=.01,height=.05,alpha=.25,color="blue")

We can see there are more higher SAT students than lower SAT students that ended up enrolling. A linear model in this case would look like this:

Predicted “Probabilities” from a Linear Model

ad%>%
  ggplot(aes(x=sat,y=yield))+
  geom_jitter(width=.01,height=.05,alpha=.25,color="blue")+
  geom_smooth(method="lm",se = FALSE,color="black")

## `geom_smooth()` using formula = 'y ~ x'

We can see the issue we identified last time: we CAN fit a model, but it doesn’t make a ton of sense. In particular, it doesn’t follow the data very well and it ends up with probabilities outside 0,1.

Generalized Linear Models

What we need is a better function that connects $y$ to $x$. The idea of connecting $y$ to $x$ with a function other than a simple line is called a generalized linear model.

A posits that the probability that $y$ is equal to some value is a function of the independent variables and the coefficients or other parameters via a link function:

$P(y|\mathbf{x})=G(\beta_0 + \mathbf{x_i\beta})$

In our case, we’re interested in the probability that $y=1$

$P(y=1|\mathbf{x})=G(\beta_0 + \mathbf{x_i\beta})$

There are several functions that “map” onto a 0,1 continuum. The most commonly used is the logistic function, which gives us the logit model.

The logistic function is given by:

$f(x)=\frac{1}{1+exp^{-k(x-x_0)}}$

The Logistic Function: Pr(Y) as a Function of X

x<-runif(100,-3,3)
pr_y=1/(1+exp(-x))
as_tibble(pr_y = pr_y,x = x)%>%
  ggplot(aes(x=x,y=pr_y))+
  geom_smooth()

## `geom_smooth()` using method = 'loess' and formula = 'y ~ x'

Mapped onto our GLM, this gives us:

$P(y=1|\mathbf{x})=\frac{exp(\beta_0 + \mathbf{x_i\beta})}{1+exp(\beta_0 +\mathbf{x_i\beta})}$

The critical thing to note about the above is that the link function maps the entire result of estimation $(\beta_0 + \mathbf{x_i\beta})$ onto the 0,1 continuum. Thus, the change in the $P(y=1|\mathbf{x})$ is a function of all of the independent variables and coefficients together, one at a time.

What does this mean? It means that the coefficients can only be interpreted on the logit scale, and don’t have the normal interpretation we would use for OLS regression. Instead, to understand what the logistic regression coefficients mean, you’re going to have to convert the entire term $(\beta_0 + \mathbf{x_i\beta})$ to the probability scale, using the inverse of the function. Luckily we have computers to do this for us . . .

If we use this link function on our data, it would look like this: glm(formula,family,data). Notice that it looks very similar to the linear regression function: lm(formula,data). The only difference is the name of the function (glm() versus lm()) and the additional input family. This input can take on many different values, but for this class, we only want the logit, which requires family = binomial(link = "logit").

Putting it all together:

Plotting Predictions from Logistic Regression

ad_analysis <- ad %>%
  ungroup() %>%
  select(yield,sat,net_price,legacy) %>%
  drop_na()

m <- glm(yield ~ sat, family = binomial(link = "logit"), data = ad_analysis)# %>% ## Run a glm
summary(m)

## 
## Call:
## glm(formula = yield ~ sat, family = binomial(link = "logit"), 
##     data = ad_analysis)
## 
## Coefficients:
##               Estimate Std. Error z value Pr(>|z|)    
## (Intercept) -1.077e+01  6.965e-01  -15.46   <2e-16 ***
## sat          9.730e-03  5.926e-04   16.42   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 2689.5  on 2149  degrees of freedom
## Residual deviance: 2353.7  on 2148  degrees of freedom
## AIC: 2357.7
## 
## Number of Fisher Scoring iterations: 4

How to interpret? It is more complicated than a linear regression model, and beyond what you are expected to know in an intro to data science class. We cannot say that each additional SAT score point corresponds to a 0.000973 increase in yield. However, we can conclude that there is a (1) positive and (2) statistically significant association between SAT scores and attending.

In this class…just focus on the sign of the coefficient and the p-value.

Quick Exercise 1: Replicate the above model using distance as a predictor and comment on what it tells you

## INSERT CODE HERE

As you’re getting started, this is what we recommend with these models:

Use coefficient estimates for sign and significance only–don’t try and come up with a substantive interpretation.
Generate probability estimates based on characteristics for substantive interpretations.

Evaluating

Since the outcome is binary, we want to evaluate our model on the basis of sensitivity, specificity, and accuracy. To get started, let’s generate predictions again.

NOTE: when predicting a glm() model, set type = "response"!

m <- glm(yield ~ sat, family = binomial(link = "logit"), data = ad_analysis)# %>% ## Run a glm
summary(m)

## 
## Call:
## glm(formula = yield ~ sat, family = binomial(link = "logit"), 
##     data = ad_analysis)
## 
## Coefficients:
##               Estimate Std. Error z value Pr(>|z|)    
## (Intercept) -1.077e+01  6.965e-01  -15.46   <2e-16 ***
## sat          9.730e-03  5.926e-04   16.42   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 2689.5  on 2149  degrees of freedom
## Residual deviance: 2353.7  on 2148  degrees of freedom
## AIC: 2357.7
## 
## Number of Fisher Scoring iterations: 4

ad_analysis%>%
  mutate(preds = predict(m,type = 'response')) %>% # Predicting our new model
  mutate(pred_attend = ifelse(preds > .5,1,0)) %>% # Converting predicted probabilities into 1s and 0s
  group_by(yield)%>%
  mutate(total_attend=n())%>%
  group_by(yield,pred_attend)%>%
  summarize(n(),`Actual Group`=mean(total_attend))%>%
  mutate(Proportion=`n()`/`Actual Group`)%>%
  rename(`Actually Attended`=yield,
         `Predicted to Attend`=pred_attend,
         `Number of Students`=`n()`)

## `summarise()` has grouped output by 'yield'. You can override using the
## `.groups` argument.

## # A tibble: 4 × 5
## # Groups:   Actually Attended [2]
##   `Actually Attended` `Predicted to Attend` `Number of Students` `Actual Group`
##                 <int>                 <dbl>                <int>          <dbl>
## 1                   0                     0                  220            684
## 2                   0                     1                  464            684
## 3                   1                     0                  173           1466
## 4                   1                     1                 1293           1466
## # ℹ 1 more variable: Proportion <dbl>

Our sensitivity is 0.88 or 88%, our specificity is 0.32 or 32%, and our overall accuracy is (220 + 1293) / 2150 or 0.70 (70%).

The Thresholds

Note that we required a “threshold” to come up with these measures of sensitivity, specificity, and accuracy. Specifically, we relied on a coin toss. If the predicted probability of attending was greater than 50%, we assumed that the student would attend, otherwise they wouldn’t. But this choice doesn’t always have to be 50%. We can choose a number of different thresholds.

ad_analysis%>%
  mutate(preds = predict(m,type = 'response')) %>% # Predicting our new model
  mutate(pred_attend = ifelse(preds > .35,1,0)) %>% # A lower threshold of 0.35 means that more students are predicted to attend
  group_by(yield)%>%
  mutate(total_attend=n())%>%
  group_by(yield,pred_attend)%>%
  summarize(n(),`Actual Group`=mean(total_attend))%>%
  mutate(Proportion=`n()`/`Actual Group`)%>%
  rename(`Actually Attended`=yield,
         `Predicted to Attend`=pred_attend,
         `Number of Students`=`n()`)

## `summarise()` has grouped output by 'yield'. You can override using the
## `.groups` argument.

## # A tibble: 4 × 5
## # Groups:   Actually Attended [2]
##   `Actually Attended` `Predicted to Attend` `Number of Students` `Actual Group`
##                 <int>                 <dbl>                <int>          <dbl>
## 1                   0                     0                   73            684
## 2                   0                     1                  611            684
## 3                   1                     0                   51           1466
## 4                   1                     1                 1415           1466
## # ℹ 1 more variable: Proportion <dbl>

ad_analysis%>%
  mutate(preds = predict(m,type = 'response')) %>% # Predicting our new model
  mutate(pred_attend = ifelse(preds > .75,1,0)) %>% # A higher threshold of 0.75 means that fewer students are predicted to attend
  group_by(yield)%>%
  mutate(total_attend=n())%>%
  group_by(yield,pred_attend)%>%
  summarize(n(),`Actual Group`=mean(total_attend))%>%
  mutate(Proportion=`n()`/`Actual Group`)%>%
  rename(`Actually Attended`=yield,
         `Predicted to Attend`=pred_attend,
         `Number of Students`=`n()`)

## `summarise()` has grouped output by 'yield'. You can override using the
## `.groups` argument.

## # A tibble: 4 × 5
## # Groups:   Actually Attended [2]
##   `Actually Attended` `Predicted to Attend` `Number of Students` `Actual Group`
##                 <int>                 <dbl>                <int>          <dbl>
## 1                   0                     0                  566            684
## 2                   0                     1                  118            684
## 3                   1                     0                  661           1466
## 4                   1                     1                  805           1466
## # ℹ 1 more variable: Proportion <dbl>

So how do we determine the optimal threshold? Loop over different choices!

threshRes <- NULL

for(thresh in seq(0,1,by = .05)) { # Loop over values between zero and one, increasing by 0.05
  tmp <- ad_analysis%>%
  mutate(preds = predict(m,type = 'response')) %>% # Predicting our new model
  mutate(pred_attend = ifelse(preds > thresh,1,0)) %>% # Plug in our threshold value
  group_by(yield)%>%
  mutate(total_attend=n())%>%
  group_by(yield,pred_attend)%>%
  summarize(n(),`Actual Group`=mean(total_attend),.groups = 'drop')%>%
  mutate(Proportion=`n()`/`Actual Group`)%>%
  rename(`Actually Attended`=yield,
         `Predicted to Attend`=pred_attend,
         `Number of Students`=`n()`) %>%
    mutate(threshold = thresh)
  
  threshRes <- threshRes %>% bind_rows(tmp)
}

threshRes %>%
  mutate(metric = ifelse(`Actually Attended` == 1 & `Predicted to Attend` == 1,'Sensitivity',
                         ifelse(`Actually Attended` == 0 & `Predicted to Attend` == 0,'Specificity',NA))) %>%
  drop_na() %>%
  ggplot(aes(x = threshold,y = Proportion,color = metric)) + 
  geom_line() + 
  geom_vline(xintercept = .67)

The optimal threshold is the one that maximizes Sensitivity and Specificity! (Although this is use-case dependent. You might prefer to do better on accurately predicting those who do attend than you do about predicting those who don’t.) In this case it is about 0.67.

The ROC curve

As the preceding plot makes clear, there is a trade-off between sensitivity and specificity. We can visualize this trade-off by putting 1-specificity on the x-axis, and sensitivity on the y-axis, to create the “Receiver-Operator Characteristic (ROC) Curve”.

threshRes %>%
  mutate(metric = ifelse(`Actually Attended` == 1 & `Predicted to Attend` == 1,'Sensitivity',
                         ifelse(`Actually Attended` == 0 & `Predicted to Attend` == 0,'Specificity',NA))) %>%
  drop_na() %>%
  select(Proportion,metric,threshold) %>%
  spread(metric,Proportion) %>% # Create two columns, one for spec, the other for sens
  ggplot(aes(x = 1-Specificity,y = Sensitivity)) + # X-axis is 1-Specificity
  geom_line() + 
  xlim(c(0,1)) + ylim(c(0,1)) + 
  geom_abline(slope = 1,intercept = 0,linetype = 'dotted') # The curve is always evaluated in reference to the diagonal line.

## Warning: Removed 7 rows containing missing values or values outside the scale range
## (`geom_line()`).

The idea is that a model that is very predictive will have high levels of sensitivity AND high levels of specificity at EVERY threshold. Such a model will cover most of the available area above the baseline of .5. A model with low levels of sensitivity and low levels of specificity at every threshold will cover almost none of the available area above the baseline of .5.

As such, we can extract a single number that captures the quality of our model from this plot: the “Area Under the Curve” (AUC). The further away from the diagonal line is our ROC curve, the better our model performs, and the higher is the AUC. But how to calculate the AUC? Thankfully, there is a helpful R package that will do this for us: tidymodels.

require(tidymodels)
roc_auc(data = ad_analysis %>%
  mutate(pred_attend = predict(m,type = 'response'), 
         truth = factor(yield,levels = c('1','0'))) %>% # Make sure the outcome is converted to factors with '1' first and '0' second!
  select(truth,pred_attend),truth,pred_attend)

## # A tibble: 1 × 3
##   .metric .estimator .estimate
##   <chr>   <chr>          <dbl>
## 1 roc_auc binary         0.742

Our curve covers almost 75% of the total area above the diagonal line. Is this good?

Just like with RMSE, you are primarily interested in the AUC measure to compare different models against each other.

But if you HAVE to, it turns out that – in general – interpreting AUC is just like interpreting academic grades:

Below .6= bad (F)

.6-.7= still not great (D)

.7-.8= Ok . .. (C)

.8-.9= Pretty good (B)

.9-1= Very good fit (A)

Quick Exercise 2: Rerun the model with sent_scores added: does it improve model fit?

# INSERT CODE HERE

Cross Validation

Just like RMSE calculated on the full data risks overfitting, AUC does also.

How to overcome? Cross validation!

set.seed(123)
cvRes <- NULL
for(i in 1:100) {
  # Cross validation prep
  inds <- sample(1:nrow(ad_analysis),size = round(nrow(ad_analysis)*.8),replace = F)
  train <- ad_analysis %>% slice(inds)
  test <- ad_analysis %>% slice(-inds)

  # Training models
  m1 <- glm(yield ~ sat,family = binomial(link = "logit"),train)
  
  # Predicting models
  toEval <- test %>%
    mutate(m1Preds = predict(m1,newdata = test,type = 'response'),
           truth = factor(yield,levels = c('1','0')))

  # Evaluating models
  rocRes <- roc_auc(data = toEval,truth = truth,m1Preds)
  cvRes <- rocRes %>%
    mutate(bsInd = i) %>%
    bind_rows(cvRes)
}

mean(cvRes$.estimate)

## [1] 0.7404506

Thinking About Policy Change in Admissions

Once we have a model that can predict an outcome, we can also run some simulations using our existing data to understand what would happen if we implemented different policies. In this class we’re going to go over how to generate predictions using hypothetical data at different levels of complexity. This is helpful to understand the implications of different models. It’s particularly helpful in the context of logistic regression, as the coefficients from a logistic regression are difficult to understand on their own. Once we feel like we have a handle on the relationship between the variables and the outcome, we can try changing policies to see what the new predictions might look like.

We’ll start by loading in our standard libraries, plus the modelr library, and getting the data set up.

library(modelr)
library(tidyverse)
library(tidymodels)

ad<-read_rds("https://github.com/rweldzius/PSC4175/raw/main/static/data/admit_data.rds")

Data Wrangling

ad<-ad%>%
  mutate(yield_f=as_factor(ifelse(yield==1,"Yes","No")))%>%
  mutate(yield_f=relevel(yield_f,ref="No"))%>%
    mutate(sat=sat/100,
         income=income/1000,
         distance=distance/1000,
         net_price=net_price/1000)

Settting the Model

Today I’m going to use a more fully specified logit model. We’ll include most of the variables in the dataset, then fit the model and take a look at the coefficients.

admit_formula <- as.formula(
                  "yield_f~
                          legacy+
                          visit+
                          registered+
                          sent_scores+
                          sat+
                          income+
                          gpa+
                          distance+
                          net_price")

Fit the Model

m <- glm(formula = admit_formula,
         family = binomial(link = 'logit'),
         data = ad)

## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred

tidy(m) # Easier to read regression output (same as summary(m))

## # A tibble: 10 × 5
##    term        estimate std.error statistic  p.value
##    <chr>          <dbl>     <dbl>     <dbl>    <dbl>
##  1 (Intercept)  -8.96     1.52       -5.89  3.87e- 9
##  2 legacy        0.514    0.153       3.35  8.11e- 4
##  3 visit         0.285    0.135       2.11  3.53e- 2
##  4 registered    0.461    0.132       3.50  4.64e- 4
##  5 sent_scores   0.730    0.179       4.08  4.48e- 5
##  6 sat          -0.0444   0.126      -0.352 7.25e- 1
##  7 income        0.0513   0.00311    16.5   3.10e-61
##  8 gpa           1.77     0.337       5.26  1.41e- 7
##  9 distance     -1.53     0.346      -4.41  1.04e- 5
## 10 net_price    -0.0559   0.00761    -7.35  1.93e-13

Current Institutional Policies

(This is a recap from lecture 1)

The institution is currently awarding need-based aid for families making less than $100,0000 on the following formula:

$need_aid=500+(income/1000-100)\*-425$

ad%>%
  ggplot(aes(x=income,y=need_aid))+
  geom_point()

The institution is currently awarding merit-based aid for students with SAT scores above 1250 on the following formula:

$merit_aid=500+(sat/10\*250)$

Translated, this means that for every 10 points in SAT scores above 1250, the student will receive an additional $250. So for a student with 1400 SAT, merit based aid will be : $500+ (1400/10 *250)= 500+140*250$

ad%>%
  ggplot(aes(x=sat,y=merit_aid))+
  geom_point()

Probability for a Specific Case

The first thing we’ll do is to generate a predicted probability of yield for a particular type of case. Let’s take a look at the predicted probability of enrolling for an individual who:

Is not a legacy (legacy=0)
Visited Campus (visit=1)
Registered on the college website (register=1)
Did not send scores in advance of applying (sent_scores=1)
Has an SAT score of 1400 (sat=14)
Has a family income of $95,000 (income=95)
Has a GPA of 3.9 (gpa=3.9)
Lives 100 miles from campus (distance=.1)
Net Price of 6,875

According to our policy, someone with this set of characteristics would receive

$need_aid=500+(income/1000-100)\*-425$= 2625 in need-based aid, and

$merit_aid=500+(sat/10\*250)$= 35,500 in merit based aid, so their net price would be:

45000-2625-35,500= 6,875

We will use the data_grid command. This command allows us to specify values of the covariates in a model so that we can then use these to get a predicted probability from the model.

hypo_data <- ad %>%
  data_grid(legacy=0,
            visit=1,
            registered=1,
            sent_scores=1,
            sat=14,
            income=95,
            gpa=3.9,
            distance=.1,
            net_price=6.875
            )

data.frame(prob_attend = predict(m,newdata = hypo_data,type="response")) %>%
  bind_cols(hypo_data)

##   prob_attend legacy visit registered sent_scores sat income gpa distance
## 1   0.9587473      0     1          1           1  14     95 3.9      0.1
##   net_price
## 1     6.875

Quick Exercise 3: What’s the probability that the same student would attend if we increased their net price by 10k?

# INSERT CODE HERE

Change in Probability for Two Cases

With the data_grid command, we can ask for results back for many combinations of values. Let’s check to see what happens in the above case if we compare individuals who did and did not send their scores.

hypo_data <- ad %>%
  data_grid(legacy=0,
            visit=1,
            registered=1,
            sent_scores=c(0,1),
            sat=14,
            income=95,
            gpa=3.9,
            distance=.1,
            net_price=6.875
            )

data.frame(prob_attend = predict(m,newdata = hypo_data,type="response")) %>%
  bind_cols(hypo_data)

##   prob_attend legacy visit registered sent_scores sat income gpa distance
## 1   0.9180167      0     1          1           0  14     95 3.9      0.1
## 2   0.9587473      0     1          1           1  14     95 3.9      0.1
##   net_price
## 1     6.875
## 2     6.875

Quick Exercise 4: What’s the difference in probability for students who did and didn’t visit campus

# INSERT CODE HERE

Using Default Values

One really powerful aspect of data_grid is that we don’t have to specify the value of every variable. Instead, we can use supply the model to data_grid and it will use the default values. Let’s say we just want a prediction for someone with mean or modal value for all of the characteristics. We can use data_grid with the model argument to get this:

hypo_data <- ad %>%
  data_grid(.model=m)

data.frame(prob_attend = predict(m,newdata = hypo_data,type="response")) %>%
  bind_cols(hypo_data)

##   prob_attend legacy visit registered sent_scores      sat   income      gpa
## 1   0.8655441      0     0          1           0 12.00089 99.71213 3.790439
##    distance net_price
## 1 0.1002338  14.10675

Quick Exercise 5: generate probabilities for individuals who are both at the mean or mode of all variables, but have a gpa of 3.5 and 3.9.

hypo_data <- ad %>%
  data_grid(.model=m,
            gpa=c(3.5,3.9))

data.frame(prob_attend = predict(m,newdata = hypo_data,type="response")) %>%
  bind_cols(hypo_data)

##   prob_attend gpa legacy visit registered sent_scores      sat   income
## 1   0.7936923 3.5      0     0          1           0 12.00089 99.71213
## 2   0.8865843 3.9      0     0          1           0 12.00089 99.71213
##    distance net_price
## 1 0.1002338  14.10675
## 2 0.1002338  14.10675

Probabilities Across a Range of Cases

The other thing we can do is to generate probabilities for a range of a continuous variable. The seq_range variable allows us to go from the minimum to the maximum of a given variable in a specified number of steps. Below I go from the minimum gpa to the maximum gpa in 100 steps, for both legacy and non-legacy students, with all other values held at their mean or mode.

hypo_data <- ad %>%
  data_grid(gpa = seq_range(gpa, n = 100),
            legacy=c(0,1),
            .model=m)

We can then plot that data as follows:

plot_data<-data.frame(prob_attend = predict(m,newdata = hypo_data,type="response")) %>%
  bind_cols(hypo_data)

plot_data%>%
ggplot(aes(x=gpa,y=prob_attend,color=as_factor(legacy)))+
  geom_line()+
  ylab("Prob(Attend)")

Quick Exercise 6: Plot the impact of changing distance across its range for those who have and haven’t visited campus

# INSERT CODE HERE

The above tools can allow us to think through the substantive importance of changes in the different variables. This is an important step in these kinds of models, where the coefficients aren’t directly interpretable.

Changing policy

AS we think about changing policy for the campus, we need to answer a series of questions about the key characteristics of the campus right now. Remember that for your assignment we want you to do the the four following things:

The college president and the board of trustees have two strategic goals:

Increase the average SAT score to 1300
Admit at least 200 more students with incomes less than $50,000
Don’t allow tuition revenues from first-year students to drop to less than $30 million
Keep the number of enrolled students between 1,450 and 1,550

So, what’s the average SAT score?

ad%>%
  filter(yield==1)%>%
  summarize(mean(sat))

##   mean(sat)
## 1  12.25941

Second, how many currently enrolled students come from families that make less than $50,000 a year?

ad%>%
  filter(yield==1,income<50)%>%
  count()

##    n
## 1 77

Someone alert Raj Chetty!

Next how much does the campus collect from first-year students in tuition revenue?

ad%>%
  filter(yield==1)%>%
  summarize(dollar(sum(net_price)))

##   dollar(sum(net_price))
## 1             $30,674.15

And how many students currently yield?

ad%>%
  filter(yield==1)%>%
  count()

##      n
## 1 1466

What we want to do now is to think about how changing policies might affect all four of these summary measures. Let’s think about changing our financial aid policy for students who sent scores.

data.frame(prob_attend = predict(m,type = 'response')) %>%
  bind_cols(ad)%>%
  mutate(pred_attend = ifelse(prob_attend > .5,1,0)) %>%
  group_by(sent_scores,pred_attend)%>%
  count()

## # A tibble: 4 × 3
## # Groups:   sent_scores, pred_attend [4]
##   sent_scores pred_attend     n
##         <dbl>       <dbl> <int>
## 1           0           0   627
## 2           0           1  1093
## 3           1           0    75
## 4           1           1   355

The model currently predicts that 355 of the 430 students who sent scores will enroll. What happens if we increase their net price by 5,000? I’m going to create a new version of our dataset, with net price increased by 5,000 (5) for everyone who sent scores.

ad_np<-ad%>%
  mutate(net_price=ifelse(sent_scores==1,
                              net_price+5,
                              net_price))

Then I can generate predictions from the dataset, and create a new variable for prob_attend which will classify our variable. Please note that this uses a threshold of .5 by default.

ad_np<-data.frame(prob_attend = predict(m,newdata = ad_np,type = 'response')) %>%
  mutate(pred_attend = ifelse(prob_attend > .5,1,0)) %>%
  bind_cols(ad_np)

How many students who sent scores are now predicted to yield?

ad_np%>%
  group_by(sent_scores,pred_attend)%>%
  count()

## # A tibble: 4 × 3
## # Groups:   sent_scores, pred_attend [4]
##   sent_scores pred_attend     n
##         <dbl>       <dbl> <int>
## 1           0           0   627
## 2           0           1  1093
## 3           1           0    92
## 4           1           1   338

So, we lost about 22 students by increasing the net price. On the other hand, we charged more to the students who did attend.

ad_np%>%
  filter(pred_attend==1)%>%
  summarize(dollar(sum(net_price)))

##   dollar(sum(net_price))
## 1             $31,264.66

Total revenues went up!

And what happened to overall enrollment?

ad_np%>%
  group_by(pred_attend)%>%
  count()

## # A tibble: 2 × 2
## # Groups:   pred_attend [2]
##   pred_attend     n
##         <dbl> <int>
## 1           0   719
## 2           1  1431

So, this policy decreased enrollment slightly, but raised 500,000 dollars. Worth it?

Quick Exercise 7: Decrease prices for everyone who lives more than 1500 miles away by 10,000 and summarize the impacts on the campus.

# INSERT CODE HERE

Confidence and Uncertainty

Mon, 01 Jan 0001 00:00:00 +0000

Uncertainty

When we calculate a summary statistic in univariate statistics, we’re making a statement about what we can expect to see in other situations. If I say that the average height of a cedar tree is 75 feet, that gives an expectation for the average height we might calculate for any given sample of cedar trees. However, there’s more information that we need to communicate. It’s not just the summary measure– it’s also our level of uncertainty around that summary measure. Sure, the average height might be 75 feet, but does that mean in every sample we ever collect we’re always going to see an average of 75 feet?

Motivating Question

We’ll be working with data from every NBA player who was active during the 2018-19 season.

Here’s the data:

require(tidyverse)
nba<-read_rds("https://github.com/rweldzius/PSC4175/raw/main/static/data/nba_players_2018.Rds")

This data contains the following variables:

Codebook for NBA Data

Name	Definition
namePlayer	Player name
idPlayer	Unique player id
slugSeason	Season start and end
numberPlayerSeason	Which season for this player
isRookie	Rookie season, true or false
slugTeam	Team short name
idTeam	Unique team id
gp	Games Played
gs	Games Started
fgm	Field goals made
fga	Field goals attempted
pctFG	Percent of field goals made
fg3m	3 point field goals made
fg3a	3 point field goals attempted
pctFG3	Percent of 3 point field goals made
pctFT	Free Throw percentage
fg2m	2 point field goals made
fg2a	2 point field goals attempted
pctFG2	Percent of 2 point field goals made
agePlayer	Player age
minutes	Minutes played
ftm	Free throws made
fta	Free throws attempted
oreb	Offensive rebounds
dreb	Defensive rebounds
treb	Total rebounds
ast	Assists
blk	Blocks
tov	Turnovers
pf	Personal fouls
pts	Total points
urlNBAAPI	Source url

We might be interested in a variety of questions:

Do certain colleges produce players that have more field goals? What about free throw percentage above a certain level? Are certain colleges in the east or the west more likely to produce higher scorers? How does this vary as a player has more seasons?

To answer these questions we need to look at the following variables:

Field goals
Free throw percentage above .25
Colleges
Player seasons
Region

For me, I’m most curious if the Eastern or Western conferences have different styles of play. In particular, I want to know if one conference fouls more than the other.

Continuous by Categorical

Recall that there are two conference in the NBA, eastern and western. Let’s take a look at the variable that indicates which conference the player played in that season.

nba%>%select(idConference)%>%
  glimpse()

## Rows: 530
## Columns: 1
## $ idConference <int> 2, 2, 2, 2, 1, 1, 2, 1, 1, 2, 2, 1, 2, 1, 1, 1, 1, 2, 2, …

It looks like conference is structured as numeric, but a “1” or a “2”. Because it’s best to have binary variables structured as “has the characteristic” or “doesn’t have the characteristic” we’re going to create a variable for western conference that’s set to 1 if the player was playing in the western conference and 0 if the player was not (this is the same as playing in the eastern conference).

nba<-nba%>%
  mutate(conference=ifelse(idConference==1,'West','East'))

Now that we’ve wrangled, let’s compare personal fouls among players in the east versus west conferences

nba %>%
  group_by(conference) %>%
  summarise(pf_mean = mean(pf,na.rm=T))

## # A tibble: 2 × 2
##   conference pf_mean
##   <chr>        <dbl>
## 1 East          98.0
## 2 West          96.1

Players in the Eastern conference have an average of 98 personal fouls in the 2018-2019 seasons, compared to players in the Western conference who only had 96.1 (on average).

But are these differences meaningful? Another way of expressing this is “how confident are we that they are significantly different?”

Statistical significance can be expressed in many different ways, but for now think of it as if you were an all-powerful deity who could see across a thousand universes. In how many of those universes would our conclusion that Eastern conference players commit more personal fouls be true?

This is all very heady, so let’s do something more mundane that winds up simulating this idea.

Sampling

We’re going to start by building up a range of uncertainty from the data we already have. We’ll do this by sampling from the data itself.

Let’s just take very small sample of players– 100 players– and calculate personal fouls for those in the Eastern and Western conferences. We are going to set.seed to ensure that we get the same/similar answers every time we run the “random number” generator.

set.seed(123)
sample_size<-100
nba%>%
  sample_n(size=sample_size, replace=TRUE) %>% ## Sample size is as set above.  Replacement is set to TRUE
  group_by(conference)%>% ## Group by the conference
  summarize(mean(pf)) ## calculate mean

## # A tibble: 2 × 2
##   conference `mean(pf)`
##   <chr>           <dbl>
## 1 East             96.9
## 2 West             86.6

An even bigger difference! Among this random sample of 100 players, there is more than a 10-personal foul difference between the East and the West!

If we think of this random sample as a proxy for an alternate universe, in this universe our conclusion is even stronger!

But what about a different universe?

And again:

nba%>%
  sample_n(size=sample_size, replace=TRUE) %>% ## Sample size is as set above.  Replacement is set to TRUE
  group_by(conference)%>% ## Group by the conference
  summarize(mean(pf)) ## calculate mean

## # A tibble: 2 × 2
##   conference `mean(pf)`
##   <chr>           <dbl>
## 1 East             100.
## 2 West             102.

Oh wait…this time the conclusion is reversed? In this simulated alternate universe, Western conference players had more personal fouls (102 versus 100). What should we therefore conclude?

These resamples on their own don’t appear to be particularly useful, but what would happen if we calculated a bunch (technical term) of them?

I can continue this process of sampling and generating values many times using a loop. The code below resamples from the data 1,000 times, each time calculating the mean personal fouls for Eastern and Western conference players in a sample of size 100. It then adds those two means to a growing list, using the bind_rows function. ## Warning: the code below will take a little while to run

bsRes<-NULL ##  Create a NULL variable: will fill this in later
for (i in 1:1000){ # Repeat the steps below 1000 times
  bsRes<-nba%>%
  sample_n(size=sample_size, replace=TRUE) %>% ## Sample 100 players
  group_by(conference)%>% ## Group by conference
  summarize(mean_pf=mean(pf))%>% ## Calculate mean personal fouls for Eastern and Western players
    mutate(bsInd = i) %>% ## Save the indicator for which random sample we are on
    bind_rows(bsRes) ## add this result to the existing dataset
}

Now I have a dataset that is built up from a bunch of small resamples from the data, with average personal fouls for Eastern and Western conference players in each small sample. Let’s see what these look like.

bsRes

## # A tibble: 2,000 × 3
##    conference mean_pf bsInd
##    <chr>        <dbl> <int>
##  1 East          84.4  1000
##  2 West          86.9  1000
##  3 East          91.5   999
##  4 West          93.2   999
##  5 East         102.    998
##  6 West          94.3   998
##  7 East         112.    997
##  8 West         102.    997
##  9 East         113.    996
## 10 West          94.5   996
## # ℹ 1,990 more rows

This is a dataset that’s just a bunch of means. We can calculate the mean of all of these means and see what it looks like:

bsRes%>%
  group_by(conference)%>%
  summarise(mean_of_means=mean(mean_pf))

## # A tibble: 2 × 2
##   conference mean_of_means
##   <chr>              <dbl>
## 1 East                97.6
## 2 West                96.4

So the average of these averages is actually pretty close to what we see in the actual data, right?

nba %>%
  group_by(conference) %>%
  summarise(mean_pf = mean(pf))

## # A tibble: 2 × 2
##   conference mean_pf
##   <chr>        <dbl>
## 1 East          98.0
## 2 West          96.1

Quick Exercise 1 Repeat the above, but do it for points scored.

# INSERT CODE HERE

Distribution of Resampled Means

That’s fine, but the other thing is that the distribution of those repeated samples will tell us about what we can expect to see in other, out of sample data that’s generated by the same process.

Let’s take a look at the distribution of personal fouls by conference:

bsRes%>%
  ggplot(aes(x=mean_pf,fill=conference))+
  geom_density(alpha=.3)

It’s pretty hard to tell if these are different, right?

So What? Using Percentiles of the Resampled Distribution

Now we can make some statements about uncertainty. Based on this, we can pretend to be all-powerful voyager across universes, and conclude that Eastern conference players commit more personal fouls.

The easiest way to do this is just to create a new variable that indicates whether the Eastern conference players had more personal fouls than the Western conference players in a given random sample. But currently, our data is organized in the “long” format, right?

bsRes

## # A tibble: 2,000 × 3
##    conference mean_pf bsInd
##    <chr>        <dbl> <int>
##  1 East          84.4  1000
##  2 West          86.9  1000
##  3 East          91.5   999
##  4 West          93.2   999
##  5 East         102.    998
##  6 West          94.3   998
##  7 East         112.    997
##  8 West         102.    997
##  9 East         113.    996
## 10 West          94.5   996
## # ℹ 1,990 more rows

We want to convert it to the “wide” format, which means that each row is a random sample simulation, and we have one column for the Eastern conference personal fouls, and one column for the Western conference personal fouls.

Let’s create this using either spread() or pivot_wider().

# Spread approach
bsRes %>%
  spread(conference,mean_pf)

## # A tibble: 1,000 × 3
##    bsInd  East  West
##    <int> <dbl> <dbl>
##  1     1 112.   92.3
##  2     2 110.   92.5
##  3     3  85.9 104. 
##  4     4 103.   93.2
##  5     5  93.5  79.5
##  6     6  94.2  98.0
##  7     7  93.8  94.1
##  8     8  94.6  89.9
##  9     9  91.8  79.8
## 10    10  92.0 101. 
## # ℹ 990 more rows

# Pivot-wider approach
bsRes %>%
  pivot_wider(names_from = 'conference',values_from = 'mean_pf')

## # A tibble: 1,000 × 3
##    bsInd  East  West
##    <int> <dbl> <dbl>
##  1  1000  84.4  86.9
##  2   999  91.5  93.2
##  3   998 102.   94.3
##  4   997 112.  102. 
##  5   996 113.   94.5
##  6   995 117.   84.6
##  7   994  92.5  92.3
##  8   993 106.   98.1
##  9   992 101.   85.5
## 10   991  97.2  99.7
## # ℹ 990 more rows

With the data organized in “wide” format, it is now trivial to calculate whether the Eastern players had more personal fouls than the Western players.

bsRes %>%
  pivot_wider(names_from = 'conference',values_from = 'mean_pf') %>%
  mutate(diff = East - West,
         EastMore = diff > 0)

## # A tibble: 1,000 × 5
##    bsInd  East  West   diff EastMore
##    <int> <dbl> <dbl>  <dbl> <lgl>   
##  1  1000  84.4  86.9 -2.47  FALSE   
##  2   999  91.5  93.2 -1.73  FALSE   
##  3   998 102.   94.3  7.53  TRUE    
##  4   997 112.  102.   9.75  TRUE    
##  5   996 113.   94.5 18.3   TRUE    
##  6   995 117.   84.6 32.8   TRUE    
##  7   994  92.5  92.3  0.235 TRUE    
##  8   993 106.   98.1  7.37  TRUE    
##  9   992 101.   85.5 15.9   TRUE    
## 10   991  97.2  99.7 -2.44  FALSE   
## # ℹ 990 more rows

Expressing confidence

To express our “confidence” in the conclusion that Eastern conference players made more personal fouls than Western conference players in the 2018-2019 season, we can simply calculate the proportion of the 1,000 simulated alternate universes in which this conclusion was true! To do this, we just take the overall average of our new column EastMore!

bsRes %>%
  pivot_wider(names_from = 'conference',values_from = 'mean_pf') %>%
  mutate(diff = East - West,
         EastMore = diff > 0) %>%
  summarise(conf = mean(EastMore))

## # A tibble: 1 × 1
##    conf
##   <dbl>
## 1 0.531

0.531. Or, approximately 53.1%. In other words, in the data, Eastern conference players committed more personal fouls in a little more than half of the 1,000 simulated realities.

How strong is our argument do you think? Typically social scientists adhere to a norm of at least 95% confidence before we feel comfortable defending our conclusion. Otherwise, how can we be certain that it’s not just a fluke of the data?

Try it yourself

Quick Exercise 2 How confident are you that Eastern conference players are better than Western conference players on each of these metrics?

Turnovers
Rebounds
Field goals

# INSERT CODE HERE

Confidence and Uncertainty

Mon, 01 Jan 0001 00:00:00 +0000

Motivation: How much do turnovers matter?

We’re going to work with a different dataset covering every NBA game played in the seasons 2016-17 to 2018-19. I’m interested in whether winning teams have higher or lower values of turnovers, and whether winning teams tend to more often make over 80 percent of their free throws.

library(tidyverse)

The Data

The data for today is game by team summary data for every game played from 2017 to 2019. Make sure to download the data (game_summary.Rds) and save to your data folder!

gms<-read_rds("https://github.com/rweldzius/PSC4175/raw/main/static/data/game_summary.Rds")
gms

## # A tibble: 7,380 × 16
##      idGame yearSeason dateGame   idTeam nameTeam locationGame   tov   pts  treb
##       <dbl>      <int> <date>      <dbl> <chr>    <chr>        <dbl> <dbl> <dbl>
##  1 21600001       2017 2016-10-25 1.61e9 Clevela… H               14   117    51
##  2 21600001       2017 2016-10-25 1.61e9 New Yor… A               18    88    42
##  3 21600002       2017 2016-10-25 1.61e9 Portlan… H               12   113    34
##  4 21600002       2017 2016-10-25 1.61e9 Utah Ja… A               11   104    31
##  5 21600003       2017 2016-10-25 1.61e9 Golden … H               16   100    35
##  6 21600003       2017 2016-10-25 1.61e9 San Ant… A               13   129    55
##  7 21600004       2017 2016-10-26 1.61e9 Miami H… A               10   108    52
##  8 21600004       2017 2016-10-26 1.61e9 Orlando… H               11    96    45
##  9 21600005       2017 2016-10-26 1.61e9 Dallas … A               15   121    49
## 10 21600005       2017 2016-10-26 1.61e9 Indiana… H               16   130    52
## # ℹ 7,370 more rows
## # ℹ 7 more variables: oreb <dbl>, pctFG <dbl>, pctFT <dbl>, teamrest <dbl>,
## #   second_game <lgl>, isWin <lgl>, ft_80 <dbl>

The codebook for this dataset is as follows:

Name	Description
idGame	Unique game id
yearSeason	Which season? NBA uses ending year so 2016-17 = 2017
dateGame	Date of the game
idTeam	Unique team id
nameTeam	Team Name
locationGame	Game location, H=Home, A=Away
tov	Total turnovers
pts	Total points
treb	Total rebounds
pctFG	Field Goal Percentage
teamrest	How many days since last game for team
pctFT	Free throw percentage
isWin	Won? TRUE or FALSE
ft_80	Team scored more than 80 percent of free throws

We’re interested in knowing about how turnovers tov are different between game winners isWin.

Continuous Variables: Point Estimates

gms%>%
  filter(yearSeason==2017)%>%
  group_by(isWin)%>%
  summarize(mean(tov))

## # A tibble: 2 × 2
##   isWin `mean(tov)`
##   <lgl>       <dbl>
## 1 FALSE        13.8
## 2 TRUE         12.9

It looks like there’s a fairly substantial difference– winning teams turned the ball over an average of 12.9 times, while losing teams turned it over an average of 13.8 times. One way to summarize this is that winning teams in general had one less turnover per game than losing teams.

What if we take these results and decide that these will apply in other seasons? We could say something like: “Winning teams over the course of a season will turn the ball over 12.9 times, and losing teams 13.8 times, period.” Well let’s look and see:

gms%>%
  filter(yearSeason==2018)%>%
  group_by(isWin)%>%
  summarize(mean(tov))

## # A tibble: 2 × 2
##   isWin `mean(tov)`
##   <lgl>       <dbl>
## 1 FALSE        14.1
## 2 TRUE         13.3

gms%>%
  filter(yearSeason==2019)%>%
  group_by(isWin)%>%
  summarize(mean(tov))

## # A tibble: 2 × 2
##   isWin `mean(tov)`
##   <lgl>       <dbl>
## 1 FALSE        13.9
## 2 TRUE         13.1

So, no, that’s not right. In other seasons winning teams turned the ball over less, but it’s not as simple as just saying it will always be the two numbers we calculated from the 2017 data.

What we’d like to be able to do is make a more general statement, not just about a given season but about what we can expect in general. To do that we need to provide some kind of range of uncertainty: what range of turnovers can we expect to see from both winning and losing teams? To do that we’re going to use some key insights from probability theory and statistics that help us generate estimates of uncertainty.

Quick exercise 1 Are winning teams in 2017 more likely to make more than 80 percent of their free throws?*

gms%>%
  filter(...)%>%
  group_by(...elt())%>%
  summarize(mean(...))

## Error in group_by(., ...elt()): '...' used in an incorrect context

Sampling

We’re going to start by building up a range of uncertainty from the data we already have. We’ll do this by sampling from the data itself.

Let’s just take very small sample of games– 100 games– and calculate turnovers for winners and losers. We are going to set.seed to ensure that we get the same/similar answers every time we run the “random number” generator.

set.seed(210916)
sample_size<-100
gms%>%
  filter(yearSeason==2017)%>% ## Filter to just 2017
  sample_n(size=sample_size, replace=TRUE) %>% ## Sample size is as set above.  Replacement is set to TRUE
  group_by(isWin)%>% ## Group by win/lose
  summarize(mean(tov)) ## calculate mean

## # A tibble: 2 × 2
##   isWin `mean(tov)`
##   <lgl>       <dbl>
## 1 FALSE        14.7
## 2 TRUE         12.9

And again:

gms%>%
  filter(yearSeason==2017)%>% ## Filter to just 2017
  sample_n(size=sample_size, replace=TRUE) %>% ## Sample size is as set above
  group_by(isWin)%>% ## Group by win/lose
  summarize(mean(tov)) ## calculate mean

## # A tibble: 2 × 2
##   isWin `mean(tov)`
##   <lgl>       <dbl>
## 1 FALSE        14.1
## 2 TRUE         13

Sometimes we can get samples where the winning team turned the ball over more! These reasmples on their own don’t appear to be particularly useful, but what would happen if we calculated a bunch (technical term) of them?

I can continue this process of sampling and generating values many times using a loop. The code below resamples from the data 1,000 times, each time calculating the mean turnovers for winners and losers in a sample of size 10. It then adds those two means to a growing list, using the bind_rows function. ## Warning: the code below will take a little while to run

gms_tov_rs<-NULL ##  Create a NULL variable: will fill this in later
for (i in 1:1000){ # Repeat the steps below 1000 times
  gms_tov_rs<-gms%>% ## Create a dataset called gms_tov_rs (rs=resampled)
  filter(yearSeason==2017)%>%  ## Just 2017
  sample_n(size=sample_size, replace=TRUE) %>% ## Sample 100 games
  group_by(isWin)%>% ## Group by won or lost
  summarize(mean_tov=mean(tov))%>% ## Calculate mean turnovers for winners and losers
    bind_rows(gms_tov_rs) ## add this result to the existing dataset
}

Now I have a dataset that is built up from a bunch of small resamples from the data, with average turnovers for winners and losers in each small sample. Let’s see what these look like.

gms_tov_rs

## # A tibble: 2,000 × 2
##    isWin mean_tov
##    <lgl>    <dbl>
##  1 FALSE     14.5
##  2 TRUE      13.7
##  3 FALSE     13.7
##  4 TRUE      12.8
##  5 FALSE     14.4
##  6 TRUE      12.3
##  7 FALSE     13.6
##  8 TRUE      13.2
##  9 FALSE     13.6
## 10 TRUE      11.4
## # ℹ 1,990 more rows

This is a dataset that’s just a bunch of means. We can calculate the mean of all of these means and see what it looks like:

gms_tov_rs%>%
  group_by(isWin)%>%
  summarise(mean_of_means=mean(mean_tov))

## # A tibble: 2 × 2
##   isWin mean_of_means
##   <lgl>         <dbl>
## 1 FALSE          13.8
## 2 TRUE           12.9

How does this “mean of means” compare with the actual?

gms%>%
  filter(yearSeason==2017)%>%
  group_by(isWin)%>%
  summarize(mean(tov))

## # A tibble: 2 × 2
##   isWin `mean(tov)`
##   <lgl>       <dbl>
## 1 FALSE        13.8
## 2 TRUE         12.9

Pretty similar! It’s what we would expect, really, but it’s super important. If we repeatedly sample from a dataset, our summary measures of a sufficiently large number of repeated samples will converge on the true value of the measure from the dataset.

Quick exercise 2 Repeat the above, but do it for Pct of Free Throws above .8.

gms_ft_80_rs<-NULL ##  Create a NULL variable: will fill this in later
for (i in 1:1000){ # Repeat the steps below 10,000 times
  gms_ft_80_rs<-gms%>% ## Create a dataset called gms_tov_rs (rs=resampled)
  filter(...)%>%  ## Just 2017
  sample_n(...) %>% ## Sample 100 games
  group_by(...)%>% ## Group by won or lost
  summarize(...)%>% ## Calculate mean turnovers for winners and losers
    bind_rows(...) ## add this result to the existing dataset
}

## Error in gms %>% filter(...) %>% sample_n(...) %>% group_by(...) %>% summarize(...) %>% : '...' used in an incorrect context

Distribution of Resampled Means

Let’s take a look at the distribution of turnovers for game winners:

gms_tov_rs%>%
  filter(isWin)%>%
  ggplot(aes(x=mean_tov,fill=isWin))+
  geom_density(alpha=.3)+
  geom_vline(xintercept =12.9)

We can see that the mean of this distribution is centered right on the mean of the actual data, and it goes from about 11 to about 15. This is different than the minimum and maximum of the overall sample, which goes from 3 to 24 (bad night).

gms_tov_rs%>%
  filter(isWin)%>%
  summarize(value=fivenum(mean_tov))%>%
    mutate(measure=c("Min","25th percentile","Median","75th percentile","Max"))%>%
  select(measure, value)

## # A tibble: 5 × 2
##   measure         value
##   <chr>           <dbl>
## 1 Min              11.4
## 2 25th percentile  12.6
## 3 Median           13.0
## 4 75th percentile  13.3
## 5 Max              14.5

So what this tells us is that the minimum turnovers for winners in all of the samples we drew was 11.4, the maximum was about 14.5 and the median was 13.0.

And for game losers, let’s look at the distribution.

gms_tov_rs%>%
  filter(!isWin)%>%
  ggplot(aes(x=mean_tov,fill=isWin))+
  geom_density(alpha=.3,fill="lightblue")+
    geom_vline(xintercept =13.8)

And now the particular values.

gms_tov_rs%>%
  filter(!isWin)%>%
  summarize(value=fivenum(mean_tov))%>%
    mutate(measure=c("Min","25th percentile","Median","75th percentile","Max"))%>%
  select(measure, value)

## # A tibble: 5 × 2
##   measure         value
##   <chr>           <dbl>
## 1 Min              12.3
## 2 25th percentile  13.5
## 3 Median           13.8
## 4 75th percentile  14.2
## 5 Max              15.9

For game losers, minimum turnovers for winners in all of the samples we drew was 12.3, the maximum was about 16 (!!) and the median was 13.8.

Quick exercise 3 Calculate the same summary, but do it for Pct of Free Throws above .8.

gms_ft_80_rs%>%
  filter(isWin)%>% # for those who won
  summarize(value=fivenum(mean_ft80))%>% ## Five number summary: described below
  mutate(measure=c("Min","25th percentile","Median","75th percentile","Max"))%>%
  select(measure, value)

## Error in UseMethod("filter"): no applicable method for 'filter' applied to an object of class "NULL"

gms_ft_80_rs%>% # now do the same for losers
  filter(...)%>%
  summarize(...)%>% ## Five number summary: described below
  mutate(...)%>%
  select(...)

## Error in gms_ft_80_rs %>% filter(...) %>% summarize(...) %>% mutate(...) %>% : '...' used in an incorrect context

So What? Using Percentiles of the Resampled Distribution

Now we can make some statements about uncertainty. Based on this what we can say is that in other seasons, we would expect that turnover for game winners will be in a certain range, and the same for game losers. What range? Well it depends on the level of risk you’re willing to take as an analyst. Academics (a cautious bunch to be sure) usually use the 5th percentile and the 95th percentile of the resampled values that were created.

So for game winners:

gms_tov_rs%>%
  filter(isWin)%>%
  summarize(pct_025=quantile(mean_tov,.025),
            pct_975=quantile(mean_tov,.975))

## # A tibble: 1 × 2
##   pct_025 pct_975
##     <dbl>   <dbl>
## 1      12    14.0

This tells us we can expect that game winners in future seasons will turn the ball over between about 12 and 14 times.

And how many times will their free throw percentage exceed 80%?

gms_ft_80_rs%>%
  filter(isWin)%>%
  summarize(pct_025=quantile(mean_ft80,.025),
            pct_975=quantile(mean_ft80,.975))

## Error in UseMethod("filter"): no applicable method for 'filter' applied to an object of class "NULL"

And for game losers

gms_tov_rs%>%
  filter(!isWin)%>%
  summarize(pct_05=quantile(mean_tov,.025),
            pct_95=quantile(mean_tov,.975))

## # A tibble: 1 × 2
##   pct_05 pct_95
##    <dbl>  <dbl>
## 1   12.8   14.9

This tells us that we can expect that game losers in future seasons will turn the ball over between … 12.8 and 14.9 times.

Don’t be disappointed! It just turns out that if we want to make accurate statements about out of sample data, we need to reflect our uncertainty.

Let’s check to see if our expectations are borne out in future seasons:

gms%>%
  filter(yearSeason==2018)%>%
  group_by(isWin)%>%
  summarize(mean(tov))

## # A tibble: 2 × 2
##   isWin `mean(tov)`
##   <lgl>       <dbl>
## 1 FALSE        14.1
## 2 TRUE         13.3

gms%>%
  filter(yearSeason==2019)%>%
  group_by(isWin)%>%
  summarize(mean(tov))

## # A tibble: 2 × 2
##   isWin `mean(tov)`
##   <lgl>       <dbl>
## 1 FALSE        13.9
## 2 TRUE         13.1

So, our intervals for both winners and losers did include the values in future seasons.

Other intervals– the tradeoff between a “precise” interval and risk

You may be underwhelmed at this point, because the 95 percent range is a big range of possible turnover values. We can use narrower intervals– it just raises the risk of being wrong. Let’s try the middle 50 percent.

gms_tov_rs%>%
  group_by(isWin)%>%
  summarize(pct_25=quantile(mean_tov,.25),
            pct_75=quantile(mean_tov,.75))

## # A tibble: 2 × 3
##   isWin pct_25 pct_75
##   <lgl>  <dbl>  <dbl>
## 1 FALSE   13.5   14.2
## 2 TRUE    12.6   13.3

Okay, now we’re saying that winners will have between 12.6 and 13.3 turnovers. Is that right?

gms%>%
  filter(yearSeason==2018)%>%
  group_by(isWin)%>%
  summarize(mean(tov))

## # A tibble: 2 × 2
##   isWin `mean(tov)`
##   <lgl>       <dbl>
## 1 FALSE        14.1
## 2 TRUE         13.3

gms%>%
  filter(yearSeason==2019)%>%
  group_by(isWin)%>%
  summarize(mean(tov))

## # A tibble: 2 × 2
##   isWin `mean(tov)`
##   <lgl>       <dbl>
## 1 FALSE        13.9
## 2 TRUE         13.1

Yes, this checks out for subsequent seasons. What about a really narrow interval– the middle 10 percent?

gms_tov_rs%>%
  group_by(isWin)%>%
  summarize(pct_45=quantile(mean_tov,.45),
            pct_55=quantile(mean_tov,.55))

## # A tibble: 2 × 3
##   isWin pct_45 pct_55
##   <lgl>  <dbl>  <dbl>
## 1 FALSE   13.8   13.9
## 2 TRUE    12.9   13.0

gms%>%
  filter(yearSeason==2018)%>%
  group_by(isWin)%>%
  summarize(mean(tov))

## # A tibble: 2 × 2
##   isWin `mean(tov)`
##   <lgl>       <dbl>
## 1 FALSE        14.1
## 2 TRUE         13.3

In 2018, winning teams turned the ball over 13.3 times, on average. That’s below the range we gave! If we used a 10 percent interval we’d be wrong. Similarly, in 2018 losing teams turned the ball over 14.1 times, again below our interval.

gms%>%
  filter(yearSeason==2019)%>%
  group_by(isWin)%>%
  summarize(mean(tov))

## # A tibble: 2 × 2
##   isWin `mean(tov)`
##   <lgl>       <dbl>
## 1 FALSE        13.9
## 2 TRUE         13.1

In 2019, winning teams turned the ball over 13.1 times, on average. That’s below the range we gave! If we used a 10 percent interval we’d be wrong, again.

It turns out that the way this method works is that for an interval of a certain range, the calculated interval will include the true value of the measure in the same percent of repeated samples. We can think of each season as a repeated sample, so the middle 95 percent of this range will include the true value in 95 percent of seasons. When we call this a confidence interval, we’re saying we have confidence in the approach, not the particular values we calculated.

The tradeoff here is between providing a narrow range of values vs. the probability of being correct. We can give a very narrow interval for what we would expect to see in out of sample data, but we’re going to be wrong– a lot. We can give a very wide interval, but the information isn’t going to be useful to decisionmakers. This is one of the key tradeoffs in applied data analysis, and there’s no single answer to the question: what interval should I use? Academic work has settled on the 95 percent interval, but there’s no real theoretical justification for this.

Empirical Bootstrap

What we just did is called the empirical bootstrap. It’s massively useful, because it can be applied for any summary measure of the data: median, percentiles, and measures like regression coefficients. Here is the summary of steps for the empirical bootstrap:

Decide on the summary measure to be used for the variable (it doesn’t have to be the mean)
Calculate the summary measure on a small subsample (called the bootstrap sample) of the data
Repeat step 2 many times (how many? Start with 1000, but more is better.) Compile the estimates.
Calculate the percentiles of the bootstrap distribution from the previous step.
Describe your uncertainty using those percentiles.

Quick exercise 4 Does 50 percent interval for free throws percent above 80 include the values for subsequent seasons?

gms_ft_80_rs%>%
  group_by(...)%>%
  summarize(pct_25=quantile(...),
           pct_75=quantile(...))

## Error in summarize(., pct_25 = quantile(...), pct_75 = quantile(...)): '...' used in an incorrect context

The middle 50% of this distribution is between .36 and .46.

And in the actual subsequent seasons

gms%>%
  filter(yearSeason==2018)%>%
  summarize(mean(ft_80))

## # A tibble: 1 × 1
##   `mean(ft_80)`
##           <dbl>
## 1         0.389

Yep, that checks out. And in 2019?

gms%>%
  filter(yearSeason==2019)%>%
  summarize(mean(ft_80))

## # A tibble: 1 × 1
##   `mean(ft_80)`
##           <dbl>
## 1         0.368

Again, yes but just barely.

Summarizing the Bootstrap

The goal is to repeatedly calculate a measure of interest on random samples of the data. There are two basic ways to do this, both of which use a loop.

Use a loop to generate 100 (or 1,000, or more) simulated datasets and then run the analysis on this massive object.
Use a loop to generate a single simulated dataset and run the analysis within the loop, saving only the measures of interest.

To demonstrate, we’re going to go back to the other NBA data.

nba <- readRDS('https://github.com/rweldzius/PSC4175/raw/main/static/data/nba_players_2018.Rds')

## Error in gzfile(file, "rb"): cannot open the connection

We want to know if players from Tennessee are better at shooting free throws than players from Virginia. If we look at the overall data, we can see that NBA players who graduated from Tennessee are better overall.

nba %>%
  filter(org %in% c('Tennessee','Virginia')) %>%
  group_by(org) %>%
  summarise(pctFT = mean(pctFT))

## Error: object 'nba' not found

So now let’s bootstrap this to express how confident we are in this conclusion.

Method 1: Big Dataset

set.seed(123)
bsSeasons <- NULL
for(bsSeason in 1:100) {
  tmpSeason <- nba %>%
    sample_n(size = nrow(.),replace = T) %>%
    select(org,pctFT) %>%
    mutate(bsSeasonNumber = bsSeason)
  bsSeasons <- bind_rows(bsSeasons,tmpSeason)
}

## Error: object 'nba' not found

nrow(bsSeasons)

## NULL

We have a huge dataset of 100 simulated seasons which we can now run our analysis on. First, let’s compare free throw shooting in each simulated season.

bsSeasons %>%
  filter(grepl('Tennessee|^Virginia',org)) %>% # Focus only on the schools of interest
  group_by(bsSeasonNumber,org) %>% # Group by the simulated season and the organization
  summarise(mean_ftp = mean(pctFT),.groups = 'drop') # Calculate average pctFT

## Error in UseMethod("filter"): no applicable method for 'filter' applied to an object of class "NULL"

In simulated seasons 1, 2, and 5 Tennessee grads are better shooters. However, in simulated seasons 3 and 4, Virginia grads have a better percentage!

But remember the question of interest – we want to calculate the difference in free throw percentage. To do this, we can use the spread() command to create one column for Tennessee and one column for Virginia

bsSeasons %>%
  filter(grepl('Tennessee|^Virginia',org)) %>%
  group_by(bsSeasonNumber,org) %>%
  summarise(mean_ftp = mean(pctFT),.groups = 'drop') %>%
  spread(org,mean_ftp) # Create two columns one for each school

## Error in UseMethod("filter"): no applicable method for 'filter' applied to an object of class "NULL"

Interestingly, in seasons 7 and 8 we **don’t have measures of Virginia free throw shooting! This is because we just happened not to sample any players from Virginia in these simulated seasons! We can drop these missing values and then use mutate() to create the difference between Virginia and Tennessee.

bsSeasons %>%
  filter(grepl('Tennessee|^Virginia',org)) %>%
  group_by(bsSeasonNumber,org) %>%
  summarise(mean_ftp = mean(pctFT),.groups = 'drop') %>%
  spread(org,mean_ftp) %>%
  drop_na() %>% # Drop any rows with missing data in any column
  mutate(TNDiff = Tennessee - Virginia) # Calculate the difference in free throw shooting between TN and VA

## Error in UseMethod("filter"): no applicable method for 'filter' applied to an object of class "NULL"

Values that are greater than zero indicate simulated seasons where Tennessee grads shot better, while values less than zero indicate simulated seasons where Virginia grads shot better. We can plot this as a distribution!

bsSeasons %>%
  filter(grepl('Tennessee|^Virginia',org)) %>%
  group_by(bsSeasonNumber,org) %>%
  summarise(mean_ftp = mean(pctFT),.groups = 'drop') %>%
  spread(org,mean_ftp) %>%
  drop_na() %>%
  mutate(TNDiff = Tennessee - Virginia) %>%
  ggplot(aes(x = TNDiff)) + # Plot the difference
  geom_density() + 
  geom_vline(xintercept = 0,linetype = 'dashed') # Add a vertical line for clarity

## Error in UseMethod("filter"): no applicable method for 'filter' applied to an object of class "NULL"

Our confidence is the proportion of times that Tennessee outshoots Virginia grads, or the proportion of the data that is to the right of zero (indicated with the vertical dashed line). We can calculate this proportion directly with a mean!

bsSeasons %>%
  filter(grepl('Tennessee|^Virginia',org)) %>%
  group_by(bsSeasonNumber,org) %>%
  summarise(mean_ftp = mean(pctFT),.groups = 'drop') %>%
  spread(org,mean_ftp) %>%
  drop_na() %>%
  mutate(TNDiff = Tennessee - Virginia) %>%
  mutate(TNBetter = ifelse(TNDiff > 0,1,0)) %>% # Create an indicator for whether TN did better
  summarise(mean(TNBetter))

## Error in UseMethod("filter"): no applicable method for 'filter' applied to an object of class "NULL"

The benefit of creating the huge dataset first and then analyzing it is that we can look at many different aspects of the data. We can calculate the overall confidence, or we can plot the distribution of the difference. We can even plot the two distributions for each school!

bsSeasons %>%
  filter(grepl('Tennessee|^Virginia',org)) %>%
  group_by(bsSeasonNumber,org) %>%
  summarise(mean_ftp = mean(pctFT),.groups = 'drop') %>%
  ggplot(aes(x = mean_ftp,fill = org)) + # Plot the difference
  geom_density(alpha = .3)

## Error in UseMethod("filter"): no applicable method for 'filter' applied to an object of class "NULL"

Method 2: Calculate within the loop

We could have instead calculated all this WITHIN each loop of the bootstrap.

set.seed(123)
bsRes <- NULL
for(counter in 1:100) {
  tmpEst <- nba %>%
    sample_n(size = nrow(.),replace = T) %>%
    filter(org %in% c('Tennessee','Virginia')) %>%
    group_by(org) %>%
    summarise(mean_FT = mean(pctFT,na.rm=T)) %>%
    ungroup() %>%
    spread(org,mean_FT) %>%
    mutate(bsSeason = counter)
  bsRes <- bind_rows(bsRes,tmpEst)
}

## Error: object 'nba' not found

Then we can plot and calculate without having to do the analysis.

bsRes %>%
  drop_na() %>%
  summarise(mean(Tennessee > Virginia)) # NOTE: You can calculate the average of TRUE/FALSE logic and R will know to treat it as a 1/0 number.

## Error in UseMethod("drop_na"): no applicable method for 'drop_na' applied to an object of class "NULL"

bsRes %>%
  drop_na() %>%
  mutate(TNDiff = Tennessee - Virginia) %>%
  ggplot(aes(x = TNDiff)) + 
  geom_density() + 
  geom_vline(xintercept = 0,linetype = 'dashed')

## Error in UseMethod("drop_na"): no applicable method for 'drop_na' applied to an object of class "NULL"

We can use the gather() command to get the overlapping plot as well.

bsRes %>%
  drop_na() %>%
  gather(org,mean_ft,-bsSeason) %>%
  ggplot(aes(x = mean_ft,fill = org)) + 
  geom_density(alpha = .3)

## Error in UseMethod("drop_na"): no applicable method for 'drop_na' applied to an object of class "NULL"

Quick exercise 5 Which team has the highest free throw percentage? How confident are you?

# INSERT CODE HERE

Your Turn! Bootstrapping with your data

“Quick” exercise 6: Use your own dataset to bootstrap a 95% CI for the mean of one variable. Plot the bootstrap distribution and mark the sample mean. Write 2–3 sentences interpreting the interval.

# Require libraries; load data

# Wrangle data (if needed); perhaps you want a binary variable to plot (i.e., a variable that equals 1 or 0.)

# Bootstrap time! Don't forget to use set.seed(). Pro-tip: copy/paste from above and change the names of the dataframe and variable of interest.

# Plot your bootstrap distribution. Don't forget to mark the sample mean!

Data Visualization

Mon, 01 Jan 0001 00:00:00 +0000

Learning Objectives

Visualizing data in ggplot
Functions: ggplot,
Applications: College data

Agenda

Visualization is one of R’s most impressive features, and arguably where it surpasses other competing programs like Python. Visualization can either be done in “base” R, or via a powerful set of functions included in the ggplot package. In this class, we will be working exclusively in ggplot, which is included in the tidyverse package.

Let’s start by loading our college data again.

Load relevant libraries

library(tidyverse)

Load The Data

Once tidyverse is loaded, you can download the data directly from GitHub using the read_rds() function. You should then open it in R by assigning it to an object with the <- command.

df<-read_rds("https://github.com/rweldzius/PSC4175/raw/main/static/data/sc_debt.Rds") 
names(df)

##  [1] "unitid"         "instnm"         "stabbr"         "grad_debt_mdn" 
##  [5] "control"        "region"         "preddeg"        "openadmp"      
##  [9] "adm_rate"       "ccbasic"        "sat_avg"        "md_earn_wne_p6"
## [13] "ugds"           "costt4_a"       "selective"      "research_u"

`ggplot`

ggplot works in layers, where the most simple layer is contained in the ggplot() function itself. Here, you set the x and y axes with a function called aes() (for the plot “aesthetics”). The primary inputs to aes() are x and y, although you can also set things like color and fill here.

Let’s create the first layer of our plot by using the %>% function to link our data with the ggplot() function.

df %>%
  ggplot(aes(x = adm_rate,y = sat_avg))

This gives us a rather ugly looking graph box (see the bottom right quadrant of RStudio), where we see the admissions rate on the x-axis (the horizontal axis) and the SAT scores on the y-axis (the vertical axis). However, there are no visuals like lines or bars or points to help us actually SEE the data. We know that ggplot has them on the axes we specified, but we haven’t drawn anything yet.

The next step is to add a “layer” to this plot that contains the visuals we want. To add a layer, we use the + sign to link our blank canvas to the function to draw the graph. In this situation, we are going to create a scatterplot using the function named geom_point(). (There are many other functions that are included with ggplot which will draw different plots…geom_line() and geom_bar() for example.)

df %>%
  ggplot(aes(x = adm_rate,y = sat_avg)) + 
  geom_point()

Tweaking Visuals

We have a visualization of our data! It suggests that there is a negative relationship between the admissions rate and SAT scores. When the admissions rate is very low (i.e., when schools are very selective), the average SAT scores of their students is above 1500 (top left part of the graph). When the admissions rate is very high, the average SAT scores is around 1000 (bottom right of the graph). Why might this be?

We can easily see this pattern just by looking at the data. However, we can make it even more clear by overlaying a “line of best fit” using a different function called geom_smooth(). This is going to be our second layer, meaning we need another + sign to link the function.

df %>%
  ggplot(aes(x = adm_rate,y = sat_avg)) + 
  geom_point() + 
  geom_smooth()

The default behavior of geom_smooth() is to draw a slightly curvy line that bends. This is potentially useful, since it reveals that the negative relationship between the admissions rate and the SAT scores is stronger among more selective schools (i.e., those with an admissions rate less than 0.50 or 50%), but almost flat among less selective schools.

However, if all we want is the overall relationship drawn with a straight line, we need to tell geom_smooth() to draw a straight line with the input method = "lm". (“lm” stands for “linear model”, a topic we will come back to later in the semester.)

df %>%
  ggplot(aes(x = adm_rate,y = sat_avg)) + 
  geom_point() + 
  geom_smooth(method = 'lm')

Colors

We can continue to tweak this plot by changing the colors of the points. For example, we could color EVERY point red as follows

df %>%
  ggplot(aes(x = adm_rate,y = sat_avg)) + 
  geom_point(color = 'red')

However, we could instead color points based on their value. To do so, we want to move the color input inside the aes() function, and set it equal to the variable we want to visualize with color.

df %>%
  ggplot(aes(x = adm_rate,y = sat_avg,
             color = region)) + 
  geom_point()

We now have a legend added to the plot that tells us what each color refers to. In this example, we set the color equal to a categorical variable. We could instead set it equal to a continuous variable, which would give us a gradient.

df %>%
  ggplot(aes(x = adm_rate,y = sat_avg,
             color = md_earn_wne_p6)) + 
  geom_point()

Here we see two patterns. First, we continue to see the negative relationship between the admissions rate and the SAT scores. Second, we can kinda see a relationship between future wages of graduates and their SAT scores.

If we don’t like the default choice of dark to light blue, we can modify this with scale_color_gradient(). As always, add another + to add the layer to the plot!

df %>%
  ggplot(aes(x = adm_rate,y = sat_avg,
             color = md_earn_wne_p6)) + 
  geom_point() + 
  scale_color_gradient(low = 'grey90',high = 'darkred')

Note that some of the points are dark gray. These are schools that don’t report the median earnings of their recent graduates. These missing data default to a dark gray color. You can find more colors in the R color palette here: https://r-graph-gallery.com/color-palette-finder.

Quick Exercise Re-do this plot but put md_earn_wne_p6 on the y-axis, and sat_avg on the x-axis. Is there a relationship between SAT scores and earnings? Why might this be the case?

# INSERT CODE HERE

Write your answer to the questions here.

Other Aesthetics

We can also change the size of the points with the size input. As with color, this can either be set uniformly for all points, or we can make the size a function of another variable.

df %>%
  ggplot(aes(x = adm_rate,y = sat_avg)) + 
  geom_point(size = 3) + 
  labs(title = 'Uniform Size Setting for all points')

df %>%
  ggplot(aes(x = adm_rate,y = sat_avg,
             size = md_earn_wne_p6)) + 
  geom_point() + 
  labs(title = 'Sized by the future earnings')

Transparency

With so many points overlapping, especially with larger points, it becomes harder for the reader to see details. We can therefore adjust the transparency of these points with the alpha parameter, which can be a value between 0 and 1. Values closer to zero make the points more transparent, while values closer to 1 make them more opaque.

df %>%
  ggplot(aes(x = adm_rate,y = sat_avg,
             size = md_earn_wne_p6)) + 
  geom_point(alpha = .3) + 
  labs(title = 'Sized by the future earnings')

Other Types of Plots

This topic is very deep and you can spend years becoming an R expert and still find new ways of visualizing things. I encourage you to keep this link bookmarked: http://r-statistics.co/Complete-Ggplot2-Tutorial-Part1-With-R-Code.html.

For now though, a few other types of plots:

Histograms & Densities

For visualization of a single measure (what we often call a univariate plot), a histogram is often useful. Here, we only need to set the x-axis variable. The geom_histogram() function will calculate the y-axis values for us, which is the number of schools falling into each bin. If we add all the bins together, we get the total number of schools in the data.

df %>%
  ggplot(aes(md_earn_wne_p6)) + 
  geom_histogram()

We can also get the same result with a density plot, which replaces the histogram with a line. The y-axis becomes the fraction of schools at each point on the x-axis, and adds up to 1.

df %>%
  ggplot(aes(x = md_earn_wne_p6)) + 
  geom_density()

Barplots

Barplots are another common type of data visualization. These are more appropriate for categorical data, or for types of continuous data where there are only a handful of distinct values.

df %>%
  ggplot(aes(x = region)) + 
  geom_bar()

Your final research project

It’s time to start thinking about your final project for this course! The project will be worth 20 points (write-up 15 points, presentation and comments 5 points), which means 20% of your final grade. You will need to come up with an interesting research question, find a dataset that will help you answer that question, and then åpply the tools from this course to that data. Students may work individually, or can work in groups of up to 3 students. I will include short assignments along the way so that you are incrementally working on and completing your project. My goal is for you all to get the full 20 points on this project!

Your first Research Exercise will be to provide me with two ideas for research questions. After each, please provide an explanation as to why you are interested in this topic and/or why you find it interesting (the “so what” question).

Research Question 1

Research Question 2

Data Wrangling

Mon, 01 Jan 0001 00:00:00 +0000

Learning Objectives

Review: how to get data into R?
What is “wrangling” and how do we do it?
Fun with pipes in R: %>% (“and then”)
Functions: filter , select , mutate , summarize, arrange, count
Applications: 2020 National Election Poll Michigan Exit Poll

Data Wrangling?

We Need a Horse, Lasso

Data Wrangling: The process of getting the data ready for analysis, including: accessing data, reformatting in appropriate ways (format, orientation), creating variables, recoding values, and selecting variables and/or observations of interest for analysis.

How you process and recode data is critical! Principles that should guide us include:

Replication: Can others do what you did? Art depends on personality, science depends on replication.
Understanding: Can others understand what you did and why? Can you follow what you did if you come back to the code in a year?

We want to do things that are understandable and sensible. Always imagine that you are handing the code off to someone else – can they understand what you are doing? Can they follow what you have done to the data? The goal in data wrangling is to provide a set of steps that will take you from the raw data to the data being analyzed in clear and understandable steps so that others can see exactly the choices that you have made (and make other choices if desired to see the robustness of your inferences).

Robustness: Does your code “break” easily? You cannot (easily) fix in your analysis what you screw up in your data! (Especially if you are unaware!)

Data wrangling in R gives us the ability to do this because we can document and explain the exact steps we are taking to organize the data. Using code to make changes means anyone and everyone can observe what we did.

Don’t Be This Guy

In contrast, if you make changes to your data in a spreadsheet like Excel or Google Sheets or Numbers it can be impossible for someone else to figure out what you did. What variables did you rename, what transformations did you do, how did you recode values?

People using Excel for analysis have been identified as being (partially) responsible for what is widely believed to be a failed global economic policy.

Source of many, many errors: World Economy

And using Excel for data entry has resulted in well-documented errors in Medical Research due to “auto-correct” changing value names.

Source of many, many errors: Medical Research

In fact, Dr. Jennifer Byrne - named a top 10 person in science in 2017 because of her data sleuthing in 2017 has developed an entire program to find and correct errors produced by data entry in Excel! Link here.

Dr. Byrne, Cancer Researcher, Data Detective

So the goal of this topic is to give you some basic tools to be able to manipulate data and get it ready for analysis. This includes inspecting your data and getting a sense of the type of data you have.

RECAP: Starting out

When you start out (in this class) it is always a good idea to have a clean – i.e., empty – workspace so that your analysis is based on the code that you are doing rather than some manipulations that were done previously. Do not be one of those students at the end of the class who has every dataset they worked with in class saved and loaded in their Environment.

If you are starting out with an empty workspace your R Studio should say the “Environment is empty” in the Environment tab. it is always a good idea to always start with an empty environment because the data manipulations we are doing will not be cumulative.

Starting Out

To that end, when you quit RStudio, DO NOT save workspace image. This will ensure that you are always starting with a clean and empty workspace which means that there is never a possibility of using “old” data in your analyses. If you are working on a larger project across several sessions it sometimes makes sense to save it, but for this class you should get in the practice of writing self-contained code that reads and wrangles the data you need to analyses every time rather than relying on earlier work.

DO NOT SAVE YOUR WORKSPACE WHEN YOU EXIT

When starting out it can be easy to forget that R needs to be told where to look to find things!

For every assignment/lecture create a new folder on your computer (e.g., “Topic 3”).
Download the code and data into this folder. (Or move them from the Download folder to that folder). Or create a new RMarkdown file and save the code to this folder.
In the Console window of RStudio figure out where R thinks it is by looking at the title bar or using getwd (get working directory)!

getwd()

## [1] "/Users/rweldziu/Library/CloudStorage/Dropbox/Villanova/TEACHING/PSC4175 - Data Science/PSC4175/content/homeworks"

If this is different than where your code and data is there will be trouble!

Because R is object-oriented, we can actually save this as an object and use it!

mydir <- getwd()

Manually set the working directory to be the directory where your code and data is located using setwd (set working directory) and the location we just saved to the object mydir!

setwd(mydir)

We can also use RStudio to accomplish the same task.

Open your code in R-Studio.
Using the GUI to Select Directory
The GUI will automatically change the directory, but you should also copy and paste the resulting code snippet in Console to your code!

Warning!

What R “sees” when working in the Console window (or using an R Script) is different from what it “sees” using RMarkdown! You can Knit a RMarkdown document to conduct analysis without any object ever appearing in the Global Environment.

Knitting RMarkdown (*.RMD) files does not create tibbles/objects in the Global Environment!

Quick Exercise 1 (not graded) Clear out the Global Environment and Knit this document. Confirm that the code will run and nothing will be created in the Global Environment.

While this makes sense once the code/project is completed, it can make coding more difficult because we often want to be able to manipulate the code and objects while working. To do so we are going to write and evaluate chunks one-at-a-time to ensure the objects are created in the Global Environment.

So getting started we always start our code by:

Loading the tidyverse library and any other libraries we are going to use.

library(tidyverse)

Checking to sure that R is looking in right spot to find your data and code. It typically makes sense to setwd to tell R where in your computer it should be looking for additional data (and code). Remember, your working directory (wd) will be different than mine!

getwd()
setwd("~/Library/CloudStorage/Dropbox/Villanova/TEACHING/PSC4175 - Data Science/PSC4175/content/homeworks")

Now get that data! One method is to use the Graphical User Interface (GUI) to select menus that will find and read in the data of interest. If you are getting data from some other format (e.g., data saved in a basic text format (comma or tab delimted) or in another statistical package (e.g., STATA or SAS)) we want to Import Dataset.

RStudio Starting Out

If you are loading in data that is already formatted in R then you go to the RStudio menu: File > Open File.... (Note that this menu also has the File > Import Dataset option.)

Because we want to document what dataset we are using, for replicability we want to copy and paste the resulting code into our RMarkdown file so that next time we can run the code directly!

A second way to access data is to use some functions directly in R. This is what the GUI is actually doing behind the scenes. We are going to focus on three functions in this class: - load - read_rds - url

A tidyverse function we will sometimes use is read_rds (Read R Data Structure). This will load a single object into memory. Here we are reading in a subset of the 2020 Michigan Exit Poll and naming it the tibble mi_ep. You should download this data and load it directly from your computer by removing the url link below and inserting your own file path.

mi_ep <- read_rds("../../static/data/MI2020_ExitPoll_small.rds")

The first part of the code is defining a new object called mi_ep (short for Michigan exit poll) and then assigning (<-) that object to be defined by the dataset being read in by the read_rds function. The filepath within read_rds starts with “..” which tells R to go back one folder from your current working directory. Here I have “..” twice which means go back two folders and then find the folder static and then the folder data, and finally read in the MI2020_ExitPoll_small.rds file. If you haven’t saved the MI2020_ExitPoll_small.rds to your data folder and set your working directory (as explained above) then this chunk of code won’t work. Go back and make adjustments as needed.

To highlight the syntax, consider what happens when you run the following code?

read_rds("../../static/data/MI2020_ExitPoll_small.rds")

If we read in data without assigning it to an object R will simply print the results to the console window. Nothing will be saved and we cannot use the data in future analyses! When reading in an R data object using read_rds we always need to define a new object associated with that file!

Before moving on, let’s clean up our Environment – always a good idea between lectures and assignments! – using either the broom icon in the Environment GUI to delete every object or the rm (remove) command to remove specific objects. Since we only have one object in our Environment so far we can use rm to remove it.

rm(mi_ep)

A nice thing about R is that it can have multiple objects in the Global Environment at the same time. This allows you to work with multiple datasets and objects. Instead of loading them all into memory one at a time using read_rds, we can also use the load function to load several R objects that have been saved into a single file (using the save function) all at once.

In the file named MI2020_ExitPoll.Rdata I have previously saved the entire 2020 Michigan Exit Poll (the object named MI_final) as well as a subset of the exit poll that focuses on variables we are going to analyze in class (named MI_final_small). To give you a chance to do your own analyses, I have saved both files together so you can access either one.

Note that when we are loading an .Rdata file we do not need to assign it to an object because the objects are already defined within the .Rdata object. You can see this when you use the objects function to print to the console window the objects that are loaded into memory (which will also match the Global Environment list when we run the code chunk-by-chunk).

Quick Exercise 2 Save the MI2020_ExitPoll.Rdata” file and load as I have done below. In my code, notice how I use “../” in the file path. Each time I use that, it means “go back one folder”. Since I used it twice, the file path goes back two folders and then looks for the folder “static”. See if you can make it work on your code! (You won’t necessarily have a folder named “static”; this is to help me orgranize the GitHub repository and this webpage). Because we are loading several objects at once the name of the file will not be the same as the name of the objects being loaded.

load(file = "../../static/data/MI2020_ExitPoll.Rdata") 
objects()

## [1] "MI_final"       "MI_final_small" "mydir"

NOTE: R will look for this file relative to where it is (as is given by getwd). Here I have created a data folder located within the current directory and telling R to look for my data in that folder!

We can also read in non-R files. For example, we can read in comma-delimited files (read.csv), tab-delimited files (read.delim), Excel-created files (read.xls, read.xlsx), and files from other statistical languages (e.g., read.dta, read.sav). Reading in non-R objects/data requires reading in the data and also assigning the data to a new R object.

Trouble with tibbles?

Data objects in tidyverse are called tibbles. Why? As with most things, it seems Twitter is to blame…

Tibble?

tibbles can be thought of as a matrix with rows and columns and we can extract the dimensions of the data using the dim (dimensions) command where the output is a vector of length two consisting of the number of rows – here 1231 and then the number of columns 14.

dim(MI_final_small)

## [1] 1231   14

In most of the work that we will do in DSCI 1000 rows typically refer to observations – e.g., survey respondents – and columns refer to characteristics of those observations (e.g., survey responses) which we call variables.

We can use matrix indexing to examine/extract specific rows and columns of tibbles/dataframes. To select the first three rows we would use:

MI_final_small[1:3,]

## # A tibble: 3 × 14
##     SEX AGE10 PRSMI20 PARTYID WEIGHT QRACEAI EDUC18  LGBT BRNAGAIN LATINOS
##   <dbl> <dbl>   <dbl>   <dbl>  <dbl>   <dbl>  <dbl> <dbl>    <dbl>   <dbl>
## 1     2     2       1       3  0.405       1      4    NA       NA       2
## 2     2    10       1       1  1.81        2      1     2        1       2
## 3     2     7       1       1  0.860       1      5     2        2       2
## # ℹ 4 more variables: RACISM20 <dbl>, QLT20 <fct>, preschoice <chr>,
## #   Quality <chr>

To select the first three columns…

MI_final_small[,1:3]

## # A tibble: 1,231 × 3
##      SEX AGE10 PRSMI20
##    <dbl> <dbl>   <dbl>
##  1     2     2       1
##  2     2    10       1
##  3     2     7       1
##  4     1     9       1
##  5     2     8       1
##  6     2     7       1
##  7     1     9       1
##  8     1     8       1
##  9     2     6       2
## 10     1     8       1
## # ℹ 1,221 more rows

Selecting the first two rows and first four columns

MI_final_small[1:2,1:4]

## # A tibble: 2 × 4
##     SEX AGE10 PRSMI20 PARTYID
##   <dbl> <dbl>   <dbl>   <dbl>
## 1     2     2       1       3
## 2     2    10       1       1

Selecting a collection/combination of rows and all columns we would use:

MI_final_small[c(1:2,45,100),]

## # A tibble: 4 × 14
##     SEX AGE10 PRSMI20 PARTYID WEIGHT QRACEAI EDUC18  LGBT BRNAGAIN LATINOS
##   <dbl> <dbl>   <dbl>   <dbl>  <dbl>   <dbl>  <dbl> <dbl>    <dbl>   <dbl>
## 1     2     2       1       3  0.405       1      4    NA       NA       2
## 2     2    10       1       1  1.81        2      1     2        1       2
## 3     2     7       1       3  0.488       1      3    NA       NA       2
## 4     2    10       2       4  0.299       1      2     2        1       2
## # ℹ 4 more variables: RACISM20 <dbl>, QLT20 <fct>, preschoice <chr>,
## #   Quality <chr>

Outline for the Next Few Lectures

Introduce some basic tools and techniques to answer a series of questions relevant for politics, political science, society, etc.
Think about the data we have available data and its’ limitations!
Enable you to be the next political-media star.

2020 MI Exit Poll

To do our data wrangling we are going to wrangle the 2020 National Exit Poll from the National Election Pool in the state of Michigan.

We are going to use the actual data we got on Election Night!
To answer some of the same questions we were answering.
But not much has been cleaned up since then so lots of work to do! (Ugh…)

Exit Polls in US Elections

Exit polls are polls that are done on (or immediately before) elections in the United States. They are used to help interpret the meaning of an election – i.e., why voters voted the way they did, whether some types of voters were more likely to support one candidate over the other, etc. – but intelligent prognosticators do not use them to actually project who is going to win. Put differently, they are used to help intepret an election, but they are not used to predict it (which is what voting data is used for).

Filling Out an Exit Poll

In class we are goign to focus on an Exit Poll from the National Election Pool for the state of Michigan. Michigan is increasingly thought of as a ``swing state” that could be won by either a Democrat or a Republican in a presidential contest following is surprising support for President Trump in the 2016 presidential election. Michigan is also a rather diverse state in terms of its population and interests and some have worked to identify groups of like-minded voters within the state. (Note that we will also do this when we get to the “clustering” topic!)

Why Michigan?

The Exit Poll data we will analyze is based on the following questionaire that reports the precise questions that were asked, as well as the value labels associated with each response. So while the data that we will read in will have responses that are coded as a “1” or “3” or “4”, interpreting the meaning of those values requires comparing the values to the questions below.

2020 MI Exit Poll

Lots of interesting questions!

Predictive: Use the data to predict an outcome of interest.

How many voters report voting for Biden vs. Trump?
What predicts who supports Trump? And Biden?

Descriptive: Use the data to describe an event.

How did the support for Trump and Biden vary by: gender? race? age? education?
When did they make up their minds?
Why did voters choose to vote for Trump? Or Biden?
How do Trump and Biden voters vary in their opinions toward: COVID? Race relations?

THINKING: Is any of it causal? Can we determine what causes a voter to support a candidate from this data?

Whenever we do anything using data we should first inspect our data to make sure it makes sense. The function glimpse gives us a quick summary by printing the first few observations of every variable to the screen. Note that the presentation of the data is flipped (technically transposed) so that the columns are presented as rows.

glimpse(MI_final_small)

## Rows: 1,231
## Columns: 14
## $ SEX        <dbl> 2, 2, 2, 1, 2, 2, 1, 1, 2, 1, 1, 1, 2, 1, 1, 2, 1, 1, 1, 2,…
## $ AGE10      <dbl> 2, 10, 7, 9, 8, 7, 9, 8, 6, 8, 9, 10, 1, 5, 9, 10, 8, 4, 1,…
## $ PRSMI20    <dbl> 1, 1, 1, 1, 1, 1, 1, 1, 2, 1, 2, 2, 1, 2, 1, 1, 2, 1, 1, 1,…
## $ PARTYID    <dbl> 3, 1, 1, 3, 3, 3, 1, 1, 2, 1, 3, 2, 4, 4, 1, 1, 3, 3, 3, 1,…
## $ WEIGHT     <dbl> 0.4045421, 1.8052619, 0.8601966, 0.1991648, 0.1772090, 0.49…
## $ QRACEAI    <dbl> 1, 2, 1, 1, 1, 1, 1, 1, 1, 2, 9, 1, 1, 1, 1, 1, 3, 1, 1, 1,…
## $ EDUC18     <dbl> 4, 1, 5, 4, 5, 3, 3, 3, 4, 4, 5, 5, 4, 1, 1, 1, 5, 2, 4, 2,…
## $ LGBT       <dbl> NA, 2, 2, NA, NA, 2, 2, 2, NA, NA, NA, NA, NA, 2, NA, 2, 2,…
## $ BRNAGAIN   <dbl> NA, 1, 2, NA, NA, 2, 1, 2, NA, NA, NA, NA, NA, 2, NA, 2, 1,…
## $ LATINOS    <dbl> 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 1, 2, 2, 2,…
## $ RACISM20   <dbl> NA, 2, 2, NA, NA, 2, 2, 2, NA, NA, NA, NA, NA, 2, NA, 9, 4,…
## $ QLT20      <fct> Has good judgment, NA, NA, Has good judgment, Cares about p…
## $ preschoice <chr> "Joe Biden, the Democrat", "Joe Biden, the Democrat", "Joe …
## $ Quality    <chr> "Has good judgment", NA, NA, "Has good judgment", "Cares ab…

This is a useful representation as we can immediately see what variables we have as well as what some of the values are. Here, for example, we see that we have missing data – denoted as NA in R - in quite a few variables. We also see that some variables have numbers for values while others have strings of letters (e.g., QLT20, preschoice).

This variation highlights the fact that there are several types of data:

<dbl> Double. “Numbers as a number.” Numbers stored to a high level of scientific precision. Mathematical operations are defined. (At least in theory!) e.g., SEX
<int> Integer. “Numbers as a number.” Mathematical operations are defined. (At least in theory!) R treats <dbl> and <int> as largely interchangeable.
<chr> Character. A variable with letter and/or number values. Mathematical operations are not defined, but other functions exist (e.g., extract the first and last characters, etc.) e.g., preschoice
<fct> Factor. A variable defining group membership. Mathematical operations are not defined, but they can be used in special ways in R. e.g. QLT20. Note how the values of a character variable like preschoice are in quotes while the values of a factor variable like QLT20 are not. Factor variable can “look” like numeric or character variables in that the values they take on may be numbers or letters (or both), but R interprets them differently than numeric and character variables and they can be used to do special things.

NOTE: There are also list objects, but we will cover them when needed.

A second way to get a sense of the data is to use the summary command which will report the quantiles for any integer or numeric variable, the count of every value for a factor variable, and a note if the variable is a character variable. Unlike glimpse which gives you a rough approximation of how much the data may vary, summary quantifies the variation of each numeric variable in a bit more detail.

summary(MI_final_small)

##       SEX           AGE10           PRSMI20        PARTYID     
##  Min.   :1.00   Min.   : 1.000   Min.   :0.00   Min.   :1.000  
##  1st Qu.:1.00   1st Qu.: 6.000   1st Qu.:1.00   1st Qu.:1.000  
##  Median :2.00   Median : 8.000   Median :1.00   Median :2.000  
##  Mean   :1.53   Mean   : 8.476   Mean   :1.63   Mean   :2.236  
##  3rd Qu.:2.00   3rd Qu.: 9.000   3rd Qu.:2.00   3rd Qu.:3.000  
##  Max.   :2.00   Max.   :99.000   Max.   :9.00   Max.   :9.000  
##                                                                
##      WEIGHT          QRACEAI          EDUC18           LGBT      
##  Min.   :0.1003   Min.   :1.000   Min.   :1.000   Min.   :1.000  
##  1st Qu.:0.3775   1st Qu.:1.000   1st Qu.:2.000   1st Qu.:2.000  
##  Median :0.8020   Median :1.000   Median :3.000   Median :2.000  
##  Mean   :1.0000   Mean   :1.572   Mean   :3.288   Mean   :2.224  
##  3rd Qu.:1.4498   3rd Qu.:1.000   3rd Qu.:5.000   3rd Qu.:2.000  
##  Max.   :5.0853   Max.   :9.000   Max.   :9.000   Max.   :9.000  
##                                                   NA's   :615    
##     BRNAGAIN        LATINOS         RACISM20    
##  Min.   :1.000   Min.   :1.000   Min.   :1.000  
##  1st Qu.:1.000   1st Qu.:2.000   1st Qu.:2.000  
##  Median :2.000   Median :2.000   Median :2.000  
##  Mean   :1.907   Mean   :2.175   Mean   :2.325  
##  3rd Qu.:2.000   3rd Qu.:2.000   3rd Qu.:3.000  
##  Max.   :9.000   Max.   :9.000   Max.   :9.000  
##  NA's   :615                     NA's   :615    
##                              QLT20      preschoice          Quality         
##  [DON'T READ] Don’t know/refused: 26   Length:1231        Length:1231       
##  Can unite the country          :125   Class :character   Class :character  
##  Cares about people like me     :121   Mode  :character   Mode  :character  
##  Has good judgment              :205                                        
##  Is a strong leader             :138                                        
##  NA's                           :616                                        
##

This is useful because it can reveal potential issues that we need to deal with. If we look at the maximum value for AGE10 for example, we can see that it has a value of 99 even though the Exit Poll questionaire indicates that the largest value should only be a 10 (for those selecting “75 and over”). This is because respondents who skipped that question were coded as having a value of 99. We also see that in other variables (e.g., PARTYID) there are values of 9 even though there is no value associated with that in the questionannire. These are again missing data!

Recall that this is the actual data that was used and we we see right away that while some variables have explicit missing data (e.g., LGBT, BRNAGAIN, RACISM20, QLT20) others have missing data that is not recognized as missing by R because of how it was coded. Moreover, the code for missing data varies between variables in this case! A 9 indicates missing data in PARTYID but it means something real in AGE10 (which uses 99 to denote missing data).

There are several functions depending on the type of data. For data that takes on discrete values – either numeric or character – it can be helpful to see the distribution of values that occur within a variable. To do so we are going to get a count of each unique value associated with a variable in a tibble.

In the code that follows we are using the tidyverse pipe command %>% which you should interpret as meaning “and then”. Using piping (%>%), we can count the variable preschoice within the tibble MI_final. This is what we will do as we are going to pipe multiple commands to accomplish our intended tasks. Note that the default reporting is to arrange the rows from lowest to smallest according to the values of the variable being counted (here preschoice which is being reported in alphabetical order).

MI_final_small %>% 
  count(preschoice)

## # A tibble: 6 × 2
##   preschoice                          n
##   <chr>                           <int>
## 1 Another candidate                  25
## 2 Donald Trump, the Republican      459
## 3 Joe Biden, the Democrat           723
## 4 Refused                            14
## 5 Undecided/Don’t know                4
## 6 Will/Did not vote for president     6

Note that here we are printing creating a table that is printed to the console window and disappears.

Quick Exercise 3 Can you create a tibble containing a table of vote choice?

# INSERT CODE HERE

If we try to count several variables what R will do is to present the count within each ordered value. So the following code will first count each value of preschoice and then count how that breaks down according to the values given in the variable SEX.

MI_final_small %>% 
  count(preschoice,SEX)

## # A tibble: 12 × 3
##    preschoice                        SEX     n
##    <chr>                           <dbl> <int>
##  1 Another candidate                   1    17
##  2 Another candidate                   2     8
##  3 Donald Trump, the Republican        1   247
##  4 Donald Trump, the Republican        2   212
##  5 Joe Biden, the Democrat             1   304
##  6 Joe Biden, the Democrat             2   419
##  7 Refused                             1     7
##  8 Refused                             2     7
##  9 Undecided/Don’t know                1     3
## 10 Undecided/Don’t know                2     1
## 11 Will/Did not vote for president     1     1
## 12 Will/Did not vote for president     2     5

This is an important reminder to always inspect your data and then you often, if not always, need to wrangle data before doing analysis!

Quick Exercise 4 How many Democrats and Republicans are in our sample?

# INSERT CODE HERE

Note that count is not useful for many-valued (continuous) variables because each value is likely to occur only a small number of times.

MI_final %>% 
  count(WEIGHT)

## # A tibble: 411 × 2
##    WEIGHT     n
##     <dbl> <int>
##  1  0.100     1
##  2  0.113     1
##  3  0.119     1
##  4  0.133     2
##  5  0.141     1
##  6  0.142     1
##  7  0.144     1
##  8  0.146     1
##  9  0.147     1
## 10  0.149     5
## # ℹ 401 more rows

Here the summary function is more useful for describing the variation in our data. In addition to summarizing the entire dataset we can also select a specific variable and use summary.

MI_final %>% 
  select(WEIGHT) %>%
  summary(WEIGHT)

##      WEIGHT      
##  Min.   :0.1003  
##  1st Qu.:0.3775  
##  Median :0.8020  
##  Mean   :1.0000  
##  3rd Qu.:1.4498  
##  Max.   :5.0853

Selecting Variables and Observations

Once we load a dataset into active memory and take a look to get a sense of what we have we often want to be able to focus on particular variables or observations. Not every variable or observation will be valuable for the analyses that we do and we want the ability to extract the relevant data either for future analyses (e.g., creating a new tibble with just the relevant data) or for the analysis that we want to do right now (e.g., perform a calculation using a specific variable in the tibble on a subset of the observations). If we are interested in the how respondents who self-identify as “born again” reported voting in 2020 in Michigan, for example, we only need to analyze the presidential vote choice of born-again voters.

For the data in this class, columns are variables and rows are observations. That is, each row is a unique data point and each column is a description of one feature of that data point. When doing analysis we often want to focus on observations with particular features – e.g., voters from a particular state in a nationwide survey.

Selecting variables (columns) using `select`

To begin, let’s create a new tibble called MI_small by extracting/selecting 4 variables from MI_final. If we have a large dataset it can be useful to create a smaller dataset to save computer memory and speed processing time. This is not a concern for any of the data we will use, but it is a useful illustration. Beyond creating new tibbles that are a subset of existing tibbles, the other use of select is to extract particular variables for analysis within the tibble.

In the code that follows we are using the tidyverse pipe command %>% which you should interpret as meaning “and then”. So, in English we would read this code as: “MI_Small is defined to be MI_final and then select the variables SEX, AGE10, PRSMI20, PARTYID and then glimpse the results”.

MI_small <- MI_final_small %>%
  select(SEX,AGE10,PRSMI20,PARTYID) %>%
  glimpse()

## Rows: 1,231
## Columns: 4
## $ SEX     <dbl> 2, 2, 2, 1, 2, 2, 1, 1, 2, 1, 1, 1, 2, 1, 1, 2, 1, 1, 1, 2, 1,…
## $ AGE10   <dbl> 2, 10, 7, 9, 8, 7, 9, 8, 6, 8, 9, 10, 1, 5, 9, 10, 8, 4, 1, 8,…
## $ PRSMI20 <dbl> 1, 1, 1, 1, 1, 1, 1, 1, 2, 1, 2, 2, 1, 2, 1, 1, 2, 1, 1, 1, 1,…
## $ PARTYID <dbl> 3, 1, 1, 3, 3, 3, 1, 1, 2, 1, 3, 2, 4, 4, 1, 1, 3, 3, 3, 1, 1,…

What this code does is to create a new tibble called MI_small that consists of the variables SEX, AGE10, PRSMI20, and PARTYID from the MI_final tibble and then prints a glimpse of the new tibble to the screen so we can check to confirm that it did what we wanted it to do. While MI_final had a dimension of 1231, 63, the new tibble MI_small has a dimension of 1231, 4.

We can also drop variables from a tibble by negatively selecting them. To drop AGE10 we just “subtract” the variable from the selection as follows:

MI_small %>% 
  select(-AGE10) %>%
  glimpse()

## Rows: 1,231
## Columns: 3
## $ SEX     <dbl> 2, 2, 2, 1, 2, 2, 1, 1, 2, 1, 1, 1, 2, 1, 1, 2, 1, 1, 1, 2, 1,…
## $ PRSMI20 <dbl> 1, 1, 1, 1, 1, 1, 1, 1, 2, 1, 2, 2, 1, 2, 1, 1, 2, 1, 1, 1, 1,…
## $ PARTYID <dbl> 3, 1, 1, 3, 3, 3, 1, 1, 2, 1, 3, 2, 4, 4, 1, 1, 3, 3, 3, 1, 1,…

Note that I am piping through the glimpse to confirm that the code is doing what I think it is doing. A large number of coding and analysis mistakes are caused by differences in what the data scientists thinks the data is relative to what the data actually is so it is usually a good ideal to confirm that you have done what you think you have done

Quick Exercise 5 Create a new tibble called MI_small_2 that contains the variables EDUC18, PARTYID, and SEX.

# INSERT CODE HERE

We can also select variables based on features of the variable names. To select all variables that start with the letter “P”, for example, we would use:

MI_small %>%
  select(starts_with("P")) %>%
  glimpse()

## Rows: 1,231
## Columns: 2
## $ PRSMI20 <dbl> 1, 1, 1, 1, 1, 1, 1, 1, 2, 1, 2, 2, 1, 2, 1, 1, 2, 1, 1, 1, 1,…
## $ PARTYID <dbl> 3, 1, 1, 3, 3, 3, 1, 1, 2, 1, 3, 2, 4, 4, 1, 1, 3, 3, 3, 1, 1,…

Why would we ever do this? If you are working with a large number of variables it can sometimes be useful to have uniform naming conventions (e.g., have all demographic variables start with the prefix “d_” as in “d_age”).

We can also select variables that end with (or do not end with) a particular set of values. The code below selects all variables that do not – hence the ! that tells R to do the opposite of the function (i.e., “does not”) – end in a 0.

MI_small %>% 
  select(!ends_with("0")) %>%
  glimpse()

## Rows: 1,231
## Columns: 2
## $ SEX     <dbl> 2, 2, 2, 1, 2, 2, 1, 1, 2, 1, 1, 1, 2, 1, 1, 2, 1, 1, 1, 2, 1,…
## $ PARTYID <dbl> 3, 1, 1, 3, 3, 3, 1, 1, 2, 1, 3, 2, 4, 4, 1, 1, 3, 3, 3, 1, 1,…

These functions are admittedly a bit specific and we won’t really use them much in class, but it is good to know the functionality exists. Note that we are not limited to a single character, we could select variables that starts_with("PAR") or ends_with("20").

We can also select a range of variables using the sequence notation : (all values between) that takes all variables between the two variables– including the two variable. For example, to select all variables between SEX and PRSMI20 in the tibble we could do the following.

MI_final_small %>% 
  select(SEX:PRSMI20) %>%
  glimpse()

## Rows: 1,231
## Columns: 3
## $ SEX     <dbl> 2, 2, 2, 1, 2, 2, 1, 1, 2, 1, 1, 1, 2, 1, 1, 2, 1, 1, 1, 2, 1,…
## $ AGE10   <dbl> 2, 10, 7, 9, 8, 7, 9, 8, 6, 8, 9, 10, 1, 5, 9, 10, 8, 4, 1, 8,…
## $ PRSMI20 <dbl> 1, 1, 1, 1, 1, 1, 1, 1, 2, 1, 2, 2, 1, 2, 1, 1, 2, 1, 1, 1, 1,…

Before reading the next sentence, can you think why this is not good coding practice? Answer: it makes the code depend on the arrangement of the variables in your data such that a different arrangement of variables will produce differences in output. We always want our code to be replicable and it is therefore desirable to use coding practices that are not going to be affected by reorderings that do not change the underlying data.

Reordering observations (rows) using `arrange`

When working with the rows of a tibble it can sometimes be useful to rearrange their order. The exit poll data we are working with, for example, has no natural ordering – the order of the data is the order in which it was collected. But we may want to rearrange the data to sort it in increasing (or decreasing) order according to selected variables. To do so we can use the arrange function to sort the tibble according to the values of the specified variables. To rearrange the MI_small tibble by SEX (from smallest value to largest value) we would use:

MI_final_small %>% 
  arrange(SEX) %>%
  glimpse()

## Rows: 1,231
## Columns: 14
## $ SEX        <dbl> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,…
## $ AGE10      <dbl> 9, 9, 8, 8, 9, 10, 5, 9, 8, 4, 1, 1, 6, 7, 7, 4, 99, 9, 10,…
## $ PRSMI20    <dbl> 1, 1, 1, 1, 2, 2, 2, 1, 2, 1, 1, 1, 1, 2, 2, 2, 2, 1, 0, 2,…
## $ PARTYID    <dbl> 3, 1, 1, 1, 3, 2, 4, 1, 3, 3, 3, 1, 1, 4, 3, 4, 3, 1, 3, 2,…
## $ WEIGHT     <dbl> 0.1991648, 1.3713049, 1.1540513, 1.3000787, 0.1469731, 0.84…
## $ QRACEAI    <dbl> 1, 1, 1, 2, 9, 1, 1, 1, 3, 1, 1, 1, 2, 1, 1, 1, 5, 1, 1, 1,…
## $ EDUC18     <dbl> 4, 3, 3, 4, 5, 5, 1, 1, 5, 2, 4, 1, 2, 5, 2, 2, 9, 2, 5, 1,…
## $ LGBT       <dbl> NA, 2, 2, NA, NA, NA, 2, NA, 2, NA, 2, 1, 2, NA, NA, NA, NA…
## $ BRNAGAIN   <dbl> NA, 1, 2, NA, NA, NA, 2, NA, 1, NA, 2, 2, 2, NA, NA, NA, NA…
## $ LATINOS    <dbl> 2, 2, 2, 2, 2, 2, 2, 2, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,…
## $ RACISM20   <dbl> NA, 2, 2, NA, NA, NA, 2, NA, 4, NA, 3, 1, 2, NA, NA, NA, NA…
## $ QLT20      <fct> Has good judgment, NA, NA, Cares about people like me, Is a…
## $ preschoice <chr> "Joe Biden, the Democrat", "Joe Biden, the Democrat", "Joe …
## $ Quality    <chr> "Has good judgment", NA, NA, "Cares about people like me", …

Note now how all of the values for SEX being glimpsed consist of the value 1. Also note that we have not saved this rearrangement - we have just rearranged the tibble. How would you save the rearrangement?

The default is to sort from smallest to largest, but to sort from largest to smallest we need to tell R to take the variable in descending (desc) order as follows.

MI_small %>% 
  arrange(desc(SEX)) %>%
  glimpse()

## Rows: 1,231
## Columns: 4
## $ SEX     <dbl> 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,…
## $ AGE10   <dbl> 2, 10, 7, 8, 7, 6, 1, 10, 8, 9, 7, 8, 9, 1, 10, 6, 10, 5, 7, 9…
## $ PRSMI20 <dbl> 1, 1, 1, 1, 1, 2, 1, 1, 1, 2, 2, 2, 1, 1, 1, 1, 1, 1, 1, 1, 9,…
## $ PARTYID <dbl> 3, 1, 1, 3, 3, 2, 4, 1, 1, 3, 2, 1, 1, 1, 1, 1, 3, 3, 1, 3, 4,…

Quick Exercise 6 Sort the new tibble MI_small_2 you created by education level and save the sorted data.

# INSERT CODE HERE

We can also sort using multiple variables. If we arrange using several variables R will process them sequentially — sort by the first variable, then sort again within each of the sorted variables according to the values of the second variable, and so on. So if we wanted to sort by age by gender in ascending order we would use:

MI_small %>% 
  arrange(SEX, AGE10) %>%
  glimpse()

## Rows: 1,231
## Columns: 4
## $ SEX     <dbl> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,…
## $ AGE10   <dbl> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2,…
## $ PRSMI20 <dbl> 1, 1, 1, 2, 2, 2, 1, 2, 2, 2, 1, 1, 1, 1, 2, 1, 2, 1, 9, 8, 1,…
## $ PARTYID <dbl> 3, 1, 3, 2, 2, 4, 4, 2, 2, 2, 3, 1, 3, 4, 4, 1, 3, 3, 3, 9, 4,…

So you can now see that the data is sorted by AGE10 within each value of SEX. There is no limit to the number of sorts we can do, or to whether we sort by ascending or descending order.

As a test of what we have done so far, can you predict what the following code will produce?

MI_small %>% 
  select(SEX,AGE10,PARTYID) %>%
  arrange(SEX, AGE10, desc(PARTYID)) %>%
  glimpse()

## Rows: 1,231
## Columns: 3
## $ SEX     <dbl> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,…
## $ AGE10   <dbl> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2,…
## $ PARTYID <dbl> 4, 4, 4, 4, 3, 3, 3, 3, 2, 2, 2, 2, 2, 1, 1, 1, 9, 9, 4, 4, 3,…

To be honest, we don’t really do much with arrange other than if we are inspecting the data visually or if we are making the output a bit more sensible.
Recall that the count function produces a tibble that is sorted according to the values of the variable being counted. This is not always sensible as we may want to sort the tibble according to the most-frequently occuring value in the data. If we wanted to produce a table of values sorted in descending order so that the top row was the most frequently occurring value we could arrange after piping thru a count.¹

MI_final_small %>% 
  count(preschoice) %>%
  arrange(desc(n))

## # A tibble: 6 × 2
##   preschoice                          n
##   <chr>                           <int>
## 1 Joe Biden, the Democrat           723
## 2 Donald Trump, the Republican      459
## 3 Another candidate                  25
## 4 Refused                            14
## 5 Will/Did not vote for president     6
## 6 Undecided/Don’t know                4

Selecting observations (rows) using `filter`

So far all we have done is to rearrange the observations (rows) in a tibble. If we want to extract particular observations then we need to use the filter function.

To select all the male respondents (i.e., SEX takes on the value of “1”), we could use filter as follows:

MI_final_small %>%
  filter(SEX == 2) %>%
  glimpse()

## Rows: 652
## Columns: 14
## $ SEX        <dbl> 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,…
## $ AGE10      <dbl> 2, 10, 7, 8, 7, 6, 1, 10, 8, 9, 7, 8, 9, 1, 10, 6, 10, 5, 7…
## $ PRSMI20    <dbl> 1, 1, 1, 1, 1, 2, 1, 1, 1, 2, 2, 2, 1, 1, 1, 1, 1, 1, 1, 1,…
## $ PARTYID    <dbl> 3, 1, 1, 3, 3, 2, 4, 1, 1, 3, 2, 1, 1, 1, 1, 1, 3, 3, 1, 3,…
## $ WEIGHT     <dbl> 0.4045421, 1.8052619, 0.8601966, 0.1772090, 0.4921975, 1.50…
## $ QRACEAI    <dbl> 1, 2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 1, 1, 2, 2,…
## $ EDUC18     <dbl> 4, 1, 5, 5, 3, 4, 4, 1, 2, 2, 4, 2, 3, 2, 4, 3, 2, 5, 4, 4,…
## $ LGBT       <dbl> NA, 2, 2, NA, 2, NA, NA, 2, 2, NA, NA, 2, NA, 2, 2, NA, 2, …
## $ BRNAGAIN   <dbl> NA, 1, 2, NA, 2, NA, NA, 2, 2, NA, NA, 2, NA, 2, 1, NA, 9, …
## $ LATINOS    <dbl> 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,…
## $ RACISM20   <dbl> NA, 2, 2, NA, 2, NA, NA, 9, 2, NA, NA, 3, NA, 1, 2, NA, 2, …
## $ QLT20      <fct> Has good judgment, NA, NA, Cares about people like me, NA, …
## $ preschoice <chr> "Joe Biden, the Democrat", "Joe Biden, the Democrat", "Joe …
## $ Quality    <chr> "Has good judgment", NA, NA, "Cares about people like me", …

When we glimpse the results we can see that every value for SEX is a 2 as requested.

Note the syntax: we use == to denote “is equal to” and we use the value 2 because it is a numeric.

We can also obviously combine filter with select to extract a subset of variables and observations as follows:

MI_final_small %>%
  select(SEX,PARTYID,preschoice) %>%
  filter(SEX == 2) %>%
  glimpse()

## Rows: 652
## Columns: 3
## $ SEX        <dbl> 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,…
## $ PARTYID    <dbl> 3, 1, 1, 3, 3, 2, 4, 1, 1, 3, 2, 1, 1, 1, 1, 1, 3, 3, 1, 3,…
## $ preschoice <chr> "Joe Biden, the Democrat", "Joe Biden, the Democrat", "Joe …

If we wanted to select observations for based on a character or factor variable the syntax would be somewhat different because of the difference in a numeric and character value. To select only respondents who supported Joe Biden using the preschoice variable, for example, we would use quotes to denote that the value we are filtering is a character:

MI_final_small %>%
  filter(preschoice == "Joe Biden, the Democrat") %>%
  glimpse()

## Rows: 723
## Columns: 14
## $ SEX        <dbl> 2, 2, 2, 1, 2, 2, 1, 1, 1, 2, 1, 2, 1, 1, 2, 1, 1, 2, 2, 2,…
## $ AGE10      <dbl> 2, 10, 7, 9, 8, 7, 9, 8, 8, 1, 9, 10, 4, 1, 8, 1, 6, 9, 1, …
## $ PRSMI20    <dbl> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,…
## $ PARTYID    <dbl> 3, 1, 1, 3, 3, 3, 1, 1, 1, 4, 1, 1, 3, 3, 1, 1, 1, 1, 1, 1,…
## $ WEIGHT     <dbl> 0.4045421, 1.8052619, 0.8601966, 0.1991648, 0.1772090, 0.49…
## $ QRACEAI    <dbl> 1, 2, 1, 1, 1, 1, 1, 1, 2, 1, 1, 1, 1, 1, 1, 1, 2, 1, 1, 1,…
## $ EDUC18     <dbl> 4, 1, 5, 4, 5, 3, 3, 3, 4, 4, 1, 1, 2, 4, 2, 1, 2, 3, 2, 4,…
## $ LGBT       <dbl> NA, 2, 2, NA, NA, 2, 2, 2, NA, NA, NA, 2, NA, 2, 2, 1, 2, N…
## $ BRNAGAIN   <dbl> NA, 1, 2, NA, NA, 2, 1, 2, NA, NA, NA, 2, NA, 2, 2, 2, 2, N…
## $ LATINOS    <dbl> 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,…
## $ RACISM20   <dbl> NA, 2, 2, NA, NA, 2, 2, 2, NA, NA, NA, 9, NA, 3, 2, 1, 2, N…
## $ QLT20      <fct> Has good judgment, NA, NA, Has good judgment, Cares about p…
## $ preschoice <chr> "Joe Biden, the Democrat", "Joe Biden, the Democrat", "Joe …
## $ Quality    <chr> "Has good judgment", NA, NA, "Has good judgment", "Cares ab…

Selecting and Filtering based on conditional statements

Many times we want to select observations (and/or variables) depending on whehter or not several conditions are satisfied. To do so we use the fact that:

& (AND) selects if all conditions are true.
| (OR) selects if any condition is true

So if we are considering condition A and condition B, filtering based on & will select observations for which both A and B are satisfied (i.e., the intersection) whereas | will select observations for which either A or B are satisfied (i.e., the union). Note that there is no limit to the number of conditions we can use and we can also combine them.

A | B means either condition A or B is satisfied.
A & B means that both conditions A and B are satisfied.
A | B | C means that either condition A OR condition B OR condition C are satisfied.
(A & B) | C means that either conditions A and B OR condition C is satisfied.
A & (B | C) means that condition A AND conditions B or C are satisfied.

** SELF-TEST: If A = self-identified Democrat, B = self-identified Republican, and C = self-identified Independent how would you interpret each of the conditions above in terms of which respondents would be filtered?

Let’s see how to implement this in R. According to the values coded in the Michigan Exit Poll we see that:

SEX: 1 = Male, 2 = Female
AGE10: 1 = “under 24”, … , 9 = “64-75”, 10 = “75+”

To select the self-reported vote choices of females under the age of 24 we would want to select observations from individuals who are both female and under the age of 24. To do so, we use the following (note that we are selecting to focus on the most relevant variables as practice – the code also works without this step):

MI_final_small %>%
  select(SEX,AGE10,preschoice) %>%
    filter(SEX == 2 & AGE10 == 1) %>%
    glimpse()

## Rows: 17
## Columns: 3
## $ SEX        <dbl> 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2
## $ AGE10      <dbl> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1
## $ preschoice <chr> "Joe Biden, the Democrat", "Joe Biden, the Democrat", "Joe …

OK, but it is hard to know what to take away from this. How about pulling together content from above to produce the following?

MI_final_small %>%
    filter(SEX == 2 & AGE10 == 1) %>%
    count(preschoice) %>%
    arrange(desc(n))

## # A tibble: 3 × 2
##   preschoice                       n
##   <chr>                        <int>
## 1 Joe Biden, the Democrat         15
## 2 Another candidate                1
## 3 Donald Trump, the Republican     1

Note that here we have dropped the select code because the point of our code is summarize the distribution of self-reported voting behavior, not produce a new tibble for subsequent analysis. Because we are using the count function applied to the variable preschoice the piping will automatically select the relevant variable.

Notice the difference in the nature and dimensions of the resulting tibbles from these two code snippets. The first code snippet produced a tibble with 17 observations and 3 columns – it is a new data set we can analyze (if we had saved it!). But the second code snippet is a tibble that consists only of 3 observations and 2 columns because it is counting the number of times that each of the 3 unique values occur among the filtered set of respondents.

Quick Exercise 7 Replicate the analysis using male respondents (i.e., SEX==1)? What do you observe about the number and distribution of vote choice?

# INSERT CODE HERE

In addition to selecting cases for which both conditions are satisfied we can also select conditions for which either condition A or condition B is satisfied. If we want to focus on voters who voted for either Biden or Trump – and ignore those who self-reported voting for some other candidate – we can filter the data accordingly:

MI_final_small %>%
    filter(preschoice == "Joe Biden, the Democrat" | preschoice == "Donald Trump, the Republican") %>%
    glimpse()

## Rows: 1,182
## Columns: 14
## $ SEX        <dbl> 2, 2, 2, 1, 2, 2, 1, 1, 2, 1, 1, 1, 2, 1, 1, 2, 1, 1, 1, 2,…
## $ AGE10      <dbl> 2, 10, 7, 9, 8, 7, 9, 8, 6, 8, 9, 10, 1, 5, 9, 10, 8, 4, 1,…
## $ PRSMI20    <dbl> 1, 1, 1, 1, 1, 1, 1, 1, 2, 1, 2, 2, 1, 2, 1, 1, 2, 1, 1, 1,…
## $ PARTYID    <dbl> 3, 1, 1, 3, 3, 3, 1, 1, 2, 1, 3, 2, 4, 4, 1, 1, 3, 3, 3, 1,…
## $ WEIGHT     <dbl> 0.4045421, 1.8052619, 0.8601966, 0.1991648, 0.1772090, 0.49…
## $ QRACEAI    <dbl> 1, 2, 1, 1, 1, 1, 1, 1, 1, 2, 9, 1, 1, 1, 1, 1, 3, 1, 1, 1,…
## $ EDUC18     <dbl> 4, 1, 5, 4, 5, 3, 3, 3, 4, 4, 5, 5, 4, 1, 1, 1, 5, 2, 4, 2,…
## $ LGBT       <dbl> NA, 2, 2, NA, NA, 2, 2, 2, NA, NA, NA, NA, NA, 2, NA, 2, 2,…
## $ BRNAGAIN   <dbl> NA, 1, 2, NA, NA, 2, 1, 2, NA, NA, NA, NA, NA, 2, NA, 2, 1,…
## $ LATINOS    <dbl> 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 1, 2, 2, 2,…
## $ RACISM20   <dbl> NA, 2, 2, NA, NA, 2, 2, 2, NA, NA, NA, NA, NA, 2, NA, 9, 4,…
## $ QLT20      <fct> Has good judgment, NA, NA, Has good judgment, Cares about p…
## $ preschoice <chr> "Joe Biden, the Democrat", "Joe Biden, the Democrat", "Joe …
## $ Quality    <chr> "Has good judgment", NA, NA, "Has good judgment", "Cares ab…

Note that this produces a new tibble that could be used for subsequent analysis containing only respondents who report voting for either Biden or Trump. Because the number of rows decreases from 1231 in MI_Final_small to 1182 after the filter we have just performed, we can determine that 49 respondents reported voting for a candidate other than Biden or Trump.

To reiterate how piped functions can change the meaning of a tibble, consider how the size and content of the code we just ran compares to the following:

MI_final_small %>%
    filter(preschoice == "Joe Biden, the Democrat" | preschoice == "Donald Trump, the Republican") %>%
    count(preschoice) %>%
    arrange(desc(n))

## # A tibble: 2 × 2
##   preschoice                       n
##   <chr>                        <int>
## 1 Joe Biden, the Democrat        723
## 2 Donald Trump, the Republican   459

Again, once we pipe (%>%) thru the count function to the filtered tibble, the tibble changes from being organized by observations (1182 x 14) to being organized by the number of unique values in the variable being counted (2). Moreover, the meaning of the columns changes from being variables associated with each observation to being the number of observations taking on each value.

Always know what your tibble looks like and what it contains!

NOTE: We can also use conditionals when selecting variables. For example:

Select variables “if and only if” multiple conditions are true: & (AND)

MI_final %>%
  select(SEX & starts_with("P")) %>%
  glimpse()

## Rows: 1,231
## Columns: 0

Select variables “if and only if” any condition is true: | (OR)

MI_final %>%
  select(SEX | starts_with("P")) %>%
  glimpse()

## Rows: 1,231
## Columns: 4
## $ SEX     <hvn_lbl_> 2, 2, 2, 1, 2, 2, 1, 1, 2, 1, 1, 1, 2, 1, 1, 2, 1, 1, 1, …
## $ PRSMI20 <hvn_lbl_> 1, 1, 1, 1, 1, 1, 1, 1, 2, 1, 2, 2, 1, 2, 1, 1, 2, 1, 1, …
## $ PARTYID <hvn_lbl_> 3, 1, 1, 3, 3, 3, 1, 1, 2, 1, 3, 2, 4, 4, 1, 1, 3, 3, 3, …
## $ PHIL3   <hvn_lbl_> 2, 2, 1, 9, 1, 2, 9, 2, 3, 2, 3, 3, 1, 3, 9, 2, 2, 1, 3, …

Combining filters and tibbles

Using piping (%>%), we count the variable preschoice within the tibble MI_final. This is what we will do as we are going to pipe multiple commands to accomplish our intended tasks.

MI_final_small %>% 
  count(preschoice)

## # A tibble: 6 × 2
##   preschoice                          n
##   <chr>                           <int>
## 1 Another candidate                  25
## 2 Donald Trump, the Republican      459
## 3 Joe Biden, the Democrat           723
## 4 Refused                            14
## 5 Undecided/Don’t know                4
## 6 Will/Did not vote for president     6

Note that here we are printing creating a table that is printed to the console window and disappears.

If we wanted to save it for later we could assign this to a new object and then manipulate it.

MI_prescount <- MI_final_small %>% 
  count(preschoice)

To access this I can then manipulate it. Note that calling MI_prescount directly reveals that it contains two variables – a variable of value labels with the same name as the variable that was counted (here preschoice) and a variable of the number of observations associated with each value (here n).

MI_prescount

## # A tibble: 6 × 2
##   preschoice                          n
##   <chr>                           <int>
## 1 Another candidate                  25
## 2 Donald Trump, the Republican      459
## 3 Joe Biden, the Democrat           723
## 4 Refused                            14
## 5 Undecided/Don’t know                4
## 6 Will/Did not vote for president     6

You can then access this using all of the tools we have already talked about. For example, to get the number of Biden supporters we can select the relevant row using filter via

MI_prescount %>%
  filter(preschoice == "Joe Biden, the Democrat")

## # A tibble: 1 × 2
##   preschoice                  n
##   <chr>                   <int>
## 1 Joe Biden, the Democrat   723

Quick Exercise 8 Extract the number of respondents who chose either Biden or Trump.

# INSERT CODE HERE

Consider what happens if we instead do:

MI_final_small %>% 
  select(preschoice) %>%
  count()

## # A tibble: 1 × 1
##       n
##   <int>
## 1  1231

What did we do ?!?! Now we have selected the variable preschoice and then counted up the number of observations. Before, we were counting the variable preschoice which was counting each value.

Missing Data

Several of our variables were only asked of half the sample (the 2020 Michigan exit poll used two different sets of questionaires to try to ask more questions) and it is important to account for that when thinking about the amount of data we have and what might be possible.

For example, let’s see why respondents reported voting for a candidate.

MI_final_small %>%
  count(Quality)

## # A tibble: 6 × 2
##   Quality                             n
##   <chr>                           <int>
## 1 Can unite the country             125
## 2 Cares about people like me        121
## 3 Has good judgment                 205
## 4 Is a strong leader                138
## 5 [DON'T READ] Don’t know/refused    26
## 6 <NA>                              616

So here we see based on the number of NA that nearly half of the respondents do not have a valid reply. We can use the drop_na function to remove missing data that R recognizes (more on this next lecture!). Note that the responses also contain an actual value for missing data, but we will deal with that later.

If we want to drop all of the missing observations in Quality we can use the following – note that drop_na is essentially applying a filter to remove missing data.

MI_final_small %>%
    drop_na(Quality) %>%
    count(Quality)

## # A tibble: 5 × 2
##   Quality                             n
##   <chr>                           <int>
## 1 Can unite the country             125
## 2 Cares about people like me        121
## 3 Has good judgment                 205
## 4 Is a strong leader                138
## 5 [DON'T READ] Don’t know/refused    26

We can include multiple variables in this list. Note that if we do not supply a list of variables it will default to the entire data set! Given that some questions are only asked to half of the sample, why does the following code produce a tibble with 0 rows?

MI_final_small %>%
    drop_na() %>%
    count(Quality)

## # A tibble: 0 × 2
## # ℹ 2 variables: Quality <chr>, n <int>

This highlights the importance of knowing what your data looks like in terms of missing data and also why it can be important to use select to first remove the variables of most interest. You do not want to remove data because of missingness in variables that you do not care about! As we will see, some functions have a built-in parameter to deal with missing data (e.g., mean) while others do not so always know your data!

Note that in this instance we could also use arrange(-n) to sort in descending order. We use desc because it is slightly more generic (i.e., if we tried to use arrange(-SEX) above it would not work).↩︎

Downloads

Mon, 01 Jan 0001 00:00:00 +0000

Data for homeworks and problem sets

HW1: Intro to Data Science

Mon, 01 Jan 0001 00:00:00 +0000

Welcome to Data Science!

In this homework, we’ll be working on getting you set up with the tools you will need for this class. Once you are set up, we’ll do what we’re here to do: analyze data!

Here’s what we will accomplish by the end of the assignment:

Getting started with R
Getting started with RStudio
Analyze Data
<….>
Profit! (profitability may vary by user)

Introductions

We need two basic sets of tools for this class. We will need R to analyze data. We will need RStudio to help us interface with R and to produce documentation of our results.

Installing R

R is going to be the only programming language we will use. R is an extensible statistical programming environment that can handle all of the main tasks that we’ll need to cover this semester: getting data, analyzing data and communicating data analysis.

If you haven’t already, you need to download R here: https://cran.r-project.org/.

Installing RStudio

When we work with R, we communicate via the command line. To help automate this process, we can write scripts, which contain all of the commands to be executed. These scripts generate various kinds of output, like numbers on the screen, graphics or reports in common formats (pdf, word). Most programming languages have several I ntegrated D evelopment E nvironments (IDEs) that encompass all of these elements (scripts, command line interface, output). The primary IDE for R is RStudio.

If you haven’t already, you need to download RStudio here: https://rstudio.com/products/rstudio/download/. You need the free RStudio desktop version.

Accessing Files and Using Directories

In each class, we’re going to include some code and text in one file, and data in another file. You’ll need to download both of these files to your computer. You need to have a particular place to put these files. Computers are organized using named directories (sometimes called folders). Don’t just put the files in your Downloads directory. One common solution is to created a directory on your computer named after the class: psc_4175. Each time you access the files, you’ll want to place them in that directory.

Yes We Code! Running R Code

We’re going to grab some data that’s part of the college scorecard and do a bit of analysis on it.

.Rmd Set Up

Open RStudio, then create a new .Rmd file. To do this, click on File → New File → R Markdown....

You will then be asked to determine a bunch of settings for this .Rmd document. For example, you can choose whether you want to create a “Document”, “Presentation”, “Shiny”, or “From Template” on the left. You can set the “Title:” “Author:” and “Date:” on the top-right. And you can choose the “Default Output Format:” to be either “HTML”, “PDF”, or “Word”. You should not change any of these settings. Their defaults (“Document”, “Untitled”, “[Your name]”, “[Today’s Date]”, and “HTML”) are sufficient. Just click “OK”.

Copy the raw code from the psc4175_hw_1.Rmd file by clicking on the copy button as shown in the image below.

Finally, replace the default code in your R Markdown file with the copied code from the GitHub!

If viewing this as an html file, you can view this gif for more help!

Helpful tip! You can also simply download the .Rmd file for the homeworks/problem sets and work directly from them. Just be sure you save it to your preferred folder on your computer system!

.Rmd Files

.Rmd files will be the only file format we work in this class. .Rmd files contain three basic elements:

Script that can be interpreted by R.
Output generated by R, including tables and figures.
Text that can be read by humans.

From an .Rmd file you can generate html documents, pdf documents, word documents, slides . . . lots of stuff. All class notes will be in .Rmd. All assignments will be completed on .Rmd files.

In the .Rmd file you’ll notice that there are three open single quotes in a row, like so: ``` This indicates the start of a “code chunk” in our file. The first code chunk that we load will include a set of programs that we will need all semester long.

These .Rmd files are great, but the reader (you and me) cannot easily see all of the output. You are in effect writing the code that Microsoft Word does behind the scenes. In order to see the nice output we need to “knit” the .Rmd file. At the top of RStudio, you’ll see a “Knit” button with a drop down arrow. If you click “Knit” the .Rmd will transform into an .html file and automatically save in the same directory as your .Rmd file. If you receive an error in the console, you’ll need to go back and check where that error occurred (this will be frustrating at first, but you’ll soon find mistakes quite quickly!). I find it easier to “knit” your .Rmd file as a PDF as this is the file you will submit for all of your assignments.

To “knit” your .Rmd as a PDF follow these steps:

Select the “Knit” drop-down icon at the top of the RStudio window, and select “Knit to PDF”. RStudio will ask you to first save the markdown file, then it will process the markdown file and render it to PDF.

If this worked, you’re good to go! You can ignore the next section here. If it didn’t work, then proceed with the next steps

Install the tinytex package by typing this code into the command console of RStudio:

# install.packages("tinytex") # Uncomment this to install

Then, once that has installed successfully, type the following:

# tinytex::install_tinytex() # Uncomment this to install

Remember, once these are loaded, you do not need to install them every time; they are saved in your library! You can comment them out again by adding a “#” before the line of code.

Now, go back and “Knit to PDF”. If you’re still having problems, let me know in Campuswire.

Outputting results

I like to see results in the Console. By default Rstudio will output results from an Rmd file inline– meaning in the document itself. To change this, go to Tools–>global Options–>R Markdown, and uncheck the box for “show output inline for all Rmarkdown documents.”

Using R Libraries

When we say that R is extensible, we mean that people in the community can write programs that everyone else can use. These are called “packages.” In these first few lines of code, I load a set of packages using the library command in R. The set of packages, called tidyverse were written by Hadley Wickham and others and play a key role in his book. To install this set of packages, simply type in install.packages("tidyverse") at the R command prompt. Alternatively, you can use the “Packages” pane in the lower right hand corner of your Rstudio screen. Click on Packages, then click on install, then type in “tidyverse.”

To run the code below in R, you can:

Press the “play” button next to the code chunk
In OS X, place the cursor in the code chunk and hit CMD+RETURN
In Windows, place the cursor in the code chunk and hit CTRL+RETURN

## Get necessary libraries-- won't work the first time, because you need to install them!
# install.packages("tidyverse")  # Uncomment this to install
library(tidyverse)

Here’s the thing about packages. There’s a difference between installing a package and calling a package. Installing means that the package is on your computer and available to use. Calling a package means that the commands in the package will be used in this session. A “session” is basically when R has been opened up on your computer. As long as R/Rstudio are open and running, the session is active.

It’s a good practice to shutdown R/Rstudio once you’re no longer working on it, and then to restart it when you begin working again. Otherwise, the working environment can get pretty crowded with data and packages.

Loading Datasets

Now we’re ready to load in data. The data frame will be our basic way of interacting with everything in this class. The sc_debt.Rds data frame contains information from the college scorecard on different colleges and universities.

tidyverse includes a read_rds() function that can read data directly from the internet.

df <- read_rds('https://github.com/rweldzius/PSC4175/raw/main/static/data/sc_debt.Rds')

You’ll notice that the code above starts with df. This is just an arbitrary name for an object. You could name it dat or raw or debt or whatever you want. Then there’s an arrow <-. This is an assignment operator. Then there’s a function, readRDS, with parentheses, and an argument “sc_debt.Rds”. Here’s how to think about this.

Functions in R always have arguments within parentheses. This function. readRDS opens a type of data– rds data. This function has one argument which is the name of the file I want to open.
Assignment operators take the result of a function and assign it to an object name.
Objects in R store information locally so that it can be accessed again.

So the command above says “use readRDS to open the file”sc_debt.Rds” and assign the result to the object df.

Let’s take a quick look at the object df

df

## # A tibble: 2,546 × 16
##    unitid instnm   stabbr grad_debt_mdn control region preddeg openadmp adm_rate
##     <int> <chr>    <chr>          <int> <chr>   <chr>  <chr>      <int>    <dbl>
##  1 100654 Alabama… AL             33375 Public  South… Bachel…        2    0.918
##  2 100663 Univers… AL             22500 Public  South… Bachel…        2    0.737
##  3 100690 Amridge… AL             27334 Private South… Associ…        1   NA    
##  4 100706 Univers… AL             21607 Public  South… Bachel…        2    0.826
##  5 100724 Alabama… AL             32000 Public  South… Bachel…        2    0.969
##  6 100751 The Uni… AL             23250 Public  South… Bachel…        2    0.827
##  7 100760 Central… AL             12500 Public  South… Associ…        1   NA    
##  8 100812 Athens … AL             19500 Public  South… Bachel…       NA   NA    
##  9 100830 Auburn … AL             24826 Public  South… Bachel…        2    0.904
## 10 100858 Auburn … AL             21281 Public  South… Bachel…        2    0.807
## # ℹ 2,536 more rows
## # ℹ 7 more variables: ccbasic <int>, sat_avg <int>, md_earn_wne_p6 <int>,
## #   ugds <int>, costt4_a <int>, selective <dbl>, research_u <dbl>

This is just the first part of the data frame. All data frames have the exact same structure. Each row is a case. In this example, each row is a college. Each column is a characteristics of the case, what we call a variable. Let’s use the names command to see what variables are in the dataset.

names(df)

##  [1] "unitid"         "instnm"         "stabbr"         "grad_debt_mdn" 
##  [5] "control"        "region"         "preddeg"        "openadmp"      
##  [9] "adm_rate"       "ccbasic"        "sat_avg"        "md_earn_wne_p6"
## [13] "ugds"           "costt4_a"       "selective"      "research_u"

It’s hard to know what these mean without some more information. We usually use a codebook to get more information about a dataset. Because we use very short names for variables, it’s useful to have some more information (fancy name: metadata) that tells us about those variables. Below you’ll see the R name for each variable next to a description of each variable.

Name	Definition
unitid	Unit ID
instnm	Institution Name
stabbr	State Abbreviation
grad_debt_mdn	Median Debt of Graduates
control	Control Public or Private
region	Census Region
preddeg	Predominant Degree Offered: Associates or Bachelors
openadmp	Open Admissions Policy: 1= Yes, 2=No,3=No 1st time students
adm_rate	Admissions Rate: proportion of applications accepted
ccbasic	Type of institution– see here
selective	Institution admits fewer than 10 % of applicants, 1=Yes, 0=No
research_u	Institution is a research university 1=Yes, 0=No
sat_avg	Average Sat Scores
md_earn_wne_p6	Average Earnings of Recent Graduates
ugds	Number of undergraduates
costt4a	Average cost of attendance (tuition-grants)

Looking at datasets

We can also look at the whole dataset using View. Just delete the # sign below to make the code work. That # sign is a comment in R code, which indicates to the computer that everything on that line should be ignored. To get it to run, we need to drop the #.

#View(df)

You’ll notice that this data is arranged in a rectangular format, with each row showing a different college, and each column representing a different characteristic of that college. Datasets are always structured this way— cases (or units) will form the rows, and the characteristics of those cases– or variables— will form the columns. Unlike working with spreadsheets, this structure is always assumed for datasets.

Filter, Select, Arrange

In exploring data, many times we want to look at smaller parts of the dataset. There are three commands we’ll use today that help with this.

-filter selects only those cases or rows that meet some logical criteria.

-select selects only those variables or columns that meet some criteria

-arrange arranges the rows of a dataset in the way we want.

For more on these, please see this vignette.

Let’s grab just the data for Villanova, then look only at the average test scores and admit rate. We can use filter to look at all of the variables for Villanova:

df%>%
  filter(instnm=="Villanova University")

## # A tibble: 1 × 16
##   unitid instnm    stabbr grad_debt_mdn control region preddeg openadmp adm_rate
##    <int> <chr>     <chr>          <int> <chr>   <chr>  <chr>      <int>    <dbl>
## 1 216597 Villanov… PA             26000 Private North… Bachel…        2    0.282
## # ℹ 7 more variables: ccbasic <int>, sat_avg <int>, md_earn_wne_p6 <int>,
## #   ugds <int>, costt4_a <int>, selective <dbl>, research_u <dbl>

What’s that weird looking %>% thing? That’s called a pipe. This is how we chain commands together in R. Think of it as saying “and then” to R. In the above case, we said, take the data and then filter it to be just the data where the institution name is Vanderbilt University.

The command above says the following:

Take the dataframe df and then filter it to just those cases where instnm is equal to “Villanova University.” Notice the “double equals” sign, that’s a logical operator asking if instnm is equal to “Villanova University.”

Many times, though we don’t want to see everything, we just want to choose a few variables. select allows us to select only the variables we want. In this case, the institution name, its admit rate, and the average SAT scores of entering students.

df%>%
  filter(instnm=="Villanova University")%>%
  select(instnm,adm_rate,sat_avg)

## # A tibble: 1 × 3
##   instnm               adm_rate sat_avg
##   <chr>                   <dbl>   <int>
## 1 Villanova University    0.282    1422

filter takes logical tests as its argument. The code insntnm=="Villanova University" is a logical statement that will be true of just one case in the dataset– when institution name is Vanderbilt University. The == is a logical test, asking if this is equal to that. Other common logical and relational operators for R include

>, <: greater than, less than
>=, <=: greater than or equal to, less than or equal to
! :not, as in != not equal to
& AND
| OR

Next, we can use filter to look at colleges with low admissions rates, say less than 10% ( or .1 in the proportion scale used in the dataset).

df%>%
  filter(adm_rate<.1)%>%
  select(instnm,adm_rate,sat_avg)%>%
  arrange(sat_avg,adm_rate)%>%
  print(n=20)

## # A tibble: 25 × 3
##    instnm                                      adm_rate sat_avg
##    <chr>                                          <dbl>   <int>
##  1 Colby College                                 0.0967    1456
##  2 Swarthmore College                            0.0893    1469
##  3 Pomona College                                0.074     1480
##  4 Dartmouth College                             0.0793    1500
##  5 Stanford University                           0.0434    1503
##  6 Northwestern University                       0.0905    1506
##  7 Columbia University in the City of New York   0.0545    1511
##  8 Brown University                              0.0707    1511
##  9 University of Pennsylvania                    0.0766    1511
## 10 Vanderbilt University                         0.0912    1515
## 11 Harvard University                            0.0464    1517
## 12 Princeton University                          0.0578    1517
## 13 Yale University                               0.0608    1517
## 14 Rice University                               0.0872    1520
## 15 Duke University                               0.076     1522
## 16 University of Chicago                         0.0617    1528
## 17 Massachusetts Institute of Technology         0.067     1547
## 18 California Institute of Technology            0.0642    1557
## 19 Saint Elizabeth College of Nursing            0           NA
## 20 Yeshivat Hechal Shemuel                       0           NA
## # ℹ 5 more rows

Now let’s look at colleges with low admit rates, and order them using arrange by SAT scores (-sat_avg gives descending order).

df%>%
  filter(adm_rate<.1)%>%
  select(instnm,adm_rate,sat_avg)%>%
  arrange(-sat_avg)

## # A tibble: 25 × 3
##    instnm                                      adm_rate sat_avg
##    <chr>                                          <dbl>   <int>
##  1 California Institute of Technology            0.0642    1557
##  2 Massachusetts Institute of Technology         0.067     1547
##  3 University of Chicago                         0.0617    1528
##  4 Duke University                               0.076     1522
##  5 Rice University                               0.0872    1520
##  6 Yale University                               0.0608    1517
##  7 Harvard University                            0.0464    1517
##  8 Princeton University                          0.0578    1517
##  9 Vanderbilt University                         0.0912    1515
## 10 Columbia University in the City of New York   0.0545    1511
## # ℹ 15 more rows

And one last operation: all colleges that admit between 20 and 30 percent of students, looking at their SAT scores, earnings of attendees six years letter, and what state they are in, then arranging by state, and then SAT score.

df%>%
  filter(adm_rate>.2&adm_rate<.3)%>%
  select(instnm,sat_avg,md_earn_wne_p6,stabbr)%>%
  arrange(stabbr,-sat_avg)%>%
  print(n=40)

## # A tibble: 37 × 4
##    instnm                                          sat_avg md_earn_wne_p6 stabbr
##    <chr>                                             <int>          <int> <chr> 
##  1 Heritage Christian University                        NA             NA AL    
##  2 University of California-Santa Barbara             1370          39000 CA    
##  3 California Polytechnic State University-San Lu…    1342          52100 CA    
##  4 University of California-Irvine                    1306          41100 CA    
##  5 California Institute of the Arts                     NA          26900 CA    
##  6 University of Miami                                1371          47500 FL    
##  7 Georgia Institute of Technology-Main Campus        1418          65500 GA    
##  8 Point University                                    986          27300 GA    
##  9 Grinnell College                                   1457          32800 IA    
## 10 St Luke's College                                    NA          45300 IA    
## 11 Purdue University Northwest                        1074             NA IN    
## 12 Alice Lloyd College                                1040          25300 KY    
## 13 Wellesley College                                  1452          44900 MA    
## 14 Boston College                                     1437          57000 MA    
## 15 Brandeis University                                1434          41700 MA    
## 16 Babson College                                     1362          70400 MA    
## 17 Laboure College                                      NA          52000 MA    
## 18 Coppin State University                             903          28500 MD    
## 19 University of Michigan-Ann Arbor                   1448          49800 MI    
## 20 University of North Carolina at Chapel Hill        1402          41000 NC    
## 21 University of North Carolina School of the Arts    1202          23800 NC    
## 22 Cabarrus College of Health Sciences                1063          41600 NC    
## 23 Carolina University                                 979             NA NC    
## 24 Wake Forest University                               NA          51100 NC    
## 25 Webb Institute                                     1465             NA NY    
## 26 Vassar College                                     1452          36100 NY    
## 27 Colgate University                                 1437          47700 NY    
## 28 University of Rochester                            1418          44800 NY    
## 29 Case Western Reserve University                    1436          59600 OH    
## 30 Denison University                                 1328          38900 OH    
## 31 Kettering College                                  1135          48800 OH    
## 32 Art Academy of Cincinnati                           958          22400 OH    
## 33 Villanova University                               1422          62600 PA    
## 34 Rhode Island School of Design                      1349          40300 RI    
## 35 Trinity University                                 1381          45700 TX    
## 36 University of Virginia-Main Campus                 1436          50300 VA    
## 37 University of Richmond                             1395          46900 VA

Quick Exercise 1: Choose a different college and two different things about that college. Have R print the output.

# INSERT CODE HERE

Summarizing Data

To summarize data, we use the summarize command. Inside that command, we tell R two things: what to call the new variable that we’re creating, and what numerical summary we would like. The code below summarizes median debt for the colleges in the dataset by calculating the average of median debt for all institutions.

df%>%
  summarize(mean_debt=mean(grad_debt_mdn,na.rm=TRUE))

## # A tibble: 1 × 1
##   mean_debt
##       <dbl>
## 1    19646.

df%>%
  summarize(median_debt=median(grad_debt_mdn,na.rm=TRUE))

## # A tibble: 1 × 1
##   median_debt
##         <int>
## 1       21500

Quick Exercise 2: Summarize the average entering SAT scores in this dataset.

# INSERT CODE HERE

Combining Commands

We can also combine commands, so that summaries are done on only a part of the dataset. Below, we summarize median debt for selective schools, and not very selective schools.

df%>%
  filter(adm_rate<.1)%>%
  summarize(mean_debt=mean(grad_debt_mdn,na.rm=TRUE))

## # A tibble: 1 × 1
##   mean_debt
##       <dbl>
## 1    16178.

What about for not very selective schools?

df%>%
  filter(adm_rate>.3)%>%
  summarize(mean_debt=mean(grad_debt_mdn,na.rm=TRUE))

## # A tibble: 1 × 1
##   mean_debt
##       <dbl>
## 1    23230.

Quick Exercise 3: Calculate average earnings for schools where SAT>1200

# INSERT CODE HERE

Quick Exercise 4: Calculate the average debt for schools that admit over 50% of the students who apply.

# INSERT CODE HERE

Manipulating data in `R`

Mon, 01 Jan 0001 00:00:00 +0000

Agenda

We’re going to go quickly back over loading data and then return to the topic of filtering, selecting and arranging data. We’ll then turn to some calculations using the concepts of summarizing (self explanatory) and mutating (creating new variables).

Rmarkdown

To recap, an Rmarkdown file contains two basic elements: text and code. That text and code can be combined or “knitted” into a variety of different document formats. Lets get you started by creating your own Rmarkdown file and knitting it.

Load relevant libraries

library(tidyverse)

Load The Data

Remember to download the data from the course webpage and save it to the data folder you created. You should then open it in R by assigning it to an object with the <- command. Below, I load the file directly from the Github Repository for the course, but (again) you should load it from your local system.

df<-read_rds("https://github.com/rweldzius/PSC4175/raw/main/static/data/sc_debt.Rds") 
names(df)

##  [1] "unitid"         "instnm"         "stabbr"         "grad_debt_mdn" 
##  [5] "control"        "region"         "preddeg"        "openadmp"      
##  [9] "adm_rate"       "ccbasic"        "sat_avg"        "md_earn_wne_p6"
## [13] "ugds"           "costt4_a"       "selective"      "research_u"

Name	Definition
unitid	Unit ID
instnm	Institution Name
stabbr	State Abbreviation
grad_debt_mdn	Median Debt of Graduates
control	Control Public or Private
region	Census Region
preddeg	Predominant Degree Offered: Associates or Bachelors
openadmp	Open Admissions Policy: 1= Yes, 2=No,3=No 1st time students
adm_rate	Admissions Rate: proportion of applications accepted
ccbasic	Type of institution– see here
selective	Institution admits fewer than 10 % of applicants, 1=Yes, 0=No
research_u	Institution is a research university 1=Yes, 0=No
sat_avg	Average Sat Scores
md_earn_wne_p6	Average Earnings of Recent Graduates
ugds	Number of undergraduates

Looking at datasets

We can use “glimpse” to see what’s in a dataset. This gives a very quick rundown of the variables and the first few observations.

glimpse(df)

## Rows: 2,546
## Columns: 16
## $ unitid         <int> 100654, 100663, 100690, 100706, 100724, 100751, 100760,…
## $ instnm         <chr> "Alabama A & M University", "University of Alabama at B…
## $ stabbr         <chr> "AL", "AL", "AL", "AL", "AL", "AL", "AL", "AL", "AL", "…
## $ grad_debt_mdn  <int> 33375, 22500, 27334, 21607, 32000, 23250, 12500, 19500,…
## $ control        <chr> "Public", "Public", "Private", "Public", "Public", "Pub…
## $ region         <chr> "Southeast", "Southeast", "Southeast", "Southeast", "So…
## $ preddeg        <chr> "Bachelor's", "Bachelor's", "Associate", "Bachelor's", …
## $ openadmp       <int> 2, 2, 1, 2, 2, 2, 1, NA, 2, 2, 2, 1, 1, 2, 1, 1, 2, 2, …
## $ adm_rate       <dbl> 0.9175, 0.7366, NA, 0.8257, 0.9690, 0.8268, NA, NA, 0.9…
## $ ccbasic        <int> 18, 15, 20, 16, 19, 15, 2, 22, 18, 15, 21, 1, 5, 19, 7,…
## $ sat_avg        <int> 939, 1234, NA, 1319, 946, 1261, NA, NA, 1082, 1300, 123…
## $ md_earn_wne_p6 <int> 25200, 35100, 30700, 36200, 22600, 37400, 23100, 33400,…
## $ ugds           <int> 5271, 13328, 365, 7785, 3750, 31900, 1201, 2677, 4407, …
## $ costt4_a       <int> 23053, 24495, 14800, 23917, 21866, 29872, 10493, NA, 19…
## $ selective      <dbl> 0, 0, NA, 0, 0, 0, NA, NA, 0, 0, 0, NA, NA, 0, NA, NA, …
## $ research_u     <dbl> 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…

Types of Variables

Notice that for each variable, it shows a different type, in angle brackets <>. So for instance, instnm has a type of <chr>. This is short for character– it’s also called a string variable.

Here are the types of data in this dataset

<int> Integer data
<chr> Character or string data
<dbl> Double, (double-precision floating point) or just numeric data– can be measured down to an arbitrary number of data points.

This information is useful, because we wouldn’t want to try to run some kind of numeric analysis on string data. The average of institution names wouldn’t make a lot of sense (but it would probably be Southeast State College University of the Northwest).

We’ll talk more about data types later, but we should also quickly note that there are some variables in this dataset where the numbers represent a characteristic, rather and a measurement. For instance, the variable research_u is set up—coded— such that a “1” indicates that the college is a research university and a “0” indicates that it is not a research university. The 1 and 0 don’t measure anything, they just indicate a characteristic.

Filter, Select, Arrange

Today, we’ll pick up where we left off– with the key commands of filter, select, and arrange.

In exploring data, many times we want to look at smaller parts of the dataset. There are three commands we’ll use today that help with this.

-filter selects only those cases or rows that meet some logical criteria.

-select selects only those variables or columns that meet some criteria

-arrange arranges the rows of a dataset in the way we want.

For more on these, please see this vignette.

We can look at the first 5 rows:

head(df)

## # A tibble: 6 × 16
##   unitid instnm    stabbr grad_debt_mdn control region preddeg openadmp adm_rate
##    <int> <chr>     <chr>          <int> <chr>   <chr>  <chr>      <int>    <dbl>
## 1 100654 Alabama … AL             33375 Public  South… Bachel…        2    0.918
## 2 100663 Universi… AL             22500 Public  South… Bachel…        2    0.737
## 3 100690 Amridge … AL             27334 Private South… Associ…        1   NA    
## 4 100706 Universi… AL             21607 Public  South… Bachel…        2    0.826
## 5 100724 Alabama … AL             32000 Public  South… Bachel…        2    0.969
## 6 100751 The Univ… AL             23250 Public  South… Bachel…        2    0.827
## # ℹ 7 more variables: ccbasic <int>, sat_avg <int>, md_earn_wne_p6 <int>,
## #   ugds <int>, costt4_a <int>, selective <dbl>, research_u <dbl>

Or the last 5 rows:

tail(df)

## # A tibble: 6 × 16
##   unitid instnm    stabbr grad_debt_mdn control region preddeg openadmp adm_rate
##    <int> <chr>     <chr>          <int> <chr>   <chr>  <chr>      <int>    <dbl>
## 1 493716 Yeshiva … NJ                NA Private North… Associ…        2    0.477
## 2 493725 Universi… AR                NA Public  South… Bachel…        1   NA    
## 3 493822 College … RI                NA Private New E… Bachel…        1   NA    
## 4 494630 Christ M… TX                NA Private South… Bachel…        1   NA    
## 5 494685 Urshan C… MO                NA Private Plains Bachel…        2    0.836
## 6 494737 Yeshiva … NY                NA Private North… Bachel…        1   NA    
## # ℹ 7 more variables: ccbasic <int>, sat_avg <int>, md_earn_wne_p6 <int>,
## #   ugds <int>, costt4_a <int>, selective <dbl>, research_u <dbl>

Using filter in combination with other commands

filter can be used with any command that retruns true or false. This can be really powerful, for instance the command str_detect “detects” the relevant string in the data, so we can look for any college with the word “Colorado” in its name.

df%>%
  filter(str_detect(instnm,"Colorado"))%>%
  select(instnm,adm_rate,sat_avg)

## # A tibble: 12 × 3
##    instnm                                                adm_rate sat_avg
##    <chr>                                                    <dbl>   <int>
##  1 University of Colorado Denver/Anschutz Medical Campus    0.673    1124
##  2 University of Colorado Colorado Springs                  0.872    1136
##  3 University of Colorado Boulder                           0.784    1276
##  4 Colorado Christian University                           NA          NA
##  5 Colorado College                                         0.135      NA
##  6 Colorado School of Mines                                 0.531    1342
##  7 Colorado State University-Fort Collins                   0.814    1204
##  8 Colorado Mesa University                                 0.782    1063
##  9 University of Northern Colorado                          0.908    1096
## 10 Colorado State University Pueblo                         0.930    1047
## 11 Western Colorado University                              0.842    1114
## 12 Colorado State University-Global Campus                  0.986    1048

We can combine this with the | operator, which remember stands for “or.” Let’s say we want all the institutions in Colorado OR California.

df%>%
  filter(str_detect(instnm,"Colorado") | str_detect(instnm,"California"))%>%
  select(instnm,adm_rate,sat_avg)

## # A tibble: 57 × 3
##    instnm                                                  adm_rate sat_avg
##    <chr>                                                      <dbl>   <int>
##  1 California Institute of Integral Studies                 NA           NA
##  2 California Baptist University                             0.783     1096
##  3 California College of the Arts                            0.850       NA
##  4 California Institute of Technology                        0.0642    1557
##  5 California Lutheran University                            0.714     1168
##  6 California Polytechnic State University-San Luis Obispo   0.284     1342
##  7 California State University-Bakersfield                   0.807       NA
##  8 California State University-Stanislaus                    0.893       NA
##  9 California State University-San Bernardino                0.686      985
## 10 California State Polytechnic University-Pomona            0.546     1143
## # ℹ 47 more rows

We can also put this together in one (notice that everything goes inside the quotes)

df%>%
  filter(str_detect(instnm,"Colorado|California"))%>%
  select(instnm,adm_rate,sat_avg)

## # A tibble: 57 × 3
##    instnm                                                  adm_rate sat_avg
##    <chr>                                                      <dbl>   <int>
##  1 California Institute of Integral Studies                 NA           NA
##  2 California Baptist University                             0.783     1096
##  3 California College of the Arts                            0.850       NA
##  4 California Institute of Technology                        0.0642    1557
##  5 California Lutheran University                            0.714     1168
##  6 California Polytechnic State University-San Luis Obispo   0.284     1342
##  7 California State University-Bakersfield                   0.807       NA
##  8 California State University-Stanislaus                    0.893       NA
##  9 California State University-San Bernardino                0.686      985
## 10 California State Polytechnic University-Pomona            0.546     1143
## # ℹ 47 more rows

Reminder: logical operators

Here are (many of) the logical operators that we use in R:

>, <: greater than, less than
>=, <=: greater than or equal to, less than or equal to
! :not, as in != not equal to
& AND
| OR

Quick Exercise 1 Select colleges that are from Texas AND have the word “community” in their name (the name variable is instnm).

# INSERT CODE HERE

Extending Select

Select can also be used with other characteristics.

For quick guide on this: https://dplyr.tidyverse.org/reference/select.html

For example, we can select just variables that contain the word “region”

df%>%
  select(contains("region"))

## # A tibble: 2,546 × 1
##    region   
##    <chr>    
##  1 Southeast
##  2 Southeast
##  3 Southeast
##  4 Southeast
##  5 Southeast
##  6 Southeast
##  7 Southeast
##  8 Southeast
##  9 Southeast
## 10 Southeast
## # ℹ 2,536 more rows

contains() and matches() are equivalent functions

df %>%
  select(matches('region'))

## # A tibble: 2,546 × 1
##    region   
##    <chr>    
##  1 Southeast
##  2 Southeast
##  3 Southeast
##  4 Southeast
##  5 Southeast
##  6 Southeast
##  7 Southeast
##  8 Southeast
##  9 Southeast
## 10 Southeast
## # ℹ 2,536 more rows

We can augment these with the logical operators listed above

# Removes columns with "inst" in their names
df %>%
  select(!matches('inst'))

## # A tibble: 2,546 × 15
##    unitid stabbr grad_debt_mdn control region  preddeg openadmp adm_rate ccbasic
##     <int> <chr>          <int> <chr>   <chr>   <chr>      <int>    <dbl>   <int>
##  1 100654 AL             33375 Public  Southe… Bachel…        2    0.918      18
##  2 100663 AL             22500 Public  Southe… Bachel…        2    0.737      15
##  3 100690 AL             27334 Private Southe… Associ…        1   NA          20
##  4 100706 AL             21607 Public  Southe… Bachel…        2    0.826      16
##  5 100724 AL             32000 Public  Southe… Bachel…        2    0.969      19
##  6 100751 AL             23250 Public  Southe… Bachel…        2    0.827      15
##  7 100760 AL             12500 Public  Southe… Associ…        1   NA           2
##  8 100812 AL             19500 Public  Southe… Bachel…       NA   NA          22
##  9 100830 AL             24826 Public  Southe… Bachel…        2    0.904      18
## 10 100858 AL             21281 Public  Southe… Bachel…        2    0.807      15
## # ℹ 2,536 more rows
## # ℹ 6 more variables: sat_avg <int>, md_earn_wne_p6 <int>, ugds <int>,
## #   costt4_a <int>, selective <dbl>, research_u <dbl>

# Selects columns with either "inst" or an underline in their names
df %>%
  select(matches('inst|_'))

## # A tibble: 2,546 × 7
##    instnm      grad_debt_mdn adm_rate sat_avg md_earn_wne_p6 costt4_a research_u
##    <chr>               <int>    <dbl>   <int>          <int>    <int>      <dbl>
##  1 Alabama A …         33375    0.918     939          25200    23053          0
##  2 University…         22500    0.737    1234          35100    24495          0
##  3 Amridge Un…         27334   NA          NA          30700    14800          0
##  4 University…         21607    0.826    1319          36200    23917          1
##  5 Alabama St…         32000    0.969     946          22600    21866          0
##  6 The Univer…         23250    0.827    1261          37400    29872          0
##  7 Central Al…         12500   NA          NA          23100    10493          0
##  8 Athens Sta…         19500   NA          NA          33400       NA          0
##  9 Auburn Uni…         24826    0.904    1082          30100    19849          0
## 10 Auburn Uni…         21281    0.807    1300          39500    31590          0
## # ℹ 2,536 more rows

We can also select just variables by their type using where()

# Select only numeric variables
df%>%
  select(where(is.numeric))

## # A tibble: 2,546 × 11
##    unitid grad_debt_mdn openadmp adm_rate ccbasic sat_avg md_earn_wne_p6  ugds
##     <int>         <int>    <int>    <dbl>   <int>   <int>          <int> <int>
##  1 100654         33375        2    0.918      18     939          25200  5271
##  2 100663         22500        2    0.737      15    1234          35100 13328
##  3 100690         27334        1   NA          20      NA          30700   365
##  4 100706         21607        2    0.826      16    1319          36200  7785
##  5 100724         32000        2    0.969      19     946          22600  3750
##  6 100751         23250        2    0.827      15    1261          37400 31900
##  7 100760         12500        1   NA           2      NA          23100  1201
##  8 100812         19500       NA   NA          22      NA          33400  2677
##  9 100830         24826        2    0.904      18    1082          30100  4407
## 10 100858         21281        2    0.807      15    1300          39500 24209
## # ℹ 2,536 more rows
## # ℹ 3 more variables: costt4_a <int>, selective <dbl>, research_u <dbl>

Quick Exercise 2 Use the same setup to select only character variables (is.character)

# INSERT CODE HERE

Summarizing Data

To summarize data, we use the summarize command. Inside that command, we tell R two things: what to call the new object (a data frame, really) that we’re creating, and what numerical summary we would like. The code below summarizes median debt for the colleges in the dataset by calculating the average of median debt for all institutions.

Notice that inside the mean command

df%>%
  summarize(mean_debt=mean(grad_debt_mdn,na.rm=TRUE))

## # A tibble: 1 × 1
##   mean_debt
##       <dbl>
## 1    19646.

Quick Exercise 3 Summarize the average entering SAT scores in this dataset.

# INSERT CODE HERE

Combining Commands

We can also combine commands, so that summaries are done on only a part of the dataset. Below, we summarize median debt for selective schools, and not very selective schools.

df%>%
  filter(stabbr=="CA")%>%
  summarize(mean_adm_rate=mean(adm_rate,na.rm=TRUE))

## # A tibble: 1 × 1
##   mean_adm_rate
##           <dbl>
## 1         0.592

Quick Exercise 4 Calculate average earnings for schools where SAT>1200 & the admissions rate is between 10 and 20 percent.

# INSERT CODE HERE

Mutate

mutate is the verb for changing variables in R. Let’s say we want to create a variable that’s set to 1 if the college admits less than 10 percent of the students who apply.

df<-df%>%
  mutate(selective=ifelse(adm_rate<=.1,1,0))

The ifelse() function is powerful. It allows us to create one value if a logical expression is TRUE, and another value if the logical expression is FALSE. The inputs are: ifelse([LOGIC],[VALUE IF TRUE],[VALUE IF FALSE]). In this example, the “logical expression” is adm_rate <= 0.1. For every row where this is TRUE, we get the value 1. For every row where this is FALSE, we get the value 0.

Quick Exercise 5 Create a new variable that’s set to 1 if the college has more than 10,000 undergraduate students

# INSERT CODE HERE

Or what if we want to create another new variable that changes the admissions rate from its current proportion to a percent?

df<-df%>%
  mutate(adm_rate_pct=adm_rate*100)

To figure out if that worked we can use summarize

df%>%
  summarize(mean_adm_rate_pct=mean(adm_rate_pct,na.rm=TRUE))

## # A tibble: 1 × 1
##   mean_adm_rate_pct
##               <dbl>
## 1              67.9

Grouping

Above, we calculated the mean_adm_rate for schools in California by combining a filter() command with a summarise() command. Let’s use the same approach to calculate the average SAT score for schools that are selective and for those that aren’t.

# Mean SAT for selective schools
df %>%
  filter(selective == 1) %>%
  summarise(SATavg = mean(sat_avg,na.rm=T))

## # A tibble: 1 × 1
##   SATavg
##    <dbl>
## 1  1510.

# Mean SAT for non-selective schools
df %>%
  filter(selective == 0) %>%
  summarise(SATavg = mean(sat_avg,na.rm=T))

## # A tibble: 1 × 1
##   SATavg
##    <dbl>
## 1  1135.

This works, but requires two separate chunks of code. We can streamline this analysis with the group_by() function, which tells R to run a command on each group separately. Thus:

df %>%
  group_by(selective) %>%
  summarise(SATavg = mean(sat_avg,na.rm=T))

## # A tibble: 3 × 2
##   selective SATavg
##       <dbl>  <dbl>
## 1         0  1135.
## 2         1  1510.
## 3        NA   NaN

Quick Exercise 6 Do the same, but calculate the average SAT score for each state, using group_by().

# INSERT CODE HERE

Multivariate Analysis, Part 2

Mon, 01 Jan 0001 00:00:00 +0000

Recap

Recall that we have tested Trump’s theory that the MSM was biased against him. We found that polls that underpredicted Trump also underpredicted Biden. This is not what we would expect if the polls favored one candidate over another.

Loading the data

require(tidyverse)
require(scales)
Pres2020.PV <- read_rds(file="https://github.com/rweldzius/PSC4175/raw/main/static/data/Pres2020_PV.Rds")
Pres2020.PV <- Pres2020.PV %>%
                mutate(Trump = Trump/100,
                      Biden = Biden/100,
                      margin = Biden - Trump)

Pres2020.PV %>%
  ggplot(aes(x = Biden, y = Trump)) + 
  labs(title="Biden and Trump Support in 2020 National Popular Vote",
       y = "Trump Support",
       x = "Biden Support") + 
  geom_jitter(color="purple",alpha = .5) + 
    scale_y_continuous(breaks=seq(0,1,by=.05),
                     labels= scales::percent_format(accuracy = 1)) +
  scale_x_continuous(breaks=seq(0,1,by=.05),
                     labels= scales::percent_format(accuracy = 1))

What is an alternative explanation for these patterns? Why would polls underpredict both Trump and Biden?

Perhaps they were fielded earlier in the year, when more people were interested in third party candidates, or hadn’t made up their mind.

Visualizing More Dimensions – And Introducing Dates!

How did the support for Biden and Trump vary across the course of the 2020 Election?

What should we measure?
How do we summarize, visualize, and communicate?

Give you some tools to do some amazing things!

Telling Time

Time is often a critical descriptive variable. (Not causal!)
Also useful for prediction ?
We want to evaluate the properties of presidential polling as Election Day 2020 approached.
Necessary for prediction – we want most recent data to account for last-minute shift.
Necessary for identifying when changes occurred (and why?)

Dates in R

Dates are a special format in R (character with quasi-numeric properties)

election.day <- as.Date("11/3/2020", "%m/%d/%Y")   
election.day16 <- as.Date("11/8/2016", "%m/%d/%Y")

Difference in “dates” versus difference in integers?

election.day - election.day16

## Time difference of 1456 days

as.numeric(election.day - election.day16)

## [1] 1456

Initial Questions

How many polls were publicly done and reported in the media about the national popular vote?
When did the polling occur? Did most of the polls occur close to Election Day?

So, for every day, how many polls were reported by the media?

Note that we could also look to see if the poll results depend on how the poll is being done (i.e., the Mode used to contact respondents) or even depending on who funded (Funded) or conducted (Conducted) the polls. We could also see if larger polls (i.e., polls with more respondents SampleSize) or polls that took longer to conduct (DaysInField) were more or less accurate.

Let’s Wrangle…

Pres2020.PV <- Pres2020.PV %>%
                mutate(EndDate = as.Date(EndDate, "%m/%d/%Y"), 
                      StartDate = as.Date(StartDate, "%m/%d/%Y"),
                      DaysToED = as.numeric(election.day - EndDate),
                      Trump = Trump/100,
                      Biden = Biden/100,
                      margin = Biden - Trump)

What are we plotting?

Media Question: how does the number of polls change over time?
Data Scientist Question: What do we need to plot? margin or DaysToED?
What will each produce?
Are they discrete/categorical (barplot) or continuous (histogram)?

ggplot(data = Pres2020.PV, aes(x = DaysToED)) +
  labs(title = "Number of 2020 National Polls Over Time",
       x = "Number of Days until Election Day",
       y = "Number of Polls") + 
  geom_bar(fill="purple", color= "black") +
  scale_x_continuous(breaks=seq(0,230,by=10)) +
  scale_y_continuous(labels = label_number(accuracy = 1))

So this is a bit weird because it arranges the axis from smallest to largest even though that is in reverse chronological order. Since November comes after January it may make sense to flip the scale so that the graph plots polls that are closer to Election Day as the reader moves along the scale to the left.

ggplot(data = Pres2020.PV, aes(x = DaysToED)) +
  labs(title = "Number of 2020 National Polls Over Time") + 
  labs(x = "Number of Days until Election Day") + 
  labs(y = "Number of Polls") + 
  geom_bar(fill="purple", color= "black") +
  scale_x_reverse(breaks=seq(0,230,by=10)) +
  scale_y_continuous(labels = label_number(accuracy = 1))

But is the bargraph the right plot to use? Should we plot every single day given that we know some days might contain fewer polls (e.g., weekends)? What if we to use a histogram instead to plot the number of polls that occur in a set interval of time (to be defined by the number of bins chosen)?

ggplot(data = Pres2020.PV, aes(x = DaysToED)) +
  labs(title = "Number of 2020 National Polls Over Time") + 
  labs(x = "Number of Days until Election Day") + 
  labs(y = "Number of Polls") + 
  geom_histogram(color="PURPLE",bins = 30) +
  scale_x_reverse()

Which do you prefer? Why or why not? Data Science is sometimes as much art as it is science - especially when it comes to data visualization!

Bivariate/Multivariate relationships

Most of what we do is a relationship between (at least) 2 variables.
Here we are interested in how the margin varies as Election Day approaches: margin by DaysToED.
Want to plot X (variable that “explains”) vs. Y (variable being “explained”):

A very frequently used plot is the scatterplot that shows the relationship between two variables. To do so we are going to define an aesthetic when calling ggplot that defines both an x-variable (here EndDate) and a y-variable (here margin).

First, a brief aside, we can change the size of the figure being printed in our Rmarkdown by including some commands when defining the R chunk. Much like we could suppress messages (e.g., message=FALSE or tell R not to actually evaluate the chunk eval=FALSE or to run the code but not print the code echo=FALSE) we can add some arguments to this line. For example, the code below defines the figure to be 2 inches tall, 2 inches wide and to be aligned in the center (as opposed to left-justified). As you can see, depending on the choices you make you can destroy the readability of the graphics as ggplot will attempt to rescale the figure accordingly. The dimensions are in inches and they refer to the plotting area – an area that includes labels and margins so it is not the area where the data itself appears.

margin_over_time_plot <- Pres2020.PV %>%
  ggplot(aes(x = EndDate, y = margin)) + 
  labs(title="Margin in 2020 National Popular Vote Polls Over Time",
       y = "Margin: Biden - Trump",
       x = "Poll Ending Date") + 
  geom_point(color="purple")
margin_over_time_plot

To ``fix” this we can call the ggplot object without defining the graphical parameters.

margin_over_time_plot

Ok, back to fixing the graph. What do you think?

Axes looks weird - lots of interpolation required by the consumer.
Data looks “chunky”? How many data points are at each point?

To fix the axis scale we can use scale_y_continuous to chose better labels for the y-axis and we can use scale_x_date to determine how to plot the dates we are plotting. Here we are going to plot at two-week intervals (date_breaks = "2 week") using labels that include the month and date (date_labels - "%b %d").

Note here that we are going to adjust the plot by adding new features to the ggplot object margin_over_time_plot. We could also have created the graph without creating the object.

margin_over_time_plot <- margin_over_time_plot  + 
    scale_y_continuous(breaks=seq(-.1,.2,by=.05),
                     labels= scales::percent_format(accuracy = 1)) +
    scale_x_date(date_breaks = "2 week", date_labels = "%b %d") 
margin_over_time_plot

Now one thing that is hard to know is how many polls are at a particular point. If some points contain a single poll and others contain 1000 polls that matters a lot for how we interpret the relationship.

To help convey this information we can again use geom_jitter and alpha transparency instead of geom_point. Here we are adding +/- .005 to the y-value to change the value of the poll, but not the date. (Note that we could also use position=jitter when calling geom_point). This adds just enough error in the x (width) and y (height) values associated with each point so as to help distinguish how many observations might share a value. We are also going to use the alpha transparency to denote when lots of points occur on a similar (jittered) point. Note that when doing this code we are going to redo the plot from start to finish.

Pres2020.PV %>%
  ggplot(aes(x = EndDate, y = margin)) + 
  labs(title="Margin in 2020 National Popular Vote Polls Over Time",
       y = "Margin: Biden - Trump",
       x = "Poll Ending Date") + 
    geom_jitter(color = "PURPLE",height=.005, alpha = .4) +
    scale_y_continuous(breaks=seq(-.1,.2,by=.05),
                     labels= scales::percent_format(accuracy = 1)) +
    scale_x_date(date_breaks = "2 week", date_labels = "%b %d")

In addition to plotting plotting points using geom_point we can also add lines to the plot using geom_line. The line will connect the values in sequence so it does not always make sense to include. For example, if we add the geom_line to the plot it is hard to make the case that the results are meaningful.

Pres2020.PV %>%
  ggplot(aes(x = EndDate, y = margin)) + 
  labs(title="Margin in 2020 National Popular Vote Polls Over Time",
       y = "Margin: Biden - Trump",
       x = "Poll Ending Date") + 
    geom_jitter(color="purple", alpha = .5) + 
    scale_y_continuous(breaks=seq(-.1,.2,by=.05),
                     labels= scales::percent_format(accuracy = 1)) +
    scale_x_date(date_breaks = "2 week", date_labels = "%b %d") +
  geom_line()

While geom_line may help accentuate variation over time, it is really not designed to summarize a relationship in the data as it is simply connecting sequential points (arranged according to the x-axis). In contrast, if we were to add geom_smooth then the plot would add the average value of nearby points to help summarize the trend. (Note that we have opted to include the associated uncertainty in the moving average off using the se=T parameter in geom_smooth.)

# Using message=FALSE to suppress note about geom_smooth
Pres2020.PV %>%
  ggplot(aes(x = EndDate, y = margin)) + 
  labs(title="Margin in 2020 National Popular Vote Polls Over Time",
       y = "Margin: Biden - Trump",
       x = "Poll Ending Date") + 
    geom_jitter(color="purple", alpha = .5) + 
    scale_y_continuous(breaks=seq(-.1,.2,by=.05),
                     labels= scales::percent_format(accuracy = 1)) +
    scale_x_date(date_breaks = "2 week", date_labels = "%b %d") +
    geom_smooth(color = "BLACK", se=T)

Plotting Multiple Variables Over Time (Time-Series)

Can we plot support for Biden and support for Trump separately over time (on the same plot)?

Let’s define a ggplot object to add to later. Note that this code chuck will not print anything because we need to call the object to see what it produced.

BidenTrumpplot <- Pres2020.PV %>%
  ggplot()  +
  geom_point(aes(x = EndDate, y = Trump), 
             color = "red", alpha=.4)  +
  geom_point(aes(x = EndDate, y = Biden), 
             color = "blue", alpha=.4) +
  labs(title="% Biden and Trump in 2020 National Popular Vote Polls Over Time",
       y = "Pct. Support",
       x = "Poll Ending Date") +
  scale_x_date(date_breaks = "2 week", date_labels = "%b %d") + 
  scale_y_continuous(breaks=seq(.3,.7,by=.05),
                     labels= scales::percent_format(accuracy = 1))

Note the use of aes in geom_point()!

Now call the plot

BidenTrumpplot

Now we are going to add smoothed lines to the ggplot object. The nice thing about having saved the ggplot object above is that to add the smoothed lines we can simply add it to the existing plot. geom_smooth summarizes the average using a subset of the data (the default is 75%) by computing the average value for the closest 75% of the data. Put differently, after sorting the polls by their date it then summarizes the predicted value for a poll taken at that date using the closest 75% of polls according to the date. (It is not taking a mean of those values, but it is doing something similar.) After doing so for the first date, it then does the same for the second date, but now the “closest” data includes polls that happened both before an after. The smoother “moves along” the x-axis and generates a predicted value for each date. Because it is using so much of the data, the values of the line will change very slowly because the only change between two adjacent dates is by dropping and adding new information.

When calling the geom_smooth we used se=T to tell ggplot to produce an estimate of how much the prediction may vary. (This is the 95% confidence interval for the prediction being graphed.)

# Using message=FALSE to suppress note about geom_smooth
BidenTrumpplot +  
  geom_smooth(aes(x = EndDate, y = Trump), 
              color = "red",se=T) + 
  geom_smooth(aes(x = EndDate, y = Biden), 
              color = "blue",se=T)

If we change it to using only the closest 10% of the data by changing span=.1 we get a slightly different relationship. The smoothed lines are less smooth because the impact of adding and removing points is much greater when we are using less data to compute the smoothed value – a single observation can change the overall results much more than when we used so much more data. In addition, the error-bars around the smoother are larger because we are using less data to calculate each point.

# Using message=FALSE to suppress note about geom_smooth
BidenTrumpplot +  
  geom_smooth(aes(x = EndDate, y = Trump), 
              color = "red",se=T,span=.1) + 
  geom_smooth(aes(x = EndDate, y = Biden), 
              color = "blue",se=T,span=.1)

Try some other values to see how things change. Note that you are not changing the data, you are only changing how you are visualizing the relationship over time by deciding how much data to use. In part, the decision of how much data to use is a question of how much you you want to allow public opinion to vary over the course of the campaign – how much of the variation is “real” versus how much is “noise”?

Quick Exercise 1 Choose another span and see how it changes how you interpret how much variation there is in the data over time.

# INSERT CODE

ADVANCED! We can also use fill to introduce another dimension into the visualization. Consider for example, plotting support for Trump over time for mixed-mode polls versus telephone polls versus online-only polls. How would you go about doing this? You want to be careful not to make a mess however. Just because you can doesn’t mean you should!

State Polls and the Electoral College

New functions and libraries:

plotly library
Working with dates
Simple looping

First load the data of all state-level polls for the 2020 presidential election.

Pres2020.StatePolls <- read_rds(file="https://github.com/rweldzius/PSC4175/raw/main/static/data/Pres2020_StatePolls.Rds")
glimpse(Pres2020.StatePolls)

## Rows: 1,545
## Columns: 19
## $ StartDate      <date> 2020-03-21, 2020-03-24, 2020-03-24, 2020-03-28, 2020-0…
## $ EndDate        <date> 2020-03-30, 2020-04-03, 2020-03-29, 2020-03-29, 2020-0…
## $ DaysinField    <dbl> 10, 11, 6, 2, 3, 5, 2, 2, 7, 3, 3, 3, 2, 2, 3, 4, 10, 1…
## $ MoE            <dbl> 2.8, 3.0, 4.2, NA, 4.0, 1.7, 3.0, 3.1, 4.1, 4.4, NA, NA…
## $ Mode           <chr> "Phone/Online", "Phone/Online", "Live phone - RDD", "Li…
## $ SampleSize     <dbl> 1331, 1000, 813, 962, 602, 3244, 1035, 1019, 583, 500, …
## $ Biden          <dbl> 41, 47, 48, 67, 46, 46, 46, 48, 52, 42, 48, 50, 52, 38,…
## $ Trump          <dbl> 46, 34, 45, 29, 46, 40, 48, 45, 39, 49, 47, 41, 43, 49,…
## $ Winner         <chr> "Rep", "Dem", "Dem", "Dem", "Dem", "Rep", "Dem", "Dem",…
## $ poll.predicted <dbl> 1, 1, 1, 1, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1…
## $ Funded         <chr> "UtahPolicy.com & KUTV 2News", "Sacred Heart University…
## $ Conducted      <chr> "Y2 Analytics", "GreatBlue Research", "LHK Partners Inc…
## $ margin         <dbl> -5, 13, 3, 38, 0, 6, -2, 3, 13, -7, 1, 9, 9, -11, 6, -1…
## $ DaysToED       <drtn> 218 days, 214 days, 219 days, 219 days, 216 days, 213 …
## $ StateName      <chr> "Utah", "Connecticut", "Wisconsin", "California", "Mich…
## $ EV             <int> 6, 7, 10, 55, 16, 29, 16, 16, 12, 15, 10, 16, 11, 6, 16…
## $ State          <chr> "UT", "CT", "WI", "CA", "MI", "FL", "GA", "MI", "WA", "…
## $ BidenCertVote  <dbl> 38, 59, 49, 64, 51, 48, 50, 51, 58, 49, 49, 51, 49, 41,…
## $ TrumpCertVote  <dbl> 58, 39, 49, 34, 48, 51, 49, 48, 39, 50, 49, 48, 49, 58,…

Variables of potential interest include:

Biden : Percentage of respondents supporting Biden, the Democrat, in poll (0-100)
Trump : Percentage of respondents supporting Trump, the Republican, in poll (0-100)
BidenCertVote : Percentage of vote Biden, the Democrat, actually received in the election (0-100)
TrumpCertVote : Percentage of vote Trump, the Democrat, actually received in the election (0-100)
Winner : whether Biden won (“Dem”) or Trump won (“Rep”)
poll.predicted : Indicator for whether the poll correctly predicted who won (1) or not (0)
State & StateName : the state where the poll was conducted
EV : the number of Electoral College Votes the state is worth for the winning candidate

Overall Task:

How do we use this data to calculate the probability that Biden will win the presidency of the United States by winning the Electoral College?

Task 1: How should we translate a poll result into a predicted probability?

Suppose that I give you 10 polls from a state.

Load in the data and create the some mutations to create new variables.

Pres2020.StatePolls <- Pres2020.StatePolls %>%
   mutate(BidenNorm = Biden/(Biden+Trump),
          TrumpNorm = 1-BidenNorm,
          Biden = Biden/100,
          Trump=Trump/100)

How can you use them to create a probability? Discuss! (I can think of 3 ways.)

Measure 1: Fraction of polls with Biden in the lead
Measure 2: Biden Pct = Probability Biden wins
Measure 3: Normalized Biden Pct = Probability Biden wins (i.e., all voters either vote for Biden or Trump). Sometimes called “two-party” vote.

How does this vary across states? The joys of group_by(). Note that group_by() defines what happens for all subsequent code in that code chunk. So here we are going to calculate the mean separately for each state.

stateprobs <- Pres2020.StatePolls %>%
    group_by(StateName) %>%
      summarize(BidenProbWin1 = mean(Biden > Trump),
                BidenProbWin2 = mean(Biden),  
                BidenProbWin3 = mean(BidenNorm))

stateprobs

## # A tibble: 50 × 4
##    StateName   BidenProbWin1 BidenProbWin2 BidenProbWin3
##    <chr>               <dbl>         <dbl>         <dbl>
##  1 Alabama             0             0.389         0.407
##  2 Alaska              0             0.442         0.466
##  3 Arizona             0.840         0.484         0.519
##  4 Arkansas            0             0.381         0.395
##  5 California          1             0.618         0.661
##  6 Colorado            1             0.534         0.571
##  7 Connecticut         1             0.584         0.631
##  8 Delaware            1             0.603         0.627
##  9 Florida             0.798         0.486         0.517
## 10 Georgia             0.548         0.474         0.504
## # ℹ 40 more rows

Clearly they differ, so let’s visualize to try to understand what is going on. Install the library plotly

library(plotly)
gg <- stateprobs %>%
  ggplot(aes(x=BidenProbWin2, y=BidenProbWin3,text=paste(StateName))) +
  geom_point() +
  geom_abline(intercept=0,slope=1) +
  labs(x= "Probability as % Support",
       y = "Probability as Two-Party % Support",
       title = "Comparing Probability of Winning Measures")

ggplotly(gg,tooltip = "text")

So removing the undecided and making the probabilities for Biden and Trump sum to 100% is consequential.

What about if we compare these measures to the fration of polls with a given winner? After all, it seems implausible that the Biden would ever lose California or Trump would ever lose Tennessee.

library(plotly)
gg <- stateprobs %>%
  ggplot(aes(x=BidenProbWin2, y=BidenProbWin1,text=paste(StateName))) +
  geom_point() +
  geom_abline(intercept=0,slope=1) +
  labs(x= "Probability as % Support",
       y = "Probability as % Polls Winning",
       title = "Comparing Probability of Winning Measures")

ggplotly(gg,tooltip = "text")

So what do you think? Exactly the same data, but just different impications depending on how you choose to measure the probability of winning a state. Data sciene is as much about argument and reasoning as it is about coding. How we measure a concept is often critical to the conclusions that we get.

Task 2: Start “simple” – calculate the probability that Biden wins PA

But we want to combine these probabilities with the Electoral College votes in each state. Not every state has the same amount of Electoral College votes – it is typically given by the number of Senators (2) plus the number of representatives (at least 1) so we need to account for this if we want to make a projection about who is going to win the Electoral College.

Create a tibble with just polls from PA.

PA.dat <- Pres2020.StatePolls %>% 
  filter(State == "PA")

Now compute these three probabilities. What functions do we need?

PA.dat %>%
      summarize(BidenProbWin1 = mean(Biden > Trump),
                BidenProbWin2 = mean(Biden),  
                BidenProbWin3 = mean(BidenNorm))

## # A tibble: 1 × 3
##   BidenProbWin1 BidenProbWin2 BidenProbWin3
##           <dbl>         <dbl>         <dbl>
## 1         0.916         0.499         0.529

What do you think about this?

Task 3: Given that probability, how do we change the code to compute the expected number of Electoral College Votes `EV` for Biden?

Keep the code from above and copy and paste so you can understand how each step changes what we are doing. Note that we have the number of electoral college votes associated with each state EV that we want to use to compute the expected number of electoral college votes. But recall that when we summarize we change the tibble to be the output of the function. So how do we keep the number of Electoral College votes for a future mutation?

PA.dat %>%
      summarize(BidenProbWin1 = mean(Biden > Trump),
                BidenProbWin2 = mean(Biden),
                BidenProbWin3 = mean(BidenNorm),
                EV = mean(EV)) %>%
      mutate(BidenEV1 = BidenProbWin1*EV,
             BidenEV2 = BidenProbWin2*EV,
             BidenEV3 = BidenProbWin3*EV)

## # A tibble: 1 × 7
##   BidenProbWin1 BidenProbWin2 BidenProbWin3    EV BidenEV1 BidenEV2 BidenEV3
##           <dbl>         <dbl>         <dbl> <dbl>    <dbl>    <dbl>    <dbl>
## 1         0.916         0.499         0.529    20     18.3     9.98     10.6

Note that we are calculation the Expected Value of the Electoral College votes using: Probability that Biden wins state i X Electoral College Votes in State i. This will allocate fractions of Electoral College votes even though the actual election is winner-take all. This is OK because the fractions reflect the probability that an alternative outcome occurs.

Quick Exercise 2 How can we get compute the expected number of Electoral College votes for Trump in each measure? NOTE: There are at least 2 ways to do this because this is a 2 candidate race

# INSERT CODE HERE

EV-BidenEV, or compute TrumpProbWin

Task 4: Now generalize to every state by applying this code to each set of state polls.

What do we need to do this calculation for every state in our tibble?
First, compute probability of winning a state. (How?)
Second, compute expected Electoral College Votes. (How?)

Pres2020.StatePolls %>%  
  group_by(StateName) %>%
    summarize(BidenProbWin1 = mean(Biden > Trump),
              BidenProbWin3 = mean(BidenNorm),
              EV = mean(EV),
              State = first(State)) %>%
    mutate(State = State,
              BidenECVPredicted1 = EV*BidenProbWin1,
              TrumpECVPredicted1 = EV- BidenECVPredicted1,
              BidenECVPredicted3 = EV*BidenProbWin3,
              TrumpECVPredicted3 = EV- BidenECVPredicted3) %>%
  summarize(BidenECVPredicted1=sum(BidenECVPredicted1),
            BidenECVPredicted3=sum(BidenECVPredicted3),
            TrumpECVPredicted1=sum(TrumpECVPredicted1),
            TrumpECVPredicted3=sum(TrumpECVPredicted3),)

## # A tibble: 1 × 4
##   BidenECVPredicted1 BidenECVPredicted3 TrumpECVPredicted1 TrumpECVPredicted3
##                <dbl>              <dbl>              <dbl>              <dbl>
## 1               345.               289.               190.               246.

Task 5: Now compute total expected vote by adding to that code

NOTE: Actually 306 - 232
What do we need to do to the tibble we created in Task 4 to get the overall number of Electoral College Votes?

Pres2020.StatePolls %>%  
  group_by(StateName) %>%
    summarize(BidenProbWin1 = mean(Biden > Trump),
              BidenProbWin3 = mean(BidenNorm),
              EV = mean(EV)) %>%
    mutate(BidenECVPredicted1 = EV*BidenProbWin1,
              TrumpECVPredicted1 = EV- BidenECVPredicted1,
              BidenECVPredicted3 = EV*BidenProbWin3,
              TrumpECVPredicted3 = EV- BidenECVPredicted3) %>%
    summarize(BidenECV1 = sum(BidenECVPredicted1),
              TrumpECV1 = sum(TrumpECVPredicted1),
              BidenECV3 = sum(BidenECVPredicted3),
              TrumpECV3 = sum(TrumpECVPredicted3))

## # A tibble: 1 × 4
##   BidenECV1 TrumpECV1 BidenECV3 TrumpECV3
##       <dbl>     <dbl>     <dbl>     <dbl>
## 1      345.      190.      289.      246.

Quick Exercise 3 Could also do this for just polls conducted in the last 7 days. How?

# INSERT CODE HERE

THINKING: What about states that do not have any polls? What should we do about them? Is there a reason why they might not have a poll? Is that useful information? Questions like this become more relevant when we start to restrict the sample.

Here are the number of polls done in each state in the last 3 days. Note that when we use fewer days our measure based on the percentage of polls won may be more affected?

Pres2020.StatePolls %>%
  filter(DaysToED < 3) %>%
  count(State) %>%
  ggplot(aes(x=n)) +
  geom_bar() + 
  scale_x_continuous(breaks=seq(0,15,by=1)) +
  labs(x="Number of Polls in a State",
       y="Number of States",
       title="Number of Polls in States \n in the Last 3 Days of 2020")

Research Exercise It’s time to work with your own data! In the following not-so-quick exercise, I want you to upload the data you retrieved for your final research project, do any data wrangling that needs to be done, provide univariate plots of two variables of interest, calculate a conditional relationship, then create a multivariate plot. The hardest part will be preparing the data, choosing which variables you want to analyze, and choosing the types of plots based on the type of variables.

Upload your data. Describe for me what this data is about.

# INSERT CODE HERE

Write answer here.

Data wrangling (if needed). If you need to do any wrangling of your data, do it here. If not, leave blank.

# INSERT CODE HERE

Describe what you did here.

Univariate plot of two key variables (preferably an outcome variable Y and an explanatory variable X).

# INSERT CODE HERE

Describe what you see. Do you need to make any adjustments to the variables based on their distributions?

Conditional relationships. Create a cross-tab of the data like you did last time. This will involve using count, mutate, and/or group_by

# INSERT CODE HERE

Create a multivariate plot of your two variables.

# INSERT CODE HERE

Problem Set 0

Mon, 01 Jan 0001 00:00:00 +0000

At the top of all problem sets I will have the following statement. You should follow the statement with the names of classmates with whom you worked and/or upload a PDF of your AI prompt/output.

If you collaborated with a colleague and/or used AI for any help on this problem set, document here. Write the names of your classmates and/or upload a PDF of your AI prompt and output with your problem set:

Problem Set 0: Getting Set Up!

The rest of the semester will see you working on data science questions using R. As such, your first problem set will have you:

Install R on your computer.
Install RStudio on your computer.
Create a directory (i.e., a folder with a set of subfolders) for this class.
Create a new .Rmd file and Save as....
Modify the .Rmd file and knit it.

1. Installing R

R is going to be the only programming language we will use. R is an extensible statistical programming environment that can handle all of the main tasks that we’ll need to cover this semester: getting data, analyzing data and communicating data analysis.

Download R here: https://cran.r-project.org/. Make sure to choose the version that works with your operating system!

2. Installing RStudio

When we work with R, we communicate via the command line. To help automate this process, we can write scripts, which contain all of the commands to be executed. These scripts generate various kinds of output, like numbers on the screen, graphics or reports in common formats (pdf, word). Most programming languages have several I ntegrated D evelopment E nvironments (IDEs) that encompass all of these elements (scripts, command line interface, output). The primary IDE for R is RStudio.

Download RStudio here: https://rstudio.com/products/rstudio/download/. You need the free RStudio desktop version.

3. Setting up Directories

In each class, we’re going to include some code and text in one file, and data in another file. You’ll need to download both of these files to your computer. You need to have a particular place to put these files. Computers are organized using named directories (sometimes called folders). Don’t just put the files in your Downloads directory. One common solution is to created a folder on your computer named after the class: PSC4175.

You could just throw everything related to the class into this folder. However, this will quickly get messy. I recommend you create a “sub-folder” (or “sub-directory”) within PSC4175 called Lecture_1. (You might also want to create similar sub-folders for Lecture_2.) Inside Lecture_1, create two additional sub-folders: code and data. When you’re done, your class directory should look like this:

PSC4175
- Lecture_1
  - code
  - data

4. Create an `.Rmd` file

Open RStudio, then create a new .Rmd file. To do this, click on File → New File → R Markdown....

Settings for `.Rmd` file

Saving `.Rmd` file

This will open a new .Rmd file! Now you should change the title of the file to “Problem Set 0” and the author to your name. You should then save the file in your code folder with the file name [Last Name]_PS0.Rmd by clicking File → Save As....

5. Modify and `knit`

Now, delete all of the default text in your .Rmd file from line 12 down to the bottom. Then write the following on line 12:

# Problem Set 0
I can take notes by just typing normally.

Now let’s knit the file by clicking the down arrow next to the Knit button on the top of the window and selecting Knit to PDF. If this didn’t work, see Homework 1 for instructions.

Inserting R Code

The final part of the homework assignment is to insert a chunk of R code. On line 15 type the following:

```{r}
2+2
```

Then knit a final time and upload the PDF to Blackboard under the Problem Set 0 assignment!

Problem Set 1

Mon, 01 Jan 0001 00:00:00 +0000

Getting Set Up

All of the following questions should be answered in this .Rmd file. There are code chunks with incomplete code that need to be filled in.

This problem set is worth 7 total points, plus 1 extra credit point. The point values for each question are indicated in brackets below. To receive full credit, you must have the correct code and answer. In addition, some questions ask you to provide a written response in addition to the code.

You are free to rely on whatever resources you need to complete this problem set, including lecture notes, lecture presentations, Google, your classmates…you name it. However, the final submission must be complete by you. There are no group assignments. To submit, compile the completed problem set and upload the PDF file to Drobox on Friday by midnight. If you use AI for help, choose to save your output as a PDF and submit this with the problem set as well; you can also include the link to your ChatGPT conversation (double-check that it goes back to your specific conversation!). Also note that I will not respond to Campuswire messages after 4PM ET on Friday, so don’t wait until the last minute to get started!

Good luck!

Part 1: All about college

[4.5 points possible; 0.5 extra credit points]

Question 0 [0 points]

Require tidyverse and load the sc_debt.Rds data by assigning it to an object named df.

require() # Load tidyverse

## Loading required package:

df <- read_rds() # Load the dataset directly from github

## Error in read_rds(): could not find function "read_rds"

Question 1 [0.25 points]

Which school has the lowest admission rate (adm_rate) and which state is it in (stabbr)?

df %>% 
  arrange() %>% # Arrange by the admission rate
  select() # Select the school name, the admission rate, and the state

## Error in df %>% arrange() %>% select(): could not find function "%>%"

Question 2 [0.25 points]

Which are the top 10 schools by average SAT score (sat_avg)?

df %>%
  arrange() %>% # arrange by SAT scores in descending order
  select() %>% # Select the school name and SAT score
  print() # Print the first 12 rows (hint: there is a tie)

## Error in df %>% arrange() %>% select() %>% print(): could not find function "%>%"

Question 3 [0.25 points]

Create a new variable called adm_rate_pct which is the admissions rate multiplied by 100 to convert from a 0-to-1 decimal to a 0-to-100 percentage point.

df <- df %>% # Use the object assignment operator to overwrite the df object
  mutate() # Create the new variable adm_rate_pct

## Error in df %>% mutate(): could not find function "%>%"

Question 4 [0.25 points]

Calculate the average SAT score and median earnings of recent graduates by state.

df %>%
  group_by() %>% # Calculate state-by-state with group_by()
  summarise(sat_avg = , # Summarise the average SAT
            earn_avg = ) # Summarise the average earnings

## Error in df %>% group_by() %>% summarise(sat_avg = , earn_avg = ): could not find function "%>%"

Extra Credit [0.5 points]

Plot the average SAT score (x-axis) against the median earnings of recent graduates (y-axis) by school, and add the line of best fit. What relationship do you observe? Why do you think this relationship exists?

# INSERT CODE HERE

Question 5 [1.5 points]

Research Question: Do students who graduate from smaller schools (i.e., schools with smaller student bodies) make more money in their future careers? Before looking at the data, write out what you think the answer is, and explain why you think so.

Based on this research question, what is the outcome / dependent / $Y$ variable and what is the explanatory / independent / $X$ variable? Create the scatterplot of the data based on this answer, along with a line of best fit. Is your answer to the research question supported?

df %>%
  ggplot(aes(x = , # Put the explanatory variable on the x-axis
             y = )) +  # Put the outcome variable on the y-axis
  geom_point() + # Create a scatterplot
  geom_smooth() + # Add line of best fit
  labs(title = '', # give the plot meaningful labels to help the viewer understand it
       x = '',
       y = '')

## Error in df %>% ggplot(aes(x = , y = )): could not find function "%>%"

Question 6 [1 points]

Does this relationship change by whether the school is a research university? Using the filter() function, create two versions of the plot, one for research universities and the other for non-research universities.

df %>%
  filter() %>% # Filter to non-research universities
  ggplot(aes(x = , # Put the explanatory variable on the x-axis
             y = )) +  # Put the outcome variable on the y-axis
  geom_point() + # Create a scatterplot
  geom_smooth() + # Add line of best fit
  labs(title = '', # give the plot meaningful labels to help the viewer understand it
       subtitle = '', 
       x = '',
       y = '')

## Error in df %>% filter() %>% ggplot(aes(x = , y = )): could not find function "%>%"

df %>%
  filter() %>% # Filter to research universities
  ggplot(aes(x = , # Put the explanatory variable on the x-axis
             y = )) +  # Put the outcome variable on the y-axis
  geom_point() + # Create a scatterplot
  geom_smooth() + # Add line of best fit
  labs(title = '', # give the plot meaningful labels to help the viewer understand it
       subtitle = '', 
       x = '',
       y = '')

## Error in df %>% filter() %>% ggplot(aes(x = , y = )): could not find function "%>%"

Question 7 [1 point]

Instead of creating two separate plots, color the points by whether the school is a research university. To do this, you first need to modify the research_u variable to be categorical (it is currently stored as numeric). To do this, use the mutate command with ifelse() to create a new variable called research_u_cat which is either “Research” if research_u is equal to 1, and “Non-Research” otherwise.

df <- df %>%
  mutate(research_u_cat = ifelse()) # Create a labeled version of the research_u variable

## Error in df %>% mutate(research_u_cat = ifelse()): could not find function "%>%"

df %>%
  ggplot(aes(x = , # Put the explanatory variable on the x-axis
             y = , # Put the outcome variable on the y-axis
             color = )) + # Color the points by the new variable you created above
  geom_point() + # Create a scatterplot
  geom_smooth() + # Add line of best fit
  labs(title = '', # give the plot meaningful labels to help the viewer understand it
       x = '',
       color = '',
       y = '')

## Error in df %>% ggplot(aes(x = , y = , color = )): could not find function "%>%"

Part 2: Learning about the 2020 elections from Michigan exit polling

[2.5 points; +0.5 extra credit point available]

For part 2 of this problem set, we will be using the MI2020_ExitPoll.Rds file from the course github page.

Question 8 [0 points]

Require an additional package called labelled (remember to install.packages("labelled") if you don’t have it yet) and load the MI2020_ExitPoll.Rds data to an object called MI_raw. (Tip: use the read_rds() function.)

require()

## Loading required package:

MI_raw <- read_rds('')

## Error in read_rds(""): could not find function "read_rds"

What is the unit of analysis in this dataset? How many variables does it have? How many observations?

Question 9 [0.5 points]

This has too much information that we don’t care about. Create a new object called MI_clean that contains only the following variables:

AGE10
SEX
PARTYID
EDUC18
PRSMI20
QLT20
LGBT
BRNAGAIN
LATINOS
QRACEAI
WEIGHT

and then list which of these variables contain missing data recorded as NA. How many respondents were not asked certain questions?

MI_clean <- MI_raw %>% 
  select() # Select the requested variables

## Error in MI_raw %>% select(): could not find function "%>%"

summary() # Identify which have missing data recorded as NA

## Error in summary.default(): argument "object" is missing, with no default

Question 10 [0.5 points]

Are there unit non-response data in the PRSMI20 variable? If so, how are they recorded? What about the PARTYID variable? How many people refused to answer both of these questions?

MI_clean %>%
  count() # Tip: use count() function to look at your variables.

## Error in MI_clean %>% count(): could not find function "%>%"

Question 11 [0.5 points]

Let’s create a new variable called preschoice that converts PRSMI20 to a character. To do this, install the labelled package if you haven’t already, then use the to_character() function from the labelled package. Now count() the number of respondents who reported voting for each candidate. How many respondents voted for candidate Trump in 2020? How many respondents refused to tell us who they voted for?

MI_clean <- MI_clean %>%
  mutate(preschoice = ) # Convert to character

## Error in MI_clean %>% mutate(preschoice = ): could not find function "%>%"

MI_clean %>%
  count()

## Error in MI_clean %>% count(): could not find function "%>%"

Question 12 [1 point]

What proportion of women supported Trump?

# Women Trump supporters
MI_clean %>%
  drop_na() %>% # Drop any missing values for preschoice
  filter() %>% # Filter to only women
  count() %>% # Count the number of women who supported each candidate
  mutate(share = ) # Calculate the proportion of women who supported Trump

## Error in MI_clean %>% drop_na() %>% filter() %>% count() %>% mutate(share = ): could not find function "%>%"

# Alternative approach
MI_clean %>%
  drop_na() %>% # Drop any missing values for preschoice
  mutate(trumpSupp = ifelse()) %>% # Create "dummy" variable for whether the person voted for Trump or not that is either 1 (they voted for Trump) or 0
  group_by() %>% # Group by gender
  summarise(share = mean(trumpSupp)) # Calculate proportion who supported Trump

## Error in MI_clean %>% drop_na() %>% mutate(trumpSupp = ifelse()) %>% group_by() %>% : could not find function "%>%"

Extra Credit [0.5 point]

Among women, which age group sees the highest support for Trump? To answer, you will need to calculate the proportion of women who supported Trump by age-group to determine which age-group had the highest Trump support among women. You will need to clean the AGE10 variable before completing this problem, just like we did with the PRSMI20 variable. Call the new variable “Age”. HINT: to make your life easier (and not write a 10-level nested ifelse() function), try asking ChatGPT for help with this prompt: “I have a labelled variable in R that I want to convert to text. How can I do this?”

# Insert code here.

Problem Set 2

Mon, 01 Jan 0001 00:00:00 +0000

Getting Set Up

Open RStudio and create a new RMarkDown file (.Rmd) by going to File -> New File -> R Markdown.... Accept defaults and save this file as [LAST NAME]_ps1.Rmd to your code folder.

Copy and paste the contents of this .Rmd file into your [LAST NAME]_ps1.Rmd file. Then change the author: [Your Name] to your name.

All of the following questions should be answered in this .Rmd file. There are code chunks with incomplete code that need to be filled in.

This problem set is worth 22 total points, plus 2.5 extra credit points. The point values for each question are indicated in brackets below. To receive full credit, you must have the correct code. In addition, some questions ask you to provide a written response in addition to the code.

You are free to rely on whatever resources you need to complete this problem set, including lecture notes, lecture presentations, Google, your classmates…you name it. However, the final submission must be complete by you. There are no group assignments. To submit, compile the completed problem set and upload the PDF file to Drobox on Friday by midnight. If you use AI for help, choose to save your output as a PDF and submit this with the problem set as well. Also note that I will not respond to Campuswire messages after 2PM ET on Friday, so don’t wait until the last minute to get started!

Good luck!

Part 1: NBA Jam, “Boom-shakalaka!”

[2.5 points; +0.5 extra credit point available]

Question 0 (0 points)

Require tidyverse and load the nba_players_2018.Rds data to an object called nba.

require()

## Loading required package:

nba <- read_rds()

## Error in read_rds(): could not find function "read_rds"

Question 1 [0.5 points]

Plot the distribution of field goals attempted by all NBA players in the 2018-2019 season. Explain why you chose the visualization that you did. Then add a vertical line indicating the mean and median number of points in the data. Color the median line blue and the mean line red. Why is the median lower than the mean?

nba %>%
  ggplot() + # Put the fga variable on the x-axis of a ggplot.
   geom_...() + # Choose the appropriate geom function to visualize.
  labs() + # Add labels
      geom_vline() + # Median vertical line (blue)
      geom_vline() # Mean vertical line (red)

## Error in nba %>% ggplot(): could not find function "%>%"

Question 2 [0.5 points]

Now examine the country variable. Visualize this variable using the appropriate geom_..., and justify your reason for choosing it. Tweak the plot to put the country labels on the y-axis, ordered by frequency. Which country are most NBA players from? What is weird about your answer, and what might explain it?

nba %>%
  count() %>% # count the number of players by country
  ggplot() + # place the country on the y-axis, reordered by the number of players. Put the number of players on the x-axis
  geom_...() + # Choose the best geom
  labs() # Add labels

## Error in nba %>% count() %>% ggplot(): could not find function "%>%"

Question 3 [1.5 points]

Let’s pretend we are consulting for an NBA organization. The owner and GM tell us they are interested in the relationship between the player’s age (agePlayer) and the amount of points they score (pts). Please answer the following research question and provide a theory supporting your answer: “Do older NBA players score more points than younger players?”

Based on your answer above, what is the outcome / dependent / $Y$ variable and what is the explanatory / independent / $X$ variable? Why?

Create a univariate visualization of both the $X$ and $Y$ variables. Choose the best geom_...() based on the variable type, and make sure to label your plots!

# X variable
nba %>%
  ggplot() + # Put the X variable on the x-axis
  geom_...() +  # Choose the best geom given the variable type (make sure to look at it if you aren't sure)
  labs()     # Add labels

## Error in nba %>% ggplot(): could not find function "%>%"

# Y variable
nba %>%
  ggplot(...) + # Put the Y variable on the x-axis
  geom_...() +  # Choose the best geom given the variable type (make sure to look at it if you aren't sure)
  labs(...)     # Add labels

## Error in nba %>% ggplot(...): could not find function "%>%"

Question 4 [0.5 points]

Now analyze the data by creating a multivariate visualization that shows the relationship between age and points. Add a STRAIGHT line of best fit with geom_smooth().

nba %>%
  ggplot() + # Put the X variable on the x-axis, and the Y variable on the y-axis
  geom_...() +  # Choose the best geom given both variable types
  geom_smooth() + # Add a STRAIGHT line of best fit
  labs()     # Add labels

## Error in nba %>% ggplot(): could not find function "%>%"

Based on your analysis, does the data support or reject your hypothesis from Question 3?

Extra Credit 1 [0.5 point]

Let’s look for evidence of a “curvelinear” relationship between player age and points scored. To do so, first calculate the average points scored by age. Then plot this relationship using a multivariate visualization. Add a line of best fit with geom_smooth() but DON’T use method = "lm". What do you conclude? Why?

# INSERT CODE HERE

Part 2: 2020 Presidential Election (5 points; +0.5 extra credit)

Question 5 (0 points)

Require tidyverse and load the Pres2020_PV.Rds data to an object called pres.

require()

## Loading required package:

pres <- read_rds()

## Error in read_rds(): could not find function "read_rds"

Question 6 [1 point]

Consider the following hypothesis: “Most Americans don’t pay very much attention to politics, and don’t know who they will vote for until very close to the election. Therefore polling predictions should be more accurate closer to the election.” Based on this hypothesis and theoretical intuition, which variable is the $X$ variable and which is the $Y$ variable(s)?

Now let’s first look at each variable by itself using univariate visualization. First, plot the total number of polls per start date in the data. NB: you will have convert StartDate to a date class with as.Date(). If you need help, see this post. Do you observe a pattern in the number of polls over time? Why do you think this is?

pres %>%
  mutate(StartDate = as.Date(StartDate,'%m/%d/%Y')) %>% # Convert to date
  ggplot(aes(x = StartDate)) + # Visualize the variable using univariate principles
  geom_...() + # Choose the correct `geom`
  labs() # Make sure it is clearly labeled

## Error in pres %>% mutate(StartDate = as.Date(StartDate, "%m/%d/%Y")) %>% : could not find function "%>%"

Question 7 [1 point]

Next, let’s look at the other variables. Calculate the prediction error for Biden (call this variable demErr) and Trump (call this variable repErr) such that positive values mean that the poll overestimated the candidate’s popular vote share (DemCertVote for Biden and RepCertVote for Trump).

pres <- pres %>%
  mutate() # Create the two new variables

## Error in pres %>% mutate(): could not find function "%>%"

Plot the Biden and Trump prediction errors on a single plot using geom_bar(), with red indicating Trump and blue indicating Biden (make sure to set alpha to some value less than 1 to increase the transparency!). Add vertical lines for the average prediction error for both candidates (colored appropriately) as well as a vertical line indicating no prediction error.

pres %>%
  ggplot() + # Instantiate an EMPTY ggplot object
  geom_bar(aes(...), # Put the first variable in the first `geom_bar()`
           ...) + # Set the color and opacity
  geom_bar(aes(...), # Put the second variable in the second `geom_bar()`
           ...) + # Set the color and opacity
  labs(...) + # Make sure it is clearly labeled
  geom_vline(...) + # Put a black vertical line at 0
  geom_vline() + # Put a dashed blue vertical line at the Democrat prediction error
  geom_vline() + # Put a dashed red vertical line at the Republican prediction error

## Error in parse(text = input): <text>:11:0: unexpected end of input
## 9:   geom_vline() + # Put a dashed blue vertical line at the Democrat prediction error
## 10:   geom_vline() + # Put a dashed red vertical line at the Republican prediction error
##    ^

Do you observe a systematic bias toward one candidate or the other?

Question 8 [1 point]

Plot the average prediction error for Trump (red) and Biden (blue) by start date using geom_point() and add two curvey lines of best fit using geom_smooth(). Make sure that the curvey line for Trump is also red, and the curvey line for Biden is also blue!

pres %>%
  mutate(...) %>% # Convert to date
  group_by(...) %>% # Calculate the average error for Biden and Trump by date
  summarise(...,
            ...) %>%
  ggplot() + # Instantiate an empty ggplot
  geom_point(aes(x = ...,y = ...), # Put the first variable in the first `geom_point()`
           ...) + # Set the color
  geom_point(aes(x = ...,y = ...), # Put the second variable in the second `geom_point()`
           ...) + # Set the color
  geom_smooth(aes(x = ...,y = ...), # Put the first variable in the first geom_smooth()
              ...) + # Set the color
  geom_smooth(aes(x = ...,y = ...), # Put the second variable in the second geom_smooth()
              ...) + # Set the color
  labs(...) + # Make sure it is clearly labeled
  geom_hline(...) # Add a horizontal dashed line at 0

## Error in pres %>% mutate(...) %>% group_by(...) %>% summarise(..., ...) %>% : could not find function "%>%"

What pattern do you observe over time, if any? Does this support the hypothesis presented in Question 1 above?

Question 9 [1 point]

Can we do better by aggregating state-level polls? Load the [Pres2020_StatePolls.Rds] to an object called state. First, create two new variables demErr and repErr just as you did in Question 2. Then recreate the same overtime plot comparing Biden and Trump prediction errors as you did in Question 3. What do you observe?

state <- read_rds(...) # Read in the data

## Error in read_rds(...): could not find function "read_rds"

state <- state %>%
  mutate(...) # Create the two new variables for Democrat and Republican prediction errors

## Error in state %>% mutate(...): could not find function "%>%"

state %>%
  mutate(...) %>% # Convert to date
  group_by(...) %>% # Calculate the average error for Biden and Trump by date
  summarise(...,
            ...) %>%
  ggplot() + # Instantiate an empty ggplot
  geom_point(aes(x = ...,y = ...), # Put the first variable in the first `geom_point()`
           ...) + # Set the color
  geom_point(aes(x = ...,y = ...), # Put the second variable in the second `geom_point()`
           ...) + # Set the color
  geom_smooth(aes(x = ...,y = ...), # Put the first variable in the first geom_smooth()
              ...) + # Set the color
  geom_smooth(aes(x = ...,y = ...), # Put the second variable in the second geom_smooth()
              ...) + # Set the color
  labs(...) + # Make sure it is clearly labeled
  geom_hline(...) # Add a horizontal dashed line at 0

## Error in state %>% mutate(...) %>% group_by(...) %>% summarise(..., ...) %>% : could not find function "%>%"

Question 10 [1 point]

One other explanation for inaccurate state polls is that some states do not have many polls run. Calculate the anti-Trump/pro-Biden bias for each state by subtracting the repErr from the demErr (call this new variable bidenBias). Then calculate the average bias by state AND calculate the number of polls in that state. Finally, plot the relationship between the number of polls and the extent of bias. Does the data support the theory that states with more polls were predicted more accurately?

state <- state %>%
  mutate(...) # Create the bidenBias variable here

## Error in state %>% mutate(...): could not find function "%>%"

state %>%
  group_by(...) %>%
  summarise(...,   # Calculate the average bidenBias by state
            ...) %>% # Calculate the number of polls by state
  ungroup() %>%
  ggplot(aes(x = ...,      # Put the correct variable on the x-axis
             y = ...)) +   # Put the correct variable on the y-axis
  geom_...() + # Choose the correct geom
  geom_...(...) + # Add a straight line of best fit
  labs(...) # Give it some good labels

## Error in state %>% group_by(...) %>% summarise(..., ...) %>% ungroup() %>% : could not find function "%>%"

Extra Credit 2 [0.5 points]

Do polls that underestimate Trump’s support overestimate Biden’s support? Investigate this question using both the national data (pres) and the state data (state). Use a scatterplot to test, combined with a (straight) line of best fit. Then, calculate the proportion of polls that (1) underestimate both Trump and Biden, (2) underestimate Trump and overestimate Biden, (3) overestimate Trump and underestimate Biden, (4) overestimate both candidates. In these analyses, define “overestimate” as prediction errors greater than or equal to zero, whereas “underestimate” should be prediction errors less than zero. What do you conclude? Is there any evidence of an anti-Trump bias in national polling? What about state polling?

# National scatterplot
# INSERT CODE HERE

# National proportions: 4 different types of polls
# INSERT CODE HERE

# State scatterplot
# INSERT CODE HERE

# State proportions: 4 different types of polls
# INSERT CODE HERE

Problem Set 3

Mon, 01 Jan 0001 00:00:00 +0000

Getting Set Up

Open RStudio and create a new RMarkDown file (.Rmd) by going to File -> New File -> R Markdown.... Accept defaults and save this file as [LAST NAME]_ps3.Rmd to your code folder.

Copy and paste the contents of this .Rmd file into your [LAST NAME]_ps3.Rmd file. Then change the author: [Your Name] to your name.

All of the following questions should be answered in this .Rmd file. There are code chunks with incomplete code that need to be filled in. To submit, compile (i.e., knit as pdf) the completed problem set and upload the PDF file to Blackboard on Friday by midnight. Be sure to check your knitted PDF for mistakes before submitting!

This problem set is worth 7 total points, plus 2 extra credit points. The point values for each question are indicated in brackets below. To receive full credit, you must have the correct code. In addition, some questions ask you to provide a written response in addition to the code.

You will be deducted 1 point for each day late the problem set is submitted, and 1 point for failing to submit in the correct format (i.e., not knitting as a PDF).

You are free to rely on whatever resources you need to complete this problem set, including lecture notes, lecture presentations, Google, your classmates…you name it. However, the final submission must be complete by you. There are no group assignments. To submit, compile the completed problem set and upload the PDF file to Drobox on Friday by midnight. If you use AI for help, choose to save your output as a PDF and submit this with the problem set as well. Also note that I will not respond to Campuswire messages after 2PM ET on Friday, so don’t wait until the last minute to get started!

Good luck!

Part 1: New York/Villanova Knicks (3 points; 0.5 extra credit points)

Question 0

Require tidyverse and load the game_summary.rds data to an object called games. (Note, you must load the data from your local computer, not from the link)

# INSERT CODE HERE

Question 1 [0.75 points]

How many points, on average, did the New York Knicks score at home and away games in the 2017 season? Calculate this answer and also plot the multivariate relationship. Explain why your chosen visualization is justified. Draw two vertical lines for the average points at home and away.

# Create extra object to plot vertical lines for average points at home and away
vertLines <- games %>%
filter() %>% # Filter to the 2017 season (yearSeason) AND to the New York Knicks (nameTeam)
  group_by() %>% # Group by the location of the game
  summarise() # Calculate the average points (pts)

## Error in games %>% filter() %>% group_by() %>% summarise(): could not find function "%>%"

games %>%
  filter() %>% # Filter to the 2017 season (yearSeason) AND to the New York Knicks (nameTeam)
  ggplot() + # Create a multivariate plot comparing points scored between home and away games
  geom_...() + # Choose the appropriate geom_... for this plot (i.e., geom_histogram(), geom_density(), geom_bar(), etc.)
  labs(title = '', # Add clear descriptions for the title, subtitle, axes, and legend
       subtitle = '',
       x = '',
       y = '',
       color = '') + 
  geom_vline() # add vertical lines for the average points scored at home and away.

## Error in games %>% filter() %>% ggplot(): could not find function "%>%"

Question 2 [0.75 points]

Now recreate the same plot for the 2018, 2019, and combined seasons. Imagine that you work for the Knicks organization and Gersson Rosas (the GM), asks you if the team scores more points at home or away? Based on your analysis, what would you tell him?

# By season
vertLines <- games %>%
filter() %>% # Filter to the New York Knicks (nameTeam)
  group_by() %>% # Group by the location and the season
  summarise() # Calculate the average points (pts)

## Error in games %>% filter() %>% group_by() %>% summarise(): could not find function "%>%"

games %>%
  filter() %>% # Filter to the New York Knicks (nameTeam)
  ggplot() + # Create a multivariate plot comparing points scored between home and away games
  geom_...() + # Choose the appropriate geom_... for this plot (i.e., geom_histogram(), geom_density(), geom_bar(), etc.)
  labs(title = '', # Add clear descriptions for the title, subtitle, axes, and legend
       subtitle = '',
       x = '',
       y = '',
       color = '') + 
  facet_wrap() + # Create separate panels for each season (facet_wrap())
  geom_vline() # add vertical lines for the average points scored at home and away.

## Error in games %>% filter() %>% ggplot(): could not find function "%>%"

# Over all seasons combined
vertLines <- games %>%
filter() %>% # Filter to the New York Knicks (nameTeam)
  group_by() %>% # Group by the location
  summarise() # Calculate the average points (pts)

## Error in games %>% filter() %>% group_by() %>% summarise(): could not find function "%>%"

games %>%
  filter() %>% # Filter to the New York Knicks (nameTeam)
  ggplot() + # Create a multivariate plot comparing points scored between home and away games
  geom_...() + # Choose the appropriate geom_... for this plot (i.e., geom_histogram(), geom_density(), geom_bar(), etc.)
  labs(title = '', # Add clear descriptions for the title, subtitle, axes, and legend
       subtitle = '',
       x = '',
       y = '',
       color = '') + 
  geom_vline() # add vertical lines for the average points scored at home and away.

## Error in games %>% filter() %>% ggplot(): could not find function "%>%"

Question 3 [0.75 points]

Gersson Rosas thanks you for your answer, but is a well-trained statistician in his own right, and wants to know how confident you are in your claim. Bootstrap sample the data 1,000 times to provide him with a more sophisticated answer. How confident are you in your conclusion that the Knicks score more points at home games than away games? Make sure to set.seed(123) to ensure you get the same answer every time you knit your code!

set.seed(123) # Set the seed!
forBS <- games %>% # To make things easier, create a new data object that is filtered to just the Knicks so we don't have to do this every time in the loop
    filter() # Filter to the Knicks (nameTeam)

## Error in games %>% filter(): could not find function "%>%"

bsRes <- NULL # Instantiate an empty object to store data from the loop
for(i in 1:1000) { # Loop 1,000 times
  bsRes <- forBS %>%
    sample_n() %>% # Sample the data with replacement using all possible rows
    group_by() %>% # Group by the location of the game
    summarise() %>% # Calculate the average points (pts)
    ungroup() %>% # Best practices!
    spread() %>% # Spread the data to get one column for average points at home and another for average points away
    mutate(, # Calculate the difference between home and away points
           ) %>% # Save the bootstrap index
    bind_rows(bsRes) # Append the result to the empty object from above
}

## Error in forBS %>% sample_n() %>% group_by() %>% summarise() %>% ungroup() %>% : could not find function "%>%"

# Calculate the confidence
bsRes %>%
  summarise(, # Calculate the proportion of bootstrap simulations where the home points are greater than the away points
            ) # Calculate the overall average difference

## Error in bsRes %>% summarise(, ): could not find function "%>%"

Question 4 [0.75 points]

Re-do this analysis for three other statistics of interest to Gersson: total rebounds (treb), turnovers (tov), and field goal percent (pctFG). Do you notice anything strange in these results? What might explain it?

bsRes <- NULL # Instantiate an empty object to store data from the loop
for(i in 1:1000) { # Loop 1,000 times
  bsRes <- forBS %>%
    sample_n() %>% # Sample the data with replacement using all possible rows
    group_by() %>% # Group by the location of the game
    summarise(, # Calculate the average total rebounds (treb)
              , # Calculate the average turnovers (tov)
              ) %>% # Calculate the average field goal shooting percentage (pctFG)
    ungroup() %>% # Best practices!
    pivot_wider(, # Pivot wider to get each measure in its own colunm for home and away games
                ) %>% # Use the values from the variables you created above
    mutate(, # Calculate the difference between home and away total rebounds
           , # Calculate the difference between home and away turnovers
           , # Calculate the difference between home and away field goal percentages
           ) %>% # Save the bootstrap index
    bind_rows(bsRes) # Append the result to the empty object from above
}

## Error in forBS %>% sample_n() %>% group_by() %>% summarise(, , ) %>% ungroup() %>% : could not find function "%>%"

# Calculate the confidence
bsRes %>%
  summarise(, # Calculate the confidence for rebounds being greater than zero
            , # Calculate the confidence for turnovers being greater than zero
            )

## Error in bsRes %>% summarise(, , ): could not find function "%>%"

Extra Credit [0.5 points]

Now Gersson is asking for a similar analysis of other teams. Calculate the difference between home and away points for every team in the league and prepare a summary table that includes both the average difference for each team, as well as your confidence about whether the difference is not zero. Based on these data, would you argue that there is an overall home court advantage in terms of points across the NBA writ large? Visualize these summary results by plotting the difference on the x-axis, the teams (reordered) on the y-axis, and the points colored by whether you are more than 90% confident in your answer. How should we interpret confidence levels less than 50%?

# INSERT CODE HERE

Part 2: Youtube Bias (4 points; 1.5 extra credit points)

We will be using a new dataset called youtube_individual.rds which can be found on the course github page. The codebook for this dataset is produced below. All ideology measures are coded such that negative values indicate more liberal content and positive values indicate more conservative content.

Name	Description
ResponseId	A unique code for each respondent to the survey
ideo_recommendation	The average ideology of all recommendations shown to the respondent
ideo_current	The average ideology of all current videos the respondent was watching when they were shown recommendations
ideo_watch	The average ideology of all videos the respondent has ever watched on YouTube (their “watch history”)
nReccs	The total number of recommendations the respondent was shown during the survey
YOB	The year the respondent was born
education	The respondent’s highest level of education
gender	The respondent’s gender
income	The respondent’s total household income
party_id	The respondent’s self-reported partisanship
ideology	The respondent’s self-reported ideology
race	The respondent’s race
age	The respondent’s age at the time of the survey

Question 0

Require tidyverse and load the youtube_individual.rds data to an object called yt.

# INSERT CODE HERE

Question 1 [0.5 point]

We are interested in how the YouTube recommendation algorithm works. These data are collected from real users, logged into their real YouTube accounts, allowing us to see who gets recommended which videos. We will investigate three research questions in this problem set:

1. What is the relationship between average ideology of recommendations shown to each user, and the average ideology of all the videos the user has watched?

2. What is the relationship between the average ideology of recommendations shown to each user, and the average ideology of the current video the user was watching when they were shown the recommendation?

3. Which of these relationships is stronger? Why?

Start by answering all three of these research questions, and explaining your thinking. Be very precise about your assumptions!

Question 2 [0.75 points]

Based on your previous answer, which variables are the $X$ (predictors) and which are the $Y$ (outcome) variables?

Now create univariate visualizations of all three variables, making sure to label your plots clearly.

# Univariate visualization of Y
# INSERT CODE HERE

# Univariate visualization of X1
# INSERT CODE HERE

# Univariate visualization of X2
# INSERT CODE HERE

Question 3 [0.75 points]

Let’s focus on the first research question. Create a multivariate visualization of the relationship between these two variables, making sure to put the $X$ variable on the x-axis, and the $Y$ variable on the y-axis. Add a straight line of best fit. Does the data support your theory?

# Multviariate visualization of Y and X1
# INSERT CODE HERE

Now run a linear regression using the lm() function and save the result to an object called model_watch.

model_watch <- lm(formula = ..., # Write the regression equation here (remember to use the tilde ~!)
             data = ...) # Indicate where the data is stored here.

## Error: '...' used in an incorrect context

Using either the summary() function (from base R) or the tidy() function (from the broom package), print the regression result.

require(broom)

## Loading required package: broom

tidy(model_watch)

## Error: object 'model_watch' not found

In a few sentences, summarize the results of the regression output. This requires you to translate the statistical measures into plain English, making sure to refer to the units for both the $X$ and $Y$ variables. In addition, you must determine whether the regression result supports your hypothesis, and discuss your confidence in your answer, referring to the p-value.

Question 4 [0.75 points]

Now let’s do the same thing for the second research question. First, create the multivariate visualization and determine whether it is consistent with your theory.

# Multviariate visualization of Y and X2
# INSERT CODE HERE

Second, run a new regression and save the result to model_current. Then print the result using either summary() or tidy(), as before.

model_current <- lm(formula = ..., # Write the regression equation here (remember to use the tilde ~!)
             data = ...) # Indicate where the data is stored here.

## Error: '...' used in an incorrect context

tidy(model_current)

## Error: object 'model_current' not found

Finally, describe the result in plain English, and interpret it in light of your hypothesis. How confident are you?

Based ONLY on the preceding analysis, are you able to answer research question 3?

Question 5 [1.25 points + 0.5 EC points]

Now let’s evaluate the models. Start by calculating the “mistakes” (i.e., the “errors” or the “residuals”) generated by both models and saving these as new columns (errors_watch and errors_current) in the yt dataset.

# Calculating errors 
yt <- yt %>%
  mutate(preds_watch = ..., # Get the predicted values from the first model (Yhat)
         preds_current = ...) %>% # Get the predicted values from the second model (Yhat)
  mutate(errors_watch = ..., # Calculate errors for the first model (Y - Yhat)
         errors_current = ...) # Calculate errors for the second model (Y - Yhat)

## Error in yt %>% mutate(preds_watch = ..., preds_current = ...) %>% mutate(errors_watch = ..., : could not find function "%>%"

Now create two univariate visualization of these errors. Based on this result, which model looks better? Why? EC [+0.5 point]: Plot both errors on the same graph using pivot_longer().

# Univariate visualization of watch history model errors 
yt %>%
  ggplot(aes(x = ...)) + # Put the errors from the first model on the x-axis
  geom_...() +  # Choose the best geom_...() to visualize based on the variable's type
  labs(...) # Provide clear labels to help a stranger understand!

## Error in yt %>% ggplot(aes(x = ...)): could not find function "%>%"

# Univariate visualization of current video model errors 
yt %>%
  ggplot(aes(x = ...)) + # Put the errors from the first model on the x-axis
  geom_...() +  # Choose the best geom_...() to visualize based on the variable's type
  labs(...) # Provide clear labels to help a stranger understand!

## Error in yt %>% ggplot(aes(x = ...)): could not find function "%>%"

# EC [0.5 points]: Plot both errors on a single plot. Hint: use pivot_longer().

Finally, create a multivariate visualization of both sets of errors, comparing them against the $X$ variable. Based on this result, which model looks better? Why? EC [+0.5 point]: Create two plots side-by-side using facet_wrap(). This is SUPER HARD, so don’t worry if you can’t get it.

# Multivariate visualization of watch history errors
yt %>%
  ggplot(aes(x = ...,      # Put the predictor on the x-axis
             y = ...)) + # Put the errors on the y-axis
  geom_...() + # Choose the best geom_...()
  geom_...() + # Add a curvey line of best fit
  geom_hline(...) + # Add a horizontal dashed line at zero
  labs(...) # Provide clear labels to help a stranger understand!

## Error in yt %>% ggplot(aes(x = ..., y = ...)): could not find function "%>%"

# Multivariate visualization of current video errors
yt %>%
  ggplot(aes(x = ...,      # Put the predictor on the x-axis
             y = ...)) + # Put the errors on the y-axis
  geom_...() + # Choose the best geom_...()
  geom_...() + # Add a curvey line of best fit
  geom_hline(...) + # Add a horizontal dashed line at zero
  labs(...) # Provide clear labels to help a stranger understand!

## Error in yt %>% ggplot(aes(x = ..., y = ...)): could not find function "%>%"

# EC [0.5 point]: Try to create two plots side-by-side. (SUPER HARD)

Extra Credit [0.5 points]

Calculate the Root Mean Squared Error (RMSE) using 100-fold cross validation with a 50-50 split for both models. How bad are the first model’s mistakes on average? How bad are the second model’s mistakes? Which model seems better? Remember to talk about the result in terms of the range of values of the outcome variable! Plot the errors by the model using geom_boxplot(). HINT: you’ll need to use pivot_longer() to get the data shaped correctly.

# INSERT CODE HERE

Problem Set 4

Mon, 01 Jan 0001 00:00:00 +0000

Getting Set Up

Open RStudio and create a new RMarkDown file (.Rmd) by going to File -> New File -> R Markdown.... Accept defaults and save this file as [LAST NAME]_ps4.Rmd to your code folder.

Copy and paste the contents of this .Rmd file into your [LAST NAME]_ps4.Rmd file. Then change the author: [Your Name] to your name.

You will be deducted 1 point for each day late the problem set is submitted, and 1 point for failing to submit in the correct format (i.e., not knitting as a PDF).

You are free to rely on whatever resources you need to complete this problem set, including lecture notes, lecture presentations, Google, your classmates…you name it. However, the final submission must be complete by you. There are no group assignments. To submit, compile the completed problem set and upload the PDF file to Blackboard on Friday by midnight. If you use AI for help, choose to save your output as a PDF and submit this with the problem set as well. Also note that I will not respond to Campuswire messages after 2PM ET on Friday, so don’t wait until the last minute to get started!

Good luck!

Question 0

Require tidyverse and load the mv.Rds data to an object called movies.

# INSERT CODE HERE

Question 1 [1 point]

In this problem set, we will answer the following research question: “Do movies that have a higher Bechdel Score (bechdel_score) make more money (gross)?” First, write out a theory that answers this question and transform it into a hypothesis. To learn more about the Bechdel Score, please read this Wikipedia entry.

Question 2 [1.5 points]

Based on your theory, which variable is the $X$ variable (i.e., the independent variable or the predictor)? Which variable is the $Y$ variable (i.e., the dependent variable or the outcome)? Use univariate visualization to create two plots, one for each variable. Do you need to apply a log-transformation to either of these variables? Why? Then create a multivariate visualization of these two variables, making sure to put the independent variable on the x-axis and the dependent variable on the y-axis. Make sure to log the data if you determined this was necessary in the previous question! Does the visualization support your hypothesis?

# Univariate visualization of predictor / X variable
movies %>%
  ggplot() + # Put the predictor on the x-axis
  geom_...() + # Choose the appropriate geom...()
  labs(title = '', # Make sure to give the plot intuitive labels!
       x = '',
       y = '')

## Error in movies %>% ggplot(): could not find function "%>%"

# Univariate visualization of outcome / Y variable
movies %>%
  ggplot() + # Put the outcome on the x-axis
  geom_...() + # Choose the appropriate geom...()
  labs(title = '', # Make sure to give the plot intuitive labels!
       x = '',
       y = '')

## Error in movies %>% ggplot(): could not find function "%>%"

# Multivariate visualization
movies %>%
  drop_na() %>% # Dropping missing observations from the variables
  mutate() %>% # Do you need to mutate anything?
  ggplot() + # Put the predictor on the x-axis and the outcome on the y-axis
  geom_...() + # Choose the appropriate geom...()
  labs(title = '', # Make sure to give the plot intuitive labels!
       x = '',
       y = '')

## Error in movies %>% drop_na() %>% mutate() %>% ggplot(): could not find function "%>%"

Question 3 [2 points]

Now estimate the regression using the lm() function. Describe the output of the model in English, talking about the intercept, the slope, and the statistical significance.

# Data wrangling
movies_analysis <- movies %>%
  mutate() %>% # Do you need to mutate anything?
  drop_na() # Dropping missing observations from the variables

## Error in movies %>% mutate() %>% drop_na(): could not find function "%>%"

model_gross_bechdel_score <- lm(formula = , # Write the regression formula here
                                data = ) # Put the data here

## Error in terms.formula(formula, data = data): argument is not a valid model

summary(model_gross_bechdel_score) # Interpret the regression output. Check here for help: https://learneconomicsonline.com/blog/archives/1095

## Error: object 'model_gross_bechdel_score' not found

Question 4 [2.5 points]

Now calculate the model’s prediction errors and create both a univariate and multivariate visualization of them. Based on these analyses, would you say that your model does a good job predicting how much money a movie makes? Make sure to reference both the univariate and multivariate visualization of the errors! Use the prediction errors to calculate the RMSE in the full data. Then calculate the RMSE using 100-fold cross validation with an 80-20 split and take the average of the 100 estimates.

movies_analysis <- movies_analysis %>%
  mutate() %>% # Create new variable of predicted values from the model
  mutate() # Calculate the errors

## Error in movies_analysis %>% mutate() %>% mutate(): could not find function "%>%"

# Univariate visualization of the errors
movies_analysis %>%
  ggplot() + # Put errors on the x-axis
  geom_...() + # Choose the apppropriate geom...()
  labs(title = '', # Make sure to give the plot intuitive labels!
       x = '',
       y = '')

## Error in movies_analysis %>% ggplot(): could not find function "%>%"

# Multivariate
movies_analysis %>%
  ggplot() + # Put errors on the y-axis and the predictor on the x-axis
  geom_...() + # Choose the apppropriate geom...()
  geom_hline() + # Add a horizontal dashed line at zero
  labs(title = '', # Make sure to give the plot intuitive labels!
       x = '',
       y = '')

## Error in movies_analysis %>% ggplot(): could not find function "%>%"

# RMSE Calculations
# RMSE Full Data
movies_analysis %>%
  mutate() %>% # Calculate the squared errors (SE)
  summarise() %>% # Calculate the mean of the squared errors (MSE)
  mutate() # Calculate the square root of the mean of the squared errors (RMSE)

## Error in movies_analysis %>% mutate() %>% summarise() %>% mutate(): could not find function "%>%"

# RMSE 100-fold CV
set.seed(123) # Set seed for consistency!
cvRes <- NULL # Instantiate an empty object to store data from the loop
for(i in 1:100) { # Loop 100 times
  inds <- sample() # Create a list of random row numbers from 80% of the data, without replacement
  
  train <- movies_analysis %>% slice() # Create the training dataset based on these rows
  test <- movies_analysis %>% slice() # Create the test dataset based on all other rows
  
  m <- lm(formula = ,
          data = ) # Calculate your regression on the training data
  
  test$preds <- predict(,
                        newdata = ) # Apply your model to the test data
  
  e <-  # Calculate the errors
  se <-  # Calculate the squared errors
  mse <- mean() # Calcualte the mean of the squared errors 
  rmse <- sqrt()# Calculate the RMSE
  cvRes <- c() # Save the RMSE to a list of numbers
}

## Error in sample(): argument "x" is missing, with no default

mean(cvRes)

## Warning in mean.default(cvRes): argument is not numeric or logical: returning
## NA

## [1] NA

mean(cvRes < 1.98)

## [1] NaN

Extra Credit [1 point]

Taking a step back, do you trust these results? What concerns might you have about the model? Can you propose a “control” to add that would speak to your concerns? Run the regression with this control and re-interpret the results.

# INSERT CODE HERE

Problem Set 4

Mon, 01 Jan 0001 00:00:00 +0000

Getting Set Up

Open RStudio and create a new RMarkDown file (.Rmd) by going to File -> New File -> R Markdown.... Accept defaults and save this file as [LAST NAME]_ps5.Rmd to your code folder.

Copy and paste the contents of this .Rmd file into your [LAST NAME]_ps5.Rmd file. Then change the author: [Your Name] to your name.

This problem set is worth 7 total points, plus 1 extra credit point. The point values for each question are indicated in brackets below. To receive full credit, you must have the correct code. In addition, some questions ask you to provide a written response in addition to the code.

You will be deducted 1 point for each day late the problem set is submitted, and 1 point for failing to submit in the correct format (i.e., not knitting as a PDF).

Note that the professor will not respond to Campuswire posts after 2PM on Friday, so don’t wait until the last minute to get started!

Good luck!

Part 1: Maximizing Accuracy

Question 0

Require tidyverse and load the fn_cleaned_final.Rds data to an object called fn.

# INSERT CODE HERE

Question 1 [0.5 points]

In this problem set, we are interested in developing a classifier that maximizes our accuracy for predicting Fortnite victories. To do so we will use both a linear probability model and a logit, and then compare their predictive accuracy. We will use two $X$ variables to predict the probability of winning: accuracy (accuracy), and head shots (head_shots). Our outcome variable of interest $Y$ is whether the player won the game (won).

Start by looking at these variables. Why types of variables are they? How much missingness do they have? What do their univariate visualizations look like? Then create two multivariate visualizations of the relationship between won and each of the two $X$ variables one-by-one. Finally, use geom_tile() to create a heatmap of the three-way relationship, where quintiles of accuracy is on the x-axis, quintiles of head_shots is on the y-axis, and tiles are filled according to the average winning probability. (NB: look up what “quintile” means if you are not sure.) Is there anything surprising about this result?

# What types?
# INSERT CODE HERE

# How much missingness?
# INSERT CODE HERE

# Univariate
# INSERT CODE HERE

# Multivariate: one-by-one
# INSERT CODE HERE

# Multivariate: 3-dimensions
# INSERT CODE HERE

Question 2 [1 point]

Now let’s run a linear model and evaluate it in terms of overall accuracy, sensitivity and specificity using a threshold of 0.5. Then, determine the threshold that maximizes both specificity and sensitivity. Finally, calculate the area under the curve (AUC).

require(...) # Require the scales package

## Error: '...' used in an incorrect context

# Running linear model
model_lm <- lm(formula = ..., # Define the regression equation
               data = ...) # Provide the dataset

## Error: '...' used in an incorrect context

# Calculating accuracy, sensitivity, and specificity
fn %>%
  mutate(prob_win = ...) %>% # Calculate the probability of winning
  mutate(pred_win = ...) %>% # Convert the probability to a 1 if the probability is greater than 0.5, or zero otherwise
  group_by(...) %>% # Calculate the total games by whether they were actually won or lost
  mutate(total_games = ...) %>%
  group_by(....) %>% # Calculate the number of games by whether they were actually won or lost, and by whether they were predicted to be won or lost
  summarise(nGames=...,.groups = 'drop') %>%
  mutate(prop = ...) %>% # Calculate the proportion of game by the total games
  ungroup() %>%
  mutate(accuracy = ...) # Calculate the overall accuracy

## Error in fn %>% mutate(prob_win = ...) %>% mutate(pred_win = ...) %>% : could not find function "%>%"

# Create the sensitivity vs specificity plot
toplot <- NULL # Instantiate an empty object
for(thresh in seq(0,1,by = .025)) {
  toplot <- fn %>%
  mutate(prob_win = ...) %>% # Calculate the probability of winning
  mutate(pred_win = ...) %>% # Convert the probability to a 1 if the probability is greater than the given threshold, or zero otherwise
  group_by(...) %>% # Calculate the total games by whether they were actually won or lost
  mutate(total_games = ...) %>%
  group_by(...) %>% # Calculate the number of games by whether they were actually won or lost, and by whether they were predicted to be won or lost
  summarise(nGames=...,.groups = 'drop') %>%
  mutate(prop = ...) %>% # Calculate the proportion of game by the total games
  ungroup() %>%
  mutate(accuracy = ...) %>% # Calculate the overall accuracy
  mutate(threshold = ...) %>% # Record the threshold level
    bind_rows(toplot) # Add it to the toplot object
}

## Error in fn %>% mutate(prob_win = ...) %>% mutate(pred_win = ...) %>% : could not find function "%>%"

toplot %>%
  mutate(metric = ifelse(...,
                         ifelse(...,...))) %>% # Using a nested ifelse() function, label each row as either Sensitivity (if the predicted win is 1 and the true win is 1), Specificity (if the predicted win is 0 and the true win is 0), or NA
  drop_na(...) %>% # Drop rows that are neither sensitivity nor specificity measures
  ggplot(aes(x = ...,y = ...,color = ...)) + # Visualize the Sensitivity and Specificity curves by putting the threshold on the x-axis, the proportion of all games on the y-axis, and coloring by Sensitivity or Specificity
  geom_...() + 
  geom_vline(xintercept = ...) # Tweak the x-intercept to find the optimal threshold

## Error in toplot %>% mutate(metric = ifelse(..., ifelse(..., ...))) %>% : could not find function "%>%"

# Plot the AUC
toplot %>%
  mutate(metric = ifelse(...,
                         ifelse(...,...))) %>% # Using a nested ifelse() function, label each row as either Sensitivity (if the predicted win is 1 and the true win is 1), Specificity (if the predicted win is 0 and the true win is 0), or NA
  drop_na(...) %>% # Drop rows that are neither sensitivity nor specificity measures
  select(...) %>% # Select only the prop, metric, and threshold columns
  spread(...) %>% # Pivot the data to wide format using either spread() or pivot_wider(), where the new columns should be the metric
  arrange(...) %>% # Arrange by descending specificity, and then by sensitivity
  ggplot(aes(x = ..., # Plot 1 minus the Specificity on the x-axis
             y = ...)) +  # Plot the Sensitivity on the y-axis
  geom_...() + 
  xlim(...) + ylim(...) + # Expand the x and y-axis limits to be between 0 and 1
  geom_abline(...) + # Add a 45-degree line using geom_abline()
  labs(x = '', # Add clear labels! (Make sure to indicate that this is the result of a linear regression model)
       y = '',
       title = '',
       subtitle = '')

## Error in toplot %>% mutate(metric = ifelse(..., ifelse(..., ...))) %>% : could not find function "%>%"

# Calculate the AUC
require(...) # Require the tidymodels package

## Error: '...' used in an incorrect context

forAUC <- fn %>%
  mutate(prob_win = ..., # Generate predicted probabilities of winning from our model
         truth = ...) %>% # Convert the outcome to a factor with levels c('1','0')
  select(truth,prob_win) # Select only the probability and true outcome columns

## Error in fn %>% mutate(prob_win = ..., truth = ...) %>% select(truth, : could not find function "%>%"

roc_auc(data = forAUC, # Run the roc_auc() function on the dataset we just created
        truth, # Tell it which column contains the true outcomes
        prob_win) # Tell it which column contains our model's predicted probabilities

## Error in roc_auc(data = forAUC, truth, prob_win): could not find function "roc_auc"

Question 3 [0.5 points]

Now let’s re-do the exact same work, except use a logit model instead of a linear model. Based on your analysis, which model has a larger AUC?

# INSERT CODE HERE

Question 4 [1 point]

Use 100-fold cross validation with a 60-40 split to calculate the average AUC for both the linear and logit models. Which is better?

set.seed(123)
cvRes <- NULL
for(i in 1:100) {
  # Cross validation prep
  # INSERT CODE HERE

  # Training models
  mLM <- lm(...)
  mGLM <- glm(...)
  
  # Predicting models
  toEval <- test %>%
    mutate(mLMPreds = ..., # Calculate the probability of winning from the linear model
           mGLMPreds = ..., # Calculate the probability of winning from the logit
           truth = ...) # Convert the outcome to a factor with levels c('1','0')

  # Evaluating models
  rocLM <- roc_auc(...) %>% # Calculate the AUC for the linear model
    mutate(model = ...) %>% # Record the model type
    rename(auc = .estimate) # Rename to 'auc'
    
  rocGLM <- roc_auc(...) %>% # Calculate the AUC for the logit model
    mutate(model = ...) %>% # Record the model type
    rename(auc = .estimate) # Rename to 'auc'

  cvRes <- rocLM %>%
    bind_rows(rocGLM) %>%
    mutate(cvInd = i) %>%
    bind_rows(cvRes)
}

## Error in lm(...): '...' used in an incorrect context

cvRes %>%
  group_by(model) %>%
  summarise(mean_auc = mean(auc))

## Error in cvRes %>% group_by(model) %>% summarise(mean_auc = mean(auc)): could not find function "%>%"

Question 5 [1 point]

Let’s consider two possible $X$ variables which might help us predict whether a player wins a Fortnite match: revives and eliminations. revives counts the total number of times a player is brought back to life by a teammate. eliminations is a measure of how many times the player killed an opponent. Which variable do you think is more helpful for predicting whether a player wins a game of Fortnite? Why?

Look at the data and provide univariate and multivariate visualizations of both variables. Make sure to think carefully about what types of variables these are, and justify your visualization choices accordingly!

# Look to determine variable types
# INSERT CODE HERE

# Univariate #1
# INSERT CODE HERE

# Univariate #1
# INSERT CODE HERE

# Multivariate (many different options will work)
# INSERT CODE HERE

Question 7 [1 point]

Let’s test your intuition. Starting with the full data, calculate the AUC for both models. Then, using 100 cross validation with a logit model and a 60-40 split, calculate the AUC for the model which uses the variable you think is best, compared to the model you think is the worst. Pay attention to the things you need to change to use a logit model! Is your assumption from Q1 supported in the data?

# Require the tidymodels package
# Running logit model #1
# INSERT CODE HERE

# Running logit model #2
# INSERT CODE HERE

# Calculate the AUC #1
# INSERT CODE HERE

# Calculate the AUC #1
# INSERT CODE HERE


# Calculate cross validation
set.seed(123)
cvRes <- NULL
for(i in 1:100) {
  # Cross validation prep
  # INSERT CODE HERE

  # Training models
  # INSERT CODE HERE
  
  # Predicting models
  # INSERT CODE HERE

  # Evaluating models
  # INSERT CODE HERE

  # Binding data
  # INSERT CODE HERE
}

# Calculate overall mean AUC
# INSERT CODE HERE

# Visualize distribution of AUC by variable (optional)
# INSERT CODE HERE

# Calculate Proportion of time the "best" model is better than the "worst" (optional)
# INSERT CODE HERE

Question 8 [1 point]

Now let’s run a kitchen sink model using a random forest (make sure to install and require the ranger package). Use the following $X$ variables: - hits - assists - accuracy - head_shots - damage_to_players - eliminations - revives - distance_traveled - materials_gathered - mental_state - startTime - gameIdSession

Run it on the full data and use importance = 'permutation' to see which variables the random forest thinks are most important. Visualize these results with a barplot. Where do the variables you thought would be best and worst appear?

# Require ranger
# INSERT CODE HERE

# Run RF model with permutation-based importance calculation
model_rf  <- ranger(..., # Insert regression equation here
                    ..., # Insert data here
                    ...) # Set importance calculation here

## Error in ranger(..., ..., ...): could not find function "ranger"

# Visualize variable importance results
# First, create a toplot object
toplot <- data.frame(vimp = ..., # Get variable importance values from model_rf
                     vars = names(...)) # Get variable importance value names from model_rf

## Error: '...' used in an incorrect context

# Second, visualize the results (make sure to reorder the variables in order of importance)
# INSERT CODE HERE

Question 9 [+1 point extra credit]

For extra credit, we will use k-means clustering to see whether Fortnite players fall into different “play style” groups. Start by creating a new dataset with these variables: accuracy, head_shots, eliminations, distance_traveled, materials_gathered, and won. Remove any rows with missing values. Next, standardize the five play-style variables (everything except won) so they each have mean 0 and standard deviation 1. Then run a k-means model with 3 clusters using the standardized play-style variables. Add the cluster assignments back to your dataset using the augment() function from the broom package. Make at least one scatterplot showing the clusters (for example, plot accuracy vs. eliminations, with points colored by cluster). Finally, calculate the mean win rate and the number of players in each cluster. Write a few sentences describing what the clusters seem to represent (e.g., aggressive players, defensive players, etc.) and which group is most likely to win.

# INSERT CODE HERE

Regression Time!

Mon, 01 Jan 0001 00:00:00 +0000

Overview

So far, we’ve been using just the simple mean to make predictions. Going forward, we’ll continue using the simple mean to make predictions, but now in a complicated way. Before, when we calculated conditional means, we did so in certain “groupings” of variables. When we run linear regression, we no longer need to do so. Instead, linear regression allows us to calculate the conditional mean of the outcome at every value of the predictor. If the predictor takes on just a few values, then that’s the number of conditional means that will be calculated. If the predictor is continuous and takes on a large number of values, we’ll still be able to calculate the conditional mean at every one of those values.

As an example, consider the following plot of weekly spending on entertainment (movies, video games, streaming, etc) as a function of hourly wages.

If we’re asked to summarize the relationship between wages and spending, we could use conditional means. That’s what the blue line above does: for each of the four quartiles of hourly wages, it provides the average spending on entertainment. We could expand this logic and include both more levels of hourly wages and other variables with which to calculate the mean– for example, hourly wages and level of education. The problem is that this approach gives us lots of numbers back.

The graphic below fits a line (in red) to the data:

The line has the general function y=12+(2*x). We’re saying that if hourly wages were 0, the person would be predicted to spend 12 on entertainment (who knows where they got it). As hourly wages go up, the line predicts that weekly spending goes up $2 for every $1 increase in hourly wages. The line we fit to this data summarizes the relationship using just two numbers: the intercept (value of the y when x=0) and slope– the amount that y increases as a function of x. We call the slope the coefficient on x.

The general model we posit for regression is as follows:

\[Y=\alpha+\beta_1 x_1 +\beta_2 x_2+ ... \beta_k x_k + \epsilon\]

It’s just a linear, additive model. Y increases or decreases as a function of x, with multiple x’s included. $\epsilon$ is the extent to which an individual value is above or below the line created. $\beta$ is the amount that $Y$ increases or decreases for a one unit change in $x$. $\alpha$ (sometimes referred to as $\beta_0$) is the intercept that tells the value of $Y$ when all the $x_1,\dots,x_k$ are equal to zero. With the simplifying assumption of linearity, we can summarize what we know about the relationship between the independent and dependent variable in a very parsimonious way. The trade-off is that an assumption of linearity may not always be warranted.

Note that this general model is the empiricist’s theory. We have to make choices about what $x_1,\dots,x_k$ will be. For example, should we include wages and family structure into a model of spending on entertainment? Theoretically, we might think that, as your family gets bigger, you must spend more money on entertainment!

When we actually apply this model to data, we obtain predictions for both $Y$ and each of the $\beta$ parameters. We denote predicted values with a “hat”: $\hat{Y}, \hat{\beta_1}$, etc. So how do we actually DO this?

College Data

We are going to go back to two previous datasets to get started. Our main focus will be on the college debt data from the beginning of the semester. Recall our previous work where we looked at the relationship between SAT scores and future earnings. All else equal, we expect that future earnings ($Y$) are positively related with SAT scores ($X$).

Let’s load the data and packages first.

require(tidyverse)
require(plotly)
sc_debt <- read_rds('https://github.com/rweldzius/PSC4175/raw/main/static/data/sc_debt.Rds')

Now let’s look at our two variables of interest before we do anything else. Are these continuous? Categorical?

sc_debt %>%
  select(sat_avg,md_earn_wne_p6)

## # A tibble: 2,546 × 2
##    sat_avg md_earn_wne_p6
##      <int>          <int>
##  1     939          25200
##  2    1234          35100
##  3      NA          30700
##  4    1319          36200
##  5     946          22600
##  6    1261          37400
##  7      NA          23100
##  8      NA          33400
##  9    1082          30100
## 10    1300          39500
## # ℹ 2,536 more rows

As we can see, they both appear to be continuous measures, although we can see that many schools don’t report the average SAT scores of their students. Let’s use the summary() function to count how much missing data we are dealing with.

summary(sc_debt %>% select(sat_avg,md_earn_wne_p6))

##     sat_avg     md_earn_wne_p6  
##  Min.   : 737   Min.   : 10600  
##  1st Qu.:1053   1st Qu.: 26100  
##  Median :1119   Median : 31500  
##  Mean   :1141   Mean   : 33028  
##  3rd Qu.:1205   3rd Qu.: 37400  
##  Max.   :1557   Max.   :120400  
##  NA's   :1317   NA's   :240

240 schools don’t report the future earnings of their recent graduates, and a whopping 1,317 schools don’t report SAT scores!

Let’s now look at both variables with univariate plots.

sc_debt %>%
  ggplot(aes(x = sat_avg)) + 
  geom_histogram()

sc_debt %>%
  ggplot(aes(x = md_earn_wne_p6)) + 
  geom_histogram()

Both variables are mildly skewed, but not enough for us to worry about transforming them.

Now let’s plot them as a scatter plot.

sc_debt %>%
  ggplot(aes(x = sat_avg,y = md_earn_wne_p6)) + 
  geom_point()

As we can see just by looking at the data, there is a positive relationship, where schools with higher SAT averages produce recent graduates with higher median earnings. However, note that there are a few outliers. Let’s use plotly to help is identify these outliers.

p <- sc_debt %>%
  ggplot(aes(x = sat_avg,y = md_earn_wne_p6,text = instnm)) + 
  geom_point()

ggplotly(p)

The University of Health Sciences and Pharmacy in St. Louis produces really wealthy recent graduates, despite having a middle-of-the-pack SAT score! (Why might this be?)

Now let’s overlay the line of best fit using geom_smooth(method = 'lm').

sc_debt %>%
  ggplot(aes(x = sat_avg,y = md_earn_wne_p6)) + 
  geom_point() + 
  geom_smooth(method = 'lm')

This line tells us that, on average, schools with average SAT scores of 1,000 produce recent graduates with incomes of roughly $30,000 annually.

Similarly, schools with average SAT scores of 1,400 produce graduates with median incomes of roughly $45,000.

The Linear Regression Model

Under the hood, ggplot is using a specific function to draw this line called the lm() function, which stands for “linear model”. The function is choosing values of $\alpha$ and $\beta$ that minimize the errors for every school in the dataset. We can access this function directly ourselves!

The lm() function takes two inputs that we must define. The first is the formula, and the second is the data.

The formula is literally just us writing the regression equation from above, but in terms R can understand. It takes the format of Y ~ X, which means $Y = \alpha + \beta X$. (We don’t need to tell R about $\alpha$ and $\beta$ in the formula…it calculates these values for us.)

In our setting, we want to set $Y$ to md_earn_wne_p6 and $X$ to sat_avg, just like we drew them on the axes in our plot. Thus our formula becomes md_earn_wne_p6 ~ sat_avg. We also need to tell R which data we are using, in this case our sc_debt object. We then save the entire regression model to an object, that I’ll call model_earn_sat

model_earn_sat <- lm(formula = md_earn_wne_p6 ~ sat_avg,data = sc_debt)

We can then look at the model results using the summary() function.

summary(model_earn_sat)

## 
## Call:
## lm(formula = md_earn_wne_p6 ~ sat_avg, data = sc_debt)
## 
## Residuals:
##    Min     1Q Median     3Q    Max 
## -23239  -4311   -852   2893  78695 
## 
## Coefficients:
##              Estimate Std. Error t value Pr(>|t|)    
## (Intercept) -12053.87    1939.80  -6.214 7.12e-10 ***
## sat_avg         42.60       1.69  25.203  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 7594 on 1196 degrees of freedom
##   (1348 observations deleted due to missingness)
## Multiple R-squared:  0.3469,	Adjusted R-squared:  0.3463 
## F-statistic: 635.2 on 1 and 1196 DF,  p-value: < 2.2e-16

The model gives us a lot of information. The results tell us that the (Intercept) (which is the same as $\alpha$ in our theory equation, and $\hat{\alpha}$ in our results) is equal to -12054.87, and that the sat_avg (which is the same as $\beta$ in our theory equation, and $\hat{\beta}$ in our results) is equal to 42.60.

Substantively, we interpret these as follows:

If a school has an average SAT score of 0, its recent grads are predicted to have median earnings of -$12,053.87.
For each additional point the school has in terms of average SAT scores, its recent grad earnings are predicted to increase by $42.60.

Obviously, the $\alpha$ value (the (Intercept)) is somewhat meaningless. There are no schools whose average SAT scores are zero…the minimum possible SAT score can’t even be zero!

But the $\beta$ value is very interesting and directly speaks to the research question, theory, and hypothesis! According to this model, each additional point on the SATs yields an increase in earnings of $42!

Reading a Regression Table

There are many other numbers in this table, including the Standard Error (Std. Error), the t-statistic (t value), and the p-value (Pr(>|t|)). It turns out that the t-statistic is just the coefficient (Estimate) divided by the standard error (Std. Error), and the p-value is a way of converting the t-statistic into a measure of uncertainty! You don’t need to know these steps in detail for this course. However, you do need to remember that the p-value is just 1 minus the confidence level. The smaller the p-value, the more confident we are that the $\beta$ coefficient is not zero (i.e., that there is a relationship).

In this case, the p-value is basically zero, meaning we are basically 100% confident that the relationship between md_earn_wne_p6 and sat_avg is positive!

Another Example

Let’s ask a different research question: what is the relationship between future earnings and the admissions rate?

Theory: Can you come up with a theory? I would assume that more selective schools have more rigorous training, which then leads to wealthier recent graduates.

Hypothesis: What is your hypothesis? Mine is that the relationship between the admissions rate and future earnings is negative.

Let’s test it!

First, we want to again look at both univariate and multivariate visualizations of our $Y$ and $X$ variables.

sc_debt %>%
  ggplot(aes(x = adm_rate)) + 
  geom_histogram()

sc_debt %>%
  ggplot(aes(x = md_earn_wne_p6)) + 
  geom_histogram()

As above, there is some mild skew, but nothing to be too worried about.

Let’s also check on missingness, just so we know how many schools we don’t have in our data.

summary(sc_debt %>% select(md_earn_wne_p6,adm_rate))

##  md_earn_wne_p6      adm_rate     
##  Min.   : 10600   Min.   :0.0000  
##  1st Qu.: 26100   1st Qu.:0.5668  
##  Median : 31500   Median :0.7115  
##  Mean   : 33028   Mean   :0.6791  
##  3rd Qu.: 37400   3rd Qu.:0.8333  
##  Max.   :120400   Max.   :1.0000  
##  NA's   :240      NA's   :958

As above, 240 schools don’t report recent graduate earnings, and almost 1,000 don’t report on their admissions rate! This is an important aspect of the data to recognize, since it limits how generalizable our conclusions might be.

Now let’s plot the multivariate relationship.

sc_debt %>%
  ggplot(aes(x = adm_rate,y = md_earn_wne_p6))+ 
  geom_point() + 
  geom_smooth(method = 'lm')

We find some evidence of a downward sloping relationship, although it is less steep than what we saw with SAT scores.

Quick Exercise: Now let’s run the regression again. What do you conclude? How confident are you in this conclusion?

# INSERT CODE HERE

Write your answer here.

Regression Time! (Part II)

Mon, 01 Jan 0001 00:00:00 +0000

Motivation: predicting movie revenues

“Nobody knows anything…… Not one person in the entire motion picture field knows for a certainty what’s going to work. Every time out it’s a guess and, if you’re lucky, an educated one.”

-William Goldman, screenwriter of The Princess Bride and All the President’s Men.

Using the tools of regression, we’re now going to see if we can predict which movies will bring in more money. Predicting movie revenues is known to be a very difficult problem, as some movies vastly outperform expectations, while other (very expensive) movies flop badly. Unlike other areas of the economy, it’s not always easy to know which characteristics of movies are associated with higher gross revenues. Nevertheless, we shall persist!

It’s typical for an investor group to have a model to understand the range of performance for a given movie. Investors want to know what range of return they might expect for an investment in a given movie. We’ll try and get started on just such a model.

The Data

Load in libraries.

library(tidyverse)
library(plotly)
library(scales)

Load in data.

mv<-read_rds("https://github.com/rweldzius/PSC4175/raw/main/static/data/mv.Rds")%>%
  filter(!is.na(budget))

glimpse(mv)

## Rows: 3,191
## Columns: 20
## $ title         <chr> "Almost Famous", "American Psycho", "Gladiator", "Requie…
## $ rating        <chr> "R", "R", "R", "Unrated", "R", "PG-13", "R", "PG-13", "P…
## $ genre         <chr> "Adventure", "Comedy", "Action", "Drama", "Mystery", "Ad…
## $ year          <dbl> 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 20…
## $ released      <chr> "September 22, 2000 (United States)", "April 14, 2000 (U…
## $ score         <dbl> 7.9, 7.6, 8.5, 8.3, 8.4, 7.8, 6.2, 6.4, 5.7, 7.4, 6.4, 7…
## $ votes         <dbl> 260000, 514000, 1400000, 786000, 1200000, 542000, 238000…
## $ director      <chr> "Cameron Crowe", "Mary Harron", "Ridley Scott", "Darren …
## $ writer        <chr> "Cameron Crowe", "Bret Easton Ellis", "David Franzoni", …
## $ star          <chr> "Billy Crudup", "Christian Bale", "Russell Crowe", "Elle…
## $ country       <chr> "United States", "United States", "United States", "Unit…
## $ budget        <dbl> 93289619, 10883789, 160147179, 6996721, 13993443, 139934…
## $ gross         <dbl> 73677478, 53278578, 723586629, 11490339, 62266278, 66800…
## $ company       <chr> "Columbia Pictures", "Am Psycho Productions", "Dreamwork…
## $ runtime       <dbl> 122, 101, 155, 102, 113, 143, 88, 130, 100, 104, 130, 16…
## $ id            <dbl> 877, 64, 1163, 2050, 52, 3795, 5544, 9301, 1093, 101, 68…
## $ imdb_id       <chr> "0181875", "0144084", "0172495", "0180093", "0209144", "…
## $ bechdel_score <dbl> 3, 3, 0, 3, 1, 2, 3, 2, 3, 1, 2, 3, 3, 0, NA, NA, 1, NA,…
## $ boxoffice_a   <dbl> 50586063, 23431686, 291849463, 5652546, 39717849, 363257…
## $ language      <chr> "English, French", "English, Spanish, Cantonese", "Engli…

This data comes from the Internet Movie Data Based, with contributions from several other sources.

Name	Description
title	Film Title
rating	MPAA Rating
genre	Genre: Adventure, Action etc
year	Year
released	Date released
score	IMDB Score
votes	Votes on IMDB
director	Director
writer	Screenwriter (top billed)
star	Top billed actor
country	Country where produced
runtime	Running time in minutes
id	Alternate ID
imdb_id	IMDB unique ID
bechdel_score	1=two women characters, 2=they speak to each other, 3= about something other than a man, 0=none of the above
box_office_a	Box office take
language	Languages spoken in the movie
gross	Gross revenue

Can we make money in the movie business?

There are a couple of ways we can answer this question. First of all, let’s look at gross minus budget (I’m avoiding the word profit because movie finance is deeply weird).

mv%>%
  mutate(gross_less_budget=gross-budget)%>%  
  summarize(dollar(mean(gross_less_budget,na.rm=TRUE)))

## # A tibble: 1 × 1
##   `dollar(mean(gross_less_budget, na.rm = TRUE))`
##   <chr>                                          
## 1 $113,277,345

Looks good! But wait a second, some movies must lose money right? Let’s see how many that is:

mv%>%
  mutate(gross_less_budget=gross-budget)%>%
  mutate(made_money=ifelse(gross_less_budget>0,1,0))%>%
  group_by(made_money)%>%
  drop_na()%>%
  count()%>%
  ungroup()%>%
  mutate(prop=n/sum(n))

## # A tibble: 2 × 3
##   made_money     n  prop
##        <dbl> <int> <dbl>
## 1          0   336 0.170
## 2          1  1645 0.830

Oof, so something like 18 percent of movies in this dataset lost money. How much did they lose?

mv%>%
  mutate(gross_less_budget=gross-budget)%>%
  mutate(made_money=ifelse(gross_less_budget>0,1,0))%>%
  group_by(made_money)%>%
  summarize(dollar(mean(gross_less_budget)))%>%
  drop_na()

## # A tibble: 2 × 2
##   made_money `dollar(mean(gross_less_budget))`
##        <dbl> <chr>                            
## 1          0 -$16,705,383                     
## 2          1 $155,755,006

16 million on average. We better get this right! Okay, Let’s get started on our model.

Dependent Variable

Our dependent variable will be gross from the movie which is a measure of revenue from all sources: box office, streaming, dvds etc.

mv%>%
  ggplot(aes(gross))+
  geom_density()+
  scale_x_continuous(labels=dollar_format())

Well, that looks weird. Some movies make A LOT. Most, not so much. We need to work with this on an appropriate scale. When working with almost any data that has to do with money we’re going to see things on an exponential scale. Our solution will be to transform this to be on a “log scale”. Really what we’re doing is taking the natural log of a number, which is the amount that Euler’s constant $e$ would need to be raised to in order to equal the nominal amount.

\[ log_e(y)=x, \equiv e^x=y \]

Let’s transform gross to be on a log scale. We can do this within ggplot to allow for some nicer labeling.

mv%>%
  ggplot(aes(x=gross))+
  geom_density()+
  scale_x_continuous(trans="log",
                     labels=dollar_format(),
                     breaks=breaks_log(n=6))

That looks somewhat better. Notice how the steps on the log scale imply very different amounts. Effectively what we’re doing is changing our thinking to be about percent changes. A 10% increase in gross above 10,000 is 1000. A 10% increase in gross above 100,000 is 10,000. On a log scale, these are (sort of) equivalent steps. Transforming this on the front end will have some implications on the back end, but we’ll deal with that in good time.

Gross as a Function of Budget

It’s quite likely that gross revenues will be related to the budget, but how likely? Let’s plot the relationship and find out.

gg<-mv%>%
  ggplot(aes(x=budget,y=gross,text=paste(title,"<br>",
                                          "Budget:", dollar(budget), "<br>",
                                          "Gross:" ,dollar(gross))))+
    geom_point(size=.25,alpha=.5)+

  scale_x_continuous(trans="log",
                     labels=label_dollar(),
                     breaks=log_breaks())+
   scale_y_continuous(trans="log",
                     labels=label_dollar(),
                     breaks=log_breaks())+
  xlab("Budget")+
  ylab("Gross")
  
ggplotly(gg,tooltip = "text")

You can navigate this plot and find out what the titles are. This is made possible by the ggplotly command, which uses the plotly library.

To make things easier, I’m going to create a new variable that is just the log of gross revenues

mv<-mv%>%
  mutate(log_gross=log(gross))

Basic Linear Model

This plot shows a line fit to the data, with the log of budget on the x axis and the log of gross budget on the y axis.

mv%>%
  mutate(log_budget=log(budget))%>%
  ggplot(aes(y=log_gross,x=log_budget))+
  geom_point(size=.25,alpha=.5)+
  geom_smooth(method="lm",se=FALSE)+
  xlim(0,25)

Does an assumption of linearity work in this case? Why or why not? Can we summarize this whole dataset in just two numbers?

Note that the geom_smooth(method = 'lm') command is running the model for us! Recall from above where we defined the theoretical regression as $Y = \alpha + \beta_1 X + \epsilon$. The figure above is now calculating $\hat{Y} = \hat{\alpha} + \hat{\beta_1} X + \hat{\epsilon}$.

How is it doing this? It is using the “linear model” regression function that is included in R! This function takes the form lm(formula,data) where formula is the regression equation and data is just the data. For example, if Y is logged gross and X is logged budget, we would write: lm(formula = log_gross ~ log_budget,data = mv). We can save this model to an object m1 with the assignment operator <- and then look at the results with summary().

m1 <- lm(log_gross ~ log_budget,mv %>%
           mutate(log_gross = log(gross),log_budget = log(budget)))

summary(m1)

## 
## Call:
## lm(formula = log_gross ~ log_budget, data = mv %>% mutate(log_gross = log(gross), 
##     log_budget = log(budget)))
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -8.2672 -0.6354  0.1648  0.7899  8.5599 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  1.26107    0.30953   4.074 4.73e-05 ***
## log_budget   0.96386    0.01786  53.971  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.281 on 3177 degrees of freedom
##   (12 observations deleted due to missingness)
## Multiple R-squared:  0.4783,	Adjusted R-squared:  0.4782 
## F-statistic:  2913 on 1 and 3177 DF,  p-value: < 2.2e-16

The results tell us that the (Intercept) (which is the same as $\alpha$ in our theory equation, and $\hat{\alpha}$ in our results) is equal to 1.26, and that the log_budget (which is the same as $\beta_1$ in our theory equation, and $\hat{\beta_1}$ in our results) is equal to 0.96. Thus, for every one unit increase in the logged budget, there is a little less than a 1 unit increase in the gross.

When we are comparing the relationship between a logged outcome and a logged predictor, we can interpret the coefficient as a percent change. Specifically, we would say that a one percent change in the budget corresponds to a 0.96 percent change in gross. For the full breakdown of how to talk about regression interpretations when it comes to logged data, see this website: https://sites.google.com/site/curtiskephart/ta/econ113/interpreting-beta.

Evaluating a Model

The summary() function tells us the predicted values for the right hand side of the regression equation: $\hat{\alpha}$ and $\hat{\beta_1}$. But we will also want to know the left-hand side: how good are our predictions for $\hat{Y}$? To answer this question, we want to measure the “errors” that our model makes. In other words, how off are our predicted values compared to the true values?

There are two ways to answer this question. The first is to just look at the errors, both as a univariate visualization and as a comparison between the errors and the predictor. The second is to calculate something called the Root Mean Squared Error, or RMSE.

But in either case, we need to calculate the errors themselves first, which are defined as the difference between the true values of $Y$ and the predicted values, denoted $\hat{Y}$. To calculate $\hat{Y}$, we can run the predict() function on the model object.

predY <- predict(m1)
predY %>% head()

##        1        2        3        4        5        6 
## 18.94904 16.87826 19.46990 16.45239 17.12049 19.33986

These values are exactly corresponding to the original data, meaning we can add them as a new column to our dataset in order to evaluate how good our model is. The more similar the predicted values to the actual values of the movie gross, the better our model!

NB: the number of predictions is not the same as the total number of rows in our data. This is because several of the rows contained missing data in either the outcome (gross) or in the predictor (budget). We can either create a new dataset that removes these missing values ahead of time, or we can use the information contained in the m1 object which tells us which rows were dropped due to missing data.

mvEval1 <- mv %>%
  slice(-m1$na.action) %>% # Drop any observations that were not used in the regression
  mutate(pred_gross = predY,
         log_gross = log(gross),
         log_budget = log(budget)) %>%
  select(title,log_gross,pred_gross,log_budget)

mvEval1 %>%
  head()

## # A tibble: 6 × 4
##   title               log_gross pred_gross log_budget
##   <chr>                   <dbl>      <dbl>      <dbl>
## 1 Almost Famous            18.1       18.9       18.4
## 2 American Psycho          17.8       16.9       16.2
## 3 Gladiator                20.4       19.5       18.9
## 4 Requiem for a Dream      16.3       16.5       15.8
## 5 Memento                  17.9       17.1       16.5
## 6 Cast Away                20.3       19.3       18.8

Now that we have our true $Y$ (log_gross) and our predicted $\hat{Y}$ (pred_gross), we can calculate the errors (denoted $\varepsilon$) by just subtracting the predicted values from the true values.

\[\varepsilon = Y - \hat{Y}\]

mvEval1 <- mvEval1 %>%
  mutate(errors = log_gross - pred_gross)
mvEval1 %>%
  head()

## # A tibble: 6 × 5
##   title               log_gross pred_gross log_budget errors
##   <chr>                   <dbl>      <dbl>      <dbl>  <dbl>
## 1 Almost Famous            18.1       18.9       18.4 -0.834
## 2 American Psycho          17.8       16.9       16.2  0.913
## 3 Gladiator                20.4       19.5       18.9  0.930
## 4 Requiem for a Dream      16.3       16.5       15.8 -0.195
## 5 Memento                  17.9       17.1       16.5  0.826
## 6 Cast Away                20.3       19.3       18.8  0.980

As we can see, sometimes our model overpredicts the log gross, which corresponds to the negative errors for Almost Famous and Requiem for a Dream. In other cases, it underpredicts the log cross, corresponding to positive errors for American Psycho, Gladiator, Memento, and Cast Away.

Visualizing Errors

The first thing to do is to just look at these errors. We do this in two ways. First we just plot them as a histogram or density. By construction, the errors will be centered around zero. However, a “good” model will have errors that are symmetrically distributed, taking the appearance of a bell curve. As we can see, our model does a pretty decent job. There is very mild skew, where we overpredict more than we underpredict (see that the distribution goes further out to the left below zero than to the right). Nevertheless, the distribution looks pretty good overall.

mvEval1 %>%
  ggplot(aes(x = errors)) + 
  geom_histogram() + 
  geom_vline(xintercept = 0,linetype = 'dashed')

The second thing to do is to visualize the errors as a scatter plot, where the errors are on the y-axis and the $X$ predictor (in this case, log_budget) is on the x-axis. Again, the center of this plot will be around zero on the y-axis by design. In this plot, a “good” model will look like a rectangular cloud of errors, where we miss above and below roughly equally, regardless of the budget. We can add a geom_smooth() to help visualize the performance. Ideally, we want the line to be flat and zero.

p <- mvEval1 %>%
  ggplot(aes(x = log_budget,y = errors,text = title)) + 
  geom_point() + 
  geom_smooth() + 
  geom_hline(yintercept = 0,linetype = 'dashed')

ggplotly(p)

As we can see, our model does poorly, as indicated by the curved geom_smooth() line. Substantively, this means that we are dramatically underestimating lower budget movies and, to a lesser extend, underestimating big budget movies. In both cases, our errors are positive.

Recall also that the perfect model is a uniform cloud of data. Meanwhile, our result has much larger mistakes for mid-budget movies compared to big budget movies. In the worst cases, we dramatically underestimate Paranormal Activity (the outlier in the top left of the plot), and overestimate Ginger Snaps (the outlier in the bottom center of the plot).

Based on these analyses, we would say that our model could be improved.

Root Mean Squared Error

It is always essential to look at the errors visually, with both univariate and multivariate plots. However, we also might want to save a single summary statistic that captures the overall performance, without having to rely on these somewhat subjective visualizations.

To do so, we will use a very standard method, Root Mean Squared Error, or RMSE. To calculate the RMSE, we just follow the recipe that is in its name. We square the errors (S), take the average (M), then take the square root of the result (R). The name RMSE is exactly what RMSE is– neat, huh?

\[ RMSE(\hat{Y})=\sqrt{ 1/n \sum_{i=1}^n(Y_i-\hat{Y_i})^2} \]

We can do this manually, and I think it’s instructive to do so at least once for learning. This might seem like a scary equation with a lot of greek letters, but let’s break it down into its separate pieces:

Let’s start with the errors $Y_i - \hat{Y}_i$. $Y_i$ are the true values and $\hat{Y}_i$ are the predictions. To calculate their difference, we just use a mutate() command and subtract the predicted values from the true values. mvEval1 <- mvEval1 %>% mutate(diff = log_gross - pred_gross).
Now we square this: mvEval1 <- mvEval1 %>% mutate(sqDiff = diff^2).
And now we take it’s average (note that $\frac{1}{n}\sum_{i=1}^n X_i$ is just the way we write average…we literally sum up every value $\sum_{i=1}^2 X_i$ and then divide this by $n$, which is the same as multiplying by $\frac{1}{n}$). msEval1 <- mvEval1 %>% summarise(mse = mean(sqDiff)).
Finally, we just take the square root! sqrt(msEval1$mse) and we’re done!

mvEval1 %>% 
  mutate(errors = log_gross - pred_gross) %>% # calculate the errors (E)
  mutate(sqErrors = errors^2) %>%             # square the errors (S)
  summarise(mse = mean(sqErrors)) %>%         # take the mean of the errors (M)
  summarise(rmse = sqrt(mse))                 # take the square root the mean (R)

## # A tibble: 1 × 1
##    rmse
##   <dbl>
## 1  1.28

That is a lot of work to calculate this! We can make it easier by calculating the errors (aka “residuals”) directly with the resid() function.

e <- resid(m1)
se <- e^2
mse <- mean(se)
rmse <- sqrt(mse)
rmse

## [1] 1.280835

Calculating rmse from the data we used to fit the line is actually not correct, because it doesn’t help us learn about out of sample data. To solve this problem, we need another concept: training and testing.

Training and Testing

The essence of prediction is discovering the extent to which our models can predict outcomes for data that does not come from our sample. Many times this process is temporal. We fit a model to data from one time period, then take predictors from a subsequent time period to come up with a prediction in the future. For instance, we might use data on team performance to predict the likely winners and losers for upcoming soccer games.

This process does not have to be temporal. We can also have data that is out of sample because it hadn’t yet been collected when our first data was collected, or we can also have data that is out of sample because we designated it as out of sample.

The data that is used to generate our predictions is known as training data. The idea is that this is the data used to train our model, to let it know what the relationship is between our predictors and our outcome. So far, we have only worked with training data.

That data that is used to validate our predictions is known as testing data. With testing data, we take our trained model and see how good it is at predicting outcomes using out of sample data.

One very simple approach to this would be to cut our data. We could then train our model on half the data, then test it on the other portion. This would tell us whether our measure of model fit (e.g. rmse) is similar or different when we apply our model to out of sample data. That’s what we’re going to do in this lesson. We’ll split the data randomly in two, with one part used to train our models and the other part used to test the model against out of sample data.

Training a model on one dataset, and then testing it on another dataset, is a method known as cross validation, because we validate (i.e., evaluate) our model on data it hasn’t seen yet. We want to repeat this process multiple times, using different random divisions of the data into training and test datasets.

You will notice that this approach is very similar to the bootstrapping we have already done.

Note: the set.seed command ensures that your random split should be the same as my random split.

Training and Testing Data

The core idea is to separate the data into two random subsets: a training set (where you will estimate a model) and a testing set (where you will test the model).

set.seed(123)

# First I'm going to add two columns of logged gross and logged budget to the dataset
mv <- mv %>%
  mutate(log_gross = log(gross),
         log_budget = log(budget))

# Get a list of row numbers for the training set
inds <- sample(1:nrow(mv),size = round(nrow(mv)/2),replace = F) # NB: we set replace = F for cross validation

# Now use these indices to create two data frames, the first that includes them, and the second that doesn't include them
train <- mv %>%
  slice(inds)

test <- mv %>%
  slice(-inds)

Now we estimate our model on the training set!

mTrain <- lm(log_gross ~ log_budget,train)

Instead of calculating the RMSE directly on this model though, we want to use this model to predict outcomes on the test dataset. To do this, we will use the predict() command again, but tell it to use a new dataset. To save a few steps, I’m going to add it directly to the test dataset.

test$predGross <- predict(mTrain,newdata = test)

Now we can calculate the RMSE here!

e <- test$predGross - test$log_gross
se <- e^2
mse <- mean(se,na.rm=T)
rmse <- sqrt(mse)

Great! Now let’s put it in a loop, just like with bootstrapping!

cvRes <- NULL

for(i in 1:100) {
  # Get a list of row numbers for the training set
  inds <- sample(1:nrow(mv),size = round(nrow(mv)/2),replace = F) # NB: we set replace = F for cross validation
  
  # Now use these indices to create two data frames, the first that includes them, and the second that doesn't include them
  train <- mv %>%
    slice(inds)
  
  test <- mv %>%
    slice(-inds)
  
  mTrain <- lm(log_gross ~ log_budget,train)
  
  test$predGross <- predict(mTrain,newdata = test)
  
  e <- test$predGross - test$log_gross
  se <- e^2
  mse <- mean(se,na.rm=T)
  rmse <- sqrt(mse)
  
  cvRes <- c(cvRes,rmse)
}

And now we have a vector of crossvalidated measures of model fit! Take the average to see how well we’re doing!

mean(cvRes,na.rm=T)

## [1] 1.286128

summary(cvRes)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   1.235   1.270   1.290   1.286   1.303   1.346

Evaluate Predictions in the Testing Data

Is this good? Who knows! RMSE is very context dependent. One way to think about it for us is that the model predicts that a 10 million dollar investment will generate about 18 million: sounds good, right?

summary(m1)

## 
## Call:
## lm(formula = log_gross ~ log_budget, data = mv %>% mutate(log_gross = log(gross), 
##     log_budget = log(budget)))
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -8.2672 -0.6354  0.1648  0.7899  8.5599 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  1.26107    0.30953   4.074 4.73e-05 ***
## log_budget   0.96386    0.01786  53.971  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.281 on 3177 degrees of freedom
##   (12 observations deleted due to missingness)
## Multiple R-squared:  0.4783,	Adjusted R-squared:  0.4782 
## F-statistic:  2913 on 1 and 3177 DF,  p-value: < 2.2e-16

quick_est<-exp(1.26+ (.96* log(1e7)))
dollar(quick_est)

## [1] "$18,501,675"

Except the RMSE says that gross could be between 66 million (yay) and 5.1 million. Right now, that’s our prediction– a 10 million dollar investment, base on this model, will make somewhere between 5.1 million and 66 million. Your investors are probably not thrilled and are thinking about just putting the money in T Bills (i.e., Treasuries).

quick_upper_bound<-exp(1.26+ .96*log(1e7) +1.28)

dollar(quick_upper_bound)

## [1] "$66,543,859"

quick_lower_bound<-exp(1.26+ .96* log(1e7) -1.28)

dollar(quick_lower_bound)

## [1] "$5,144,156"

Quick Exercise 1: Now, let’s see if the budget predicts a higher IMDB score for the film. Follow the process as before: check the distribution of the dependent variable (log transform if necessary), run a linear model, calculate the RMSE, and finally cross-validate. This will be a lot of copying/pasting from above, but really focus on what each part of the process is doing and comment accordingly! Finally, interpret your results: what is the relationship between a film’s budget and its IMDB score?

# INSERT CODE HERE

Write answer here.

Research Exercise 1: Let’s go through the process for regression analysis using your data! Complete the 5 steps of our “regression recipe” in the separate code chunks below. NB: some of these steps will be repeats from before, just think about how you can improve upon these steps from the last time.

Look at your data to identify missingness

# INSERT CODE HERE

Univariate visualization of your variables of interest (transform variable(s) if needed)

# INSERT CODE HERE

Multivariate visualization of your variables of interest (the y-axis should be your outcome variable)

# INSERT CODE HERE

Regression analysis

# INSERT CODE HERE

Evaluation of errors (you do not need to conduct cross-validation here)

# INSERT CODE HERE

Resources for PSC 4175: Introduction to Data Science

Mon, 01 Jan 0001 00:00:00 +0000

Important resources for the course.

Rstudio Cheat Sheet: Data Wrangling

Rstudio Cheat Sheet: ggplot2

R-graphics Cookbook

… And the full list of Rstudio cheat sheets

Tidymodels Resources

Schedule

Mon, 01 Jan 0001 00:00:00 +0000

You can find the schedule for the semester here. Below is the complete list of titles, assignemts & due dates, homeworks and links to the “Materials” for each week - the videos and slides of the lectures included.

Week	Date	Title	Goal	Assignment	Homeworks	Materials
1	Aug 25	Introduction	Scientific method, camps of analysis	PS0	HW1
2	Sep 1	Introduction to R	Objects, functions, and coding		HW2
3	Sep 8	Data Visualization	Visualizing data		HW3
4	Sep 15	Data Wrangling	Replicability and tabular data	PS1	HW4
5	Sep 22	Univariate and Multivariate Analysis	Conditional relationships		HW5
6	Sep 29	Multivariate 2	More conditional relationships		HW6
7	Oct 6	Uncertainty 1	Uncertainty and bootstrapping	PS2	HW7
--	Oct 13	Fall Break
8	Oct 20	Uncertainty 2	Confidence statements		HW8
9	Oct 27	Regression 1	Interpreting output and evaluating model	PS3	HW9
10	Nov 3	Regression 2	Interpreting output and evaluating model		HW10
11	Nov 10	Regression 3	Multiple regression, categorical Xs	PS4	HW11
12	Nov 17	Classification 1	The concept of logistic regression		HW12
13	Nov 24	Classification 2	Interpreting output and evaluating model		HW13
14	Dec 1	Clustering	k-means clustering	PS5	HW14
15	Dec 8	Final project presentations
16	Dec 16	Final papers due

Syllabus for PSC 4175: Introduction to Data Science

Mon, 01 Jan 0001 00:00:00 +0000

Head Instructor

Prof. Ryan Weldzius

Email: ryan.weldzius@villanova.edu

Web: ryanweldzius.com

Office Hours

Tuesdays, 2:30pm-4:30pm Villanova time
You must make an appointment for office hours here: https://calendly.com/weldzius/officehours
If you cannot make my office hours, please email me your availability at least 24-hours in advance and we can try to find a time that works.

Course Description

The use of large, quantitative data sets is increasingly central in social science. Whether one seeks to understand political behavior, economic outcomes, or violent conflict, the availability of large quantities of data has changed the study of social phenomena. In this course, students will learn about data acquisition, management, and visualization — what we call data science — to answer exciting questions in the social sciences. Whereas most data-related courses focus exclusively on probability theory, matrix algebra, and/or statistical estimation, our main focus will be on the computational tools of data science. Students will leave the course with the ability to acquire, clean, visualize, and analyze various types of political data using the statistical programming language R, which will set them up for success in future statistical courses (as well as the post-graduation job market). No prior background in statistics is required, but students should be familiar with how to use a computer and have a willingness to learn a variety of data science tools.

The contents of this repository represent a work-in-progress and revisions and edits are likely frequent.

The main text for the course is “R For Data Science” which can be assessed free online here. Note that there are no assigned readings from this book; the material is synthesized in the daily homework assignments. However, should you need another source with more detail, you’ll find most of the topics we cover in this course in this book.

Villanova has an enterprise site license for Microsoft’s Copilot chat application, which is built off of Open A.I. Copilot is available to all faculty, staff, and students here.

Class time and location: Asynchronous (online) Tuesdays; Synchronous (online) Thursdays 2:30-3:45pm.

Required Applications

R and R Studio

This course uses the open-source program R and its user interface R Studio. In order to use this program for all graded assignments (See Week 1), you will need a personal computer (laptop or desktop) capable of running this software. Notebooks, Chromebooks, and most tablets will not suffice. Falvey Library has computers on loan if needed.

Blackboard

This is the course management software used at Villanova University to support course learning. It is clunky, not user-friendly, and is thankfully on its way out soon. For these reasons, I will only utilize Blackboard to post course materials (e.g., additional readings), for you to submit your assignments, and to see your grades.

Campuswire

I have set up a Campuswire workspace for our use this semester to help us better communicate with each other. You will need to create an account and join our workspace by following this link. The Code/PIN can be found on the first email I sent to the class. You are encouraged to adopt these Slack etiquette tips. Most likely, you will utilize a similar communication system at a future job, so use this time wisely as you adopt best practices.

Here is the list of channels you should see upon joining the Campuswire workspace:

Class feed: A space to post questions and respond to other posts.
#announcements: A space for all course announcements.
#general: A space for you to share and discuss stories you’ve seen in the news or on social media that are relevant to our class.
Calendar: Not used. See Schedule.
Files: Not used. See Resources.
Grades: Not used. See Blackboard.

Evaluation & Responsibilities

As with learning any new topic or language, the best strategy is to put in a little effort every day. To this end, you will be assigned homework assignments for each class. These are your primary readings, so take your time working through them. You must submit each homework to Blackboard by Tuesday at 11:59pm on the date they are assigned.

You will be assigned bi-weekly problem sets that will test your ability to apply what you’ve learned in the lectures. These problem sets are assigned on the Monday of each week and are due by 11:59PM Villanova time the following Friday. You are welcome to collaborate on these problem sets, and are encouraged to ask questions on the Class feed on Campuswire.

The final grade is calculated as a weighted average of these components with the following weights:

Homeworks (35 points): There are 14 homeworks over the semester. Each will be worth between 1 and 3 points depending on their length/difficulty. Due on Tuesdays by 11:59pm.
Problem sets (35 points): 5 in total worth 7 points each. There will be 1 extra credit point available on each of the problem sets (occassionaly I’ll include an extra hard question for another potential extra credit point).
Final Project: Worth 20 points (write-up 15 points, presentation and comments 5 points). The final project for the course will be a data analysis project where students will find a dataset of interest, state an interesting research question about that data, and answer this question using that data. Students may work individually, or can work in groups of up to 3 students. Your proposal is due by Week 7 (a short description of your research question, argument, and potential data sources). In the final week of classes, you will present your work to the class in a short 5 minute presentation (recorded). Each student will watch your video and provide one positive comment, one looming question, and one helpful tip to improve the project. Final papers due by Tuesday, December 16 at 5:00pm.
Attendance & Participation: Worth 10 points. You are required to show up to our Thursday classes and participate.

See the table below for a breakdown of the percentages, points, and extra credit.

Item	Percent	Points	EC	Max
pset0	0%	0	0	0
pset1	7%	7	1	8
pset2	7%	7	1	8
pset3	7%	7	1	8
pset4	7%	7	1	8
pset5	7%	7	1	8
Homeworks	35%	35	0	35
Final Project	20%	20	0	20
Attendance/Participation	10%	10	0	10
Totals	100%	100	5	105

Letter grades are determined as per the standard Villanova grading system:

Letter Grade	Score Range
A	94+
A−	90–93
B+	87–89
B	84–86
B−	80–83
C+	77–79
C	74–76
C−	70–73
D+	67–69
D	64–66
D−	60–63
F	<60

Course Policies

Attendance

This course is a mix of asynchronous (Tuesdays) and synchronous (Thursdays, 2:30-3:45pm). You are required to attend all synchronous sessions and participate in the discussion.

Late Assignments

Late homeworks will not be accepted. Every problem set is assigned on a Monday and due on Blackboard by 11:59PM Villanova time on the following Friday. All graded work should be submitted via Blackboard. The problem sets are designed to require no more than a few hours to complete. Late submissions will be penalized 1 point off for each day late. After three days, problem sets will no longer be accepted and will be scored 0.

Academic Honor Code

All students are expected to uphold Villanova’s Academic Integrity Policy and Code. Any incident of academic dishonesty will be reported to the Dean of the College of Liberal Arts and Sciences for disciplinary action. You may view the University’s Academic Integrity Policy and Code for a detailed description.

If a student is found responsible for an academic integrity violation, which results in a grade penalty, they may not WX the course unless they are approved to WX for significant medical reasons. Students applying for a WX based on significant medical reasons, must submit documentation and their request for an exception will be considered.

Collaboration is the heart of data science, but your work on your assignments should be your own. Please be careful not to plagiarize. The above link is a very helpful guide to understanding plagiarism. In particular, while students are invited to work on problem sets together, collaboration is prohibited on the midterm and final exams.

Copilot and related Large Language Models (LLMs) are essential tools in the data scientist’s toolkit, and acceptable resources for completing the assignments and learning concepts at a deeper level. However, graded assignments cannot be generated purely by these tools. All assignments must include a log of the Copilot (or other AI programs) prompts and resulting output used to complete the assignment. If you are found to have used AI to complete an assignment with no citation and printed output, you will receive a zero for that assignment. A second infraction will lead to a failure of the class.

Office for Access & Disability Services (ADS) and Learning Support Services (LSS)

It is the policy of Villanova to make reasonable academic accommodations for qualified individuals with disabilities. All students who need accommodations should go to Clockwork for Students via myNOVA to complete the Online Intake or to send accommodation letters to professors. Go to the LSS website http://learningsupportservices.villanova.edu or the ADS website https://www1.villanova.edu/university/student-life/ods.html for registration guidelines and instructions. If you have any questions please contact LSS at 610-519-5176 or learning.support.services@villanova.edu, or ADS at 610-519-3209 or ods@villanova.edu.

Absences for Religious Holidays

Villanova University makes every reasonable effort to allow members of the community to observe their religious holidays, consistent with the University’s obligations, responsibilities, and policies. Students who expect to miss a class or assignment due to the observance of a religious holiday should discuss the matter with their professors as soon as possible, normally at least two weeks in advance. Absence from classes or examinations for religious reasons does not relieve students from responsibility for any part of the course work required during the absence. https://www1.villanova.edu/villanova/provost/resources/student/policies/religiousholidays.html.

Acknowledgements

The contents of this course are influenced by Prof. James H. Bisbee who teaches a similar course at Vanderbilt University. I am indebted to him for making his course materials available. The design of the webpage is inspired by Matthew Blackwell.

Univariate Analysis and Conditional Relationships

Mon, 01 Jan 0001 00:00:00 +0000

Agenda

Basics of univariate analysis
Conditional data: when a variable varies with respect to some other variable.
How does the value of the outcome of interest vary depending on the value of another variable of interest?
Typically: outcome of interest (dependent variable), Y-axis.
Other variables possibly related to the outcome (independent variables): X-axis

Our tools depend on the type of variables we are trying to graph.

Univariate Data Analysis

Univariate is pretty much what it sounds like: one variable. When undertaking univariate data analysis, we need first and foremost to figure what type of variable it is that we’re working with. Once we do that, we can choose the appropriate use of the variable, either as an outcome or as a possible predictor.

Motivating Question

We’ll be working with data from every NBA player who was active during the 2018-19 season.

Here’s the data:

require(tidyverse)
nba<-read_rds("https://github.com/rweldzius/PSC4175/raw/main/static/data/nba_players_2018.Rds")

This data contains the following variables:

Codebook for NBA Data

Name	Definition
namePlayer	Player name
idPlayer	Unique player id
slugSeason	Season start and end
numberPlayerSeason	Which season for this player
isRookie	Rookie season, true or false
slugTeam	Team short name
idTeam	Unique team id
gp	Games Played
gs	Games Started
fgm	Field goals made
fga	Field goals attempted
pctFG	Percent of field goals made
fg3m	3 point field goals made
fg3a	3 point field goals attempted
pctFG3	Percent of 3 point field goals made
pctFT	Free Throw percentage
fg2m	2 point field goals made
fg2a	2 point field goals attempted
pctFG2	Percent of 2 point field goals made
agePlayer	Player age
minutes	Minutes played
ftm	Free throws made
fta	Free throws attempted
oreb	Offensive rebounds
dreb	Defensive rebounds
treb	Total rebounds
ast	Assists
blk	Blocks
tov	Turnovers
pf	Personal fouls
pts	Total points
urlNBAAPI	Source url

We’re interested in the following questions:

Do certain colleges produce players that have more field goals? What about free throw percentage above a certain level? Are certain colleges in the east or the west more likely to produce higher scorers? How does this vary as a player has more seasons?

To answer these questions we need to look at the following variables:

Field goals
Free throw percentage above .25
Colleges
Player seasons
Region

We’re going to go through a pretty standard set of steps for each variable. First, examine some cases. Second, based on our examination, we’ll try either a plot or a table. Once we’ve seen the plot or the table, we’ll think a bit about ordering, and then choose an appropriate measure of central tendency, and maybe variation.

Types of Variables

It’s really important to understand the types of variables you’re working with. Many times analysts are indifferent to this step particularly with larger datasets. This can lead to a great deal of confusion down the road. Below are the variable types we’ll be working with this semester and the definition of each.

Continuous Variables

A continuous variable can theoretically be subdivided at any arbitrarily small measure and can still be identified. You may have encountered further subdivision of continuous variables into “interval” or “ratio” data in other classes. We RARELY use these distinctions in practice. The distinction between a continuous and a categorical variable is hugely consequential, but the distinction between interval and ratio is not really all that important in practice.

The mean is the most widely used measure of central tendency for a continuous variable. If the distribution of the variable isn’t very symmetric or there are large outliers, then the median is a much better measure of central tendency.

Categorical Variables

A categorical variables divides the sample up into a set of mutually exclusive and exhaustive categories. Mutually exclusive means that each case can only be one, and exhaustive means that the categories cover every possible option. Categorical is sort of the “top” level classification for variables of this type. Within the broad classification of categorical there are multiple types of other variables.

Categorical: ordered

an ordered categorical variable has– you guessed it– some kind of sensible order that can be applied. For instance, the educational attainment of an individual: high school diploma, associates degree, bachelor’s degree, graduate degree– is an ordered categorical variable.

Ordered categorical variables should be arranged in the order of the variable, with proportions or percentages associated with each order. The mode, or the category with the highest proportion, is a reasonable measure of central tendency, but with fewer than ten categories the analyst should generally just show the proportion in each category.

Categorical: ordered, binary

An ordered binary variable has just two levels, but can be ordered. For instance, is a bird undertaking its first migration: yes or no? A “no” means that the bird has more than one.

The mean of a binary variable is exactly the same thing as the proportion of the sample with that characteristic. So, the mean of a binary variable for “first migration” where 1=“yes” will give the proportion of birds migrating for the first time.

An ordered binary variable coded as 0 or 1 can be summarized using the mean which is the same thing as the proportion of the sample with that characteristic.

Categorical: unordered

An unordered categorical variable has no sensible ordering that can be applied. Think about something like college major. There’s no “number” we might apply to philosophy that has any meaningful distance from a number we might apply to chemical engineering.

Unlike an ordered variable, an unordered categorical variable should be ordered in terms of the proportions falling into each of the categories. As with an unordered variable, it’s best just to show the proportions in each category for variables with less than ten levels. The mode is a reasonable single variable summary of an unordered categorical variable.

Categorical: unordered, binary

This kind of variable has no particular order, but can be just binary. A “1” means that the case has that characteristics, a “0” means the case does not have that characteristic. For instance, whether a tree is deciduous or not.

An unordered binary variable coded as 0 or 1 can also be summarized by the mean, which is the same thing as the proportion of the sample with that characteristic.

Formats for categorical variables

In R, categorical variables CAN be stored as text, numbers or even logicals. Don’t count on the data to help you out– you as the analyst need to figure this out.

Factors

We probably need to talk about factors. In R, a factor is a way of storing categorical variables. The factor provides additional information, including an ordering of the variable and a number assigned to each “level” of the factor. A categorical variable is a general term that’s understood across statistics. A factor variable is a specific R term. Most of the time it’s best not to have a categorical variable structured as a factor unless you know you want it to be a factor. More on this later . . .

The Process: #TrustTheProcess

I’m going to walk you through how an analyst might typically decide what type of variables they’re working with. It generally works like this:

Take a look at a few observations and form a guess as to what type of variable it is.
Based on that guess, create an appropriate plot or table.
If the plot or table looks as expected, calculate some summary measures. If not, go back to 1.

“Glimpse” to start: what’s in here anyway?

The first thing we’re going to do with any dataset is just to take a quick look. We can call the data itself, but that will just show the first few cases and the first few variables. Far better is the glimpse command, which shows us all variables and the first few observations for all of the variables. Here’s a link to the codebook for this dataset:

The six variables we’re going to think about are field goals, free throw percentage, seasons played, rookie season, college attended, and conference played in.

glimpse(nba)

## Rows: 530
## Columns: 37
## $ namePlayer         <chr> "LaMarcus Aldridge", "Quincy Acy", "Steven Adams", …
## $ idPlayer           <dbl> 200746, 203112, 203500, 203518, 1628389, 1628959, 1…
## $ slugSeason         <chr> "2018-19", "2018-19", "2018-19", "2018-19", "2018-1…
## $ numberPlayerSeason <dbl> 12, 6, 5, 2, 1, 0, 0, 0, 0, 0, 8, 5, 4, 3, 1, 1, 1,…
## $ isRookie           <lgl> FALSE, FALSE, FALSE, FALSE, FALSE, TRUE, TRUE, TRUE…
## $ slugTeam           <chr> "SAS", "PHX", "OKC", "OKC", "MIA", "CHI", "UTA", "C…
## $ idTeam             <dbl> 1610612759, 1610612756, 1610612760, 1610612760, 161…
## $ gp                 <dbl> 81, 10, 80, 31, 82, 10, 38, 19, 34, 7, 81, 72, 43, …
## $ gs                 <dbl> 81, 0, 80, 2, 28, 1, 2, 3, 1, 0, 81, 72, 40, 4, 80,…
## $ fgm                <dbl> 684, 4, 481, 56, 280, 13, 67, 11, 38, 3, 257, 721, …
## $ fga                <dbl> 1319, 18, 809, 157, 486, 39, 178, 36, 110, 10, 593,…
## $ pctFG              <dbl> 0.519, 0.222, 0.595, 0.357, 0.576, 0.333, 0.376, 0.…
## $ fg3m               <dbl> 10, 2, 0, 41, 3, 3, 32, 6, 25, 0, 96, 52, 9, 24, 6,…
## $ fg3a               <dbl> 42, 15, 2, 127, 15, 12, 99, 23, 74, 4, 280, 203, 34…
## $ pctFG3             <dbl> 0.2380952, 0.1333333, 0.0000000, 0.3228346, 0.20000…
## $ pctFT              <dbl> 0.847, 0.700, 0.500, 0.923, 0.735, 0.667, 0.750, 1.…
## $ fg2m               <dbl> 674, 2, 481, 15, 277, 10, 35, 5, 13, 3, 161, 669, 1…
## $ fg2a               <dbl> 1277, 3, 807, 30, 471, 27, 79, 13, 36, 6, 313, 1044…
## $ pctFG2             <dbl> 0.5277995, 0.6666667, 0.5960347, 0.5000000, 0.58811…
## $ agePlayer          <dbl> 33, 28, 25, 25, 21, 21, 23, 22, 23, 26, 28, 24, 25,…
## $ minutes            <dbl> 2687, 123, 2669, 588, 1913, 120, 416, 194, 428, 22,…
## $ ftm                <dbl> 349, 7, 146, 12, 166, 8, 45, 4, 7, 1, 150, 500, 37,…
## $ fta                <dbl> 412, 10, 292, 13, 226, 12, 60, 4, 9, 2, 173, 686, 6…
## $ oreb               <dbl> 251, 3, 391, 5, 165, 11, 3, 3, 11, 1, 112, 159, 48,…
## $ dreb               <dbl> 493, 22, 369, 43, 432, 15, 20, 16, 49, 3, 498, 739,…
## $ treb               <dbl> 744, 25, 760, 48, 597, 26, 23, 19, 60, 4, 610, 898,…
## $ ast                <dbl> 194, 8, 124, 20, 184, 13, 25, 5, 65, 6, 104, 424, 1…
## $ stl                <dbl> 43, 1, 117, 17, 71, 1, 6, 1, 14, 2, 68, 92, 54, 22,…
## $ blk                <dbl> 107, 4, 76, 6, 65, 0, 6, 4, 5, 0, 33, 110, 37, 13, …
## $ tov                <dbl> 144, 4, 135, 14, 121, 8, 33, 6, 28, 2, 72, 268, 58,…
## $ pf                 <dbl> 179, 24, 204, 53, 203, 7, 47, 13, 45, 4, 143, 232, …
## $ pts                <dbl> 1727, 17, 1108, 165, 729, 37, 211, 32, 108, 7, 760,…
## $ urlNBAAPI          <chr> "https://stats.nba.com/stats/playercareerstats?Leag…
## $ n                  <int> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, …
## $ org                <fct> Texas, NA, Other, FC Barcelona Basquet, Kentucky, N…
## $ country            <chr> NA, NA, NA, "Spain", NA, NA, NA, NA, NA, NA, NA, "S…
## $ idConference       <int> 2, 2, 2, 2, 1, 1, 2, 1, 1, 2, 2, 1, 2, 1, 1, 1, 1, …

Continuous

Let’s start by taking a look at field goals. It seems pretty likely that this is a continuous variable. Let’s take a look at the top 50 spots.

nba%>% ## Start with the dataset
  select(namePlayer,slugTeam,fgm)%>% ## and then select a few variables
  arrange(-fgm)%>% ## arrange in reverse order of field goals
  print(n=50) ## print out the top 50

## # A tibble: 530 × 3
##    namePlayer            slugTeam   fgm
##    <chr>                 <chr>    <dbl>
##  1 James Harden          HOU        843
##  2 Bradley Beal          WAS        764
##  3 Kemba Walker          CHA        731
##  4 Giannis Antetokounmpo MIL        721
##  5 Kevin Durant          GSW        721
##  6 Paul George           OKC        707
##  7 Nikola Vucevic        ORL        701
##  8 LaMarcus Aldridge     SAS        684
##  9 Damian Lillard        POR        681
## 10 Karl-Anthony Towns    MIN        681
## 11 Donovan Mitchell      UTA        661
## 12 D'Angelo Russell      BKN        659
## 13 Klay Thompson         GSW        655
## 14 Stephen Curry         GSW        632
## 15 DeMar DeRozan         SAS        631
## 16 Russell Westbrook     OKC        630
## 17 Buddy Hield           SAC        623
## 18 Blake Griffin         DET        619
## 19 Nikola Jokic          DEN        616
## 20 Tobias Harris         MIN        611
## 21 Kyrie Irving          BOS        604
## 22 Devin Booker          PHX        586
## 23 Joel Embiid           PHI        580
## 24 CJ McCollum           POR        571
## 25 Julius Randle         NOP        571
## 26 Andre Drummond        DET        561
## 27 Kawhi Leonard         TOR        560
## 28 LeBron James          LAL        558
## 29 Jrue Holiday          NOP        547
## 30 Montrezl Harrell      LAC        546
## 31 Ben Simmons           PHI        540
## 32 Anthony Davis         NOP        530
## 33 Zach LaVine           CHI        530
## 34 Jordan Clarkson       CLE        529
## 35 Trae Young            ATL        525
## 36 Bojan Bogdanovic      IND        522
## 37 Pascal Siakam         TOR        519
## 38 Collin Sexton         CLE        519
## 39 Jamal Murray          DEN        513
## 40 Deandre Ayton         PHX        509
## 41 Luka Doncic           DAL        506
## 42 Khris Middleton       MIL        506
## 43 De'Aaron Fox          SAC        505
## 44 Andrew Wiggins        MIN        498
## 45 Kyle Kuzma            LAL        496
## 46 Mike Conley           MEM        490
## 47 Lou Williams          LAC        484
## 48 Steven Adams          OKC        481
## 49 Rudy Gobert           UTA        476
## 50 Clint Capela          HOU        474
## # ℹ 480 more rows

So what I’m seeing here is that field goals aren’t “clumped” at certain levels. Let’s confirm that by looking at a kernel density plot.

nba%>%
  ggplot(aes(x=fgm))+
  geom_density()

We can also use a histogram to figure out much the same thing.

nba%>%
  ggplot(aes(x=fgm))+
  geom_histogram()

Now, technically field goals don’t meet the definition I set out above as being a continuous variable because they aren’t divisible below a certain amount. Usually in practice though we just ignore this– this variable is “as good as” continuous, given that it varies smoothly over the range and isn’t confined to a relatively small set of possible values.

Quick Exercise 1: Do the same thing for field goal percentage and think about what kind of variable it is.

# INSERT CODE HERE

Measures for Continuous Variables

The mean is used most of the time for continuous variables, but it’s VERY sensitive to outliers. The median (50th percentile) is usually better, but it can be difficult to explain to general audiences.

nba%>%
  summarize(mean_fgm=mean(fgm))

## # A tibble: 1 × 1
##   mean_fgm
##      <dbl>
## 1     191.

nba%>%
  summarize(median_fgm=median(fgm))

## # A tibble: 1 × 1
##   median_fgm
##        <dbl>
## 1        157

In this case I’d really prefer the mean as a single measure of field goal production, but depending on the audience I still might just go ahead and use the median.

Quick Exercise 2 What measure would you prefer for field goal percentage? Calculate that measure.

# INSERT CODE HERE

Categorical: ordered

Let’s take a look at player seasons.

nba%>%
  select(namePlayer,numberPlayerSeason)%>%
  arrange(-numberPlayerSeason)%>%
  print(n=50)

## # A tibble: 530 × 2
##    namePlayer        numberPlayerSeason
##    <chr>                          <dbl>
##  1 Vince Carter                      20
##  2 Dirk Nowitzki                     20
##  3 Jamal Crawford                    18
##  4 Tony Parker                       17
##  5 Tyson Chandler                    17
##  6 Pau Gasol                         17
##  7 Nene                              16
##  8 Carmelo Anthony                   15
##  9 Udonis Haslem                     15
## 10 LeBron James                      15
## 11 Zaza Pachulia                     15
## 12 Dwyane Wade                       15
## 13 Kyle Korver                       15
## 14 Luol Deng                         14
## 15 Devin Harris                      14
## 16 Dwight Howard                     14
## 17 Andre Iguodala                    14
## 18 JR Smith                          14
## 19 Trevor Ariza                      14
## 20 Andrew Bogut                      13
## 21 Jose Calderon                     13
## 22 Raymond Felton                    13
## 23 Amir Johnson                      13
## 24 Shaun Livingston                  13
## 25 Chris Paul                        13
## 26 Marvin Williams                   13
## 27 Lou Williams                      13
## 28 CJ Miles                          13
## 29 LaMarcus Aldridge                 12
## 30 J.J. Barea                        12
## 31 Channing Frye                     12
## 32 Rudy Gay                          12
## 33 Kyle Lowry                        12
## 34 Paul Millsap                      12
## 35 JJ Redick                         12
## 36 Rajon Rondo                       12
## 37 Thabo Sefolosha                   12
## 38 Marco Belinelli                   11
## 39 Mike Conley                       11
## 40 Kevin Durant                      11
## 41 Jared Dudley                      11
## 42 Marcin Gortat                     11
## 43 Gerald Green                      11
## 44 Al Horford                        11
## 45 Joakim Noah                       11
## 46 Thaddeus Young                    11
## 47 Nick Young                        11
## 48 Corey Brewer                      11
## 49 D.J. Augustin                     10
## 50 Jerryd Bayless                    10
## # ℹ 480 more rows

Looks like it might be continuous? Let’s plot it:

nba%>%
  ggplot(aes(x=numberPlayerSeason))+
  geom_histogram(binwidth = 1)

Nope. See how it falls into a small set of possible categories? This is an ordered categorical variable. That means we should calculate the proportions in each category

nba%>%
  group_by(numberPlayerSeason)%>%
  count(name="total_in_group")%>%
  ungroup()%>%
  mutate(proportion=total_in_group/sum(total_in_group))

## # A tibble: 20 × 3
##    numberPlayerSeason total_in_group proportion
##                 <dbl>          <int>      <dbl>
##  1                  0            105    0.198  
##  2                  1             89    0.168  
##  3                  2             56    0.106  
##  4                  3             43    0.0811 
##  5                  4             37    0.0698 
##  6                  5             33    0.0623 
##  7                  6             31    0.0585 
##  8                  7             25    0.0472 
##  9                  8             19    0.0358 
## 10                  9             20    0.0377 
## 11                 10             24    0.0453 
## 12                 11             11    0.0208 
## 13                 12              9    0.0170 
## 14                 13              9    0.0170 
## 15                 14              6    0.0113 
## 16                 15              6    0.0113 
## 17                 16              1    0.00189
## 18                 17              3    0.00566
## 19                 18              1    0.00189
## 20                 20              2    0.00377

What does this tell us?

Quick Exercise 3 Create a histogram for player age. What does that tell us about the NBA?

# INSERT CODE HERE

Categorical: ordered, binary

Let’s take a look at the variable for Rookie season.

nba%>%select(namePlayer,isRookie)

## # A tibble: 530 × 2
##    namePlayer             isRookie
##    <chr>                  <lgl>   
##  1 LaMarcus Aldridge      FALSE   
##  2 Quincy Acy             FALSE   
##  3 Steven Adams           FALSE   
##  4 Alex Abrines           FALSE   
##  5 Bam Adebayo            FALSE   
##  6 Rawle Alkins           TRUE    
##  7 Grayson Allen          TRUE    
##  8 Deng Adel              TRUE    
##  9 Jaylen Adams           TRUE    
## 10 DeVaughn Akoon-Purcell TRUE    
## # ℹ 520 more rows

Okay, so that’s set to a logical. In R, TRUE or FALSE are special values that indicate the result of a logical question. In this it’s whether or not the player is a rookie.

Usually we want a binary variable to have at least one version that’s structured so that 1= TRUE and 2=FALSE. This makes data analysis much easier. Let’s do that with this variable.

This code uses ifelse to create a new variable called isRookiebin that’s set to 1 if the isRookie variable is true, and 0 otherwise.

nba<-nba%>%
  mutate(isRookie_bin=ifelse(isRookie==TRUE,1,0))

Now that it’s coded 0,1 we can calculate the mean, which is the same thing as the proportion of the players that are rookies.

nba%>%summarize(mean=mean(isRookie_bin))

## # A tibble: 1 × 1
##    mean
##   <dbl>
## 1 0.198

Categorical: unordered

Let’s take a look at which college a player attended, which is a good example of an unordered categorical variable. The org variable tells us which organization the player was in before playing in the NBA.

nba%>%
  select(org)%>%
  glimpse()

## Rows: 530
## Columns: 1
## $ org <fct> Texas, NA, Other, FC Barcelona Basquet, Kentucky, NA, Duke, NA, NA…

This look like team or college names, so this would be a categorical variable. Let’s take a look at the counts of players from different organizations:

nba%>%
  group_by(org)%>%
  count()%>%
  arrange(-n)%>%
  print(n=50)

## # A tibble: 68 × 2
## # Groups:   org [68]
##    org                        n
##    <fct>                  <int>
##  1 <NA>                     157
##  2 Other                     85
##  3 Kentucky                  25
##  4 Duke                      17
##  5 California-Los Angeles    15
##  6 Kansas                    11
##  7 Arizona                   10
##  8 Texas                     10
##  9 North Carolina             9
## 10 Michigan                   8
## 11 Villanova                  7
## 12 Indiana                    6
## 13 Southern California        6
## 14 Syracuse                   6
## 15 California                 5
## 16 Louisville                 5
## 17 Ohio State                 5
## 18 Wake Forest                5
## 19 Colorado                   4
## 20 Connecticut                4
## 21 Creighton                  4
## 22 FC Barcelona Basquet       4
## 23 Florida                    4
## 24 Georgia Tech               4
## 25 Michigan State             4
## 26 Oregon                     4
## 27 Utah                       4
## 28 Washington                 4
## 29 Wisconsin                  4
## 30 Boston College             3
## 31 Florida State              3
## 32 Georgetown                 3
## 33 Gonzaga                    3
## 34 Iowa State                 3
## 35 Marquette                  3
## 36 Maryland                   3
## 37 Miami (FL)                 3
## 38 North Carolina State       3
## 39 Notre Dame                 3
## 40 Oklahoma                   3
## 41 Purdue                     3
## 42 Southern Methodist         3
## 43 Stanford                   3
## 44 Tennessee                  3
## 45 Virginia                   3
## 46 Anadolu Efes S.K.          2
## 47 Baylor                     2
## 48 Butler                     2
## 49 Cincinnati                 2
## 50 Kansas State               2
## # ℹ 18 more rows

Here we have a problem. If we’re interested just in colleges, we’re going to need to structure this a bit more. The code below filters out three categories that we don’t want: missing data, anything classified as others, and sports teams from other countries. The last is incomplete– I probably missed some! If I were doing this for real, I would use a list of colleges and only include those names.

What I do below is to negate the str_detect variable by placing the ! in front of it. This means I want all of the cases that don’t match the pattern the supplied. The pattern makes heavy use of the OR operator |. I’m saying I don’t want to include players whose organization included the letters CB r KK and so on (these are common prefixes for sports organizations in other countries, I definitely did not look that up on Wikipedia. Ok, I did.).

nba%>%
  filter(!is.na(org))%>%
  filter(!org=="Other")%>%
  filter(!str_detect(org,"CB|KK|rytas|FC|B.C.|S.K.|Madrid"))%>%
  group_by(org)%>%
  count()%>%
  arrange(-n)%>%
  print(n=50)

## # A tibble: 57 × 2
## # Groups:   org [57]
##    org                        n
##    <fct>                  <int>
##  1 Kentucky                  25
##  2 Duke                      17
##  3 California-Los Angeles    15
##  4 Kansas                    11
##  5 Arizona                   10
##  6 Texas                     10
##  7 North Carolina             9
##  8 Michigan                   8
##  9 Villanova                  7
## 10 Indiana                    6
## 11 Southern California        6
## 12 Syracuse                   6
## 13 California                 5
## 14 Louisville                 5
## 15 Ohio State                 5
## 16 Wake Forest                5
## 17 Colorado                   4
## 18 Connecticut                4
## 19 Creighton                  4
## 20 Florida                    4
## 21 Georgia Tech               4
## 22 Michigan State             4
## 23 Oregon                     4
## 24 Utah                       4
## 25 Washington                 4
## 26 Wisconsin                  4
## 27 Boston College             3
## 28 Florida State              3
## 29 Georgetown                 3
## 30 Gonzaga                    3
## 31 Iowa State                 3
## 32 Marquette                  3
## 33 Maryland                   3
## 34 Miami (FL)                 3
## 35 North Carolina State       3
## 36 Notre Dame                 3
## 37 Oklahoma                   3
## 38 Purdue                     3
## 39 Southern Methodist         3
## 40 Stanford                   3
## 41 Tennessee                  3
## 42 Virginia                   3
## 43 Baylor                     2
## 44 Butler                     2
## 45 Cincinnati                 2
## 46 Kansas State               2
## 47 Louisiana State            2
## 48 Memphis                    2
## 49 Missouri                   2
## 50 Murray State               2
## # ℹ 7 more rows

That looks better. Which are the most common colleges and universities that send players to the NBA?

Quick Exercise 4 Arrange the number of players by team in descending order.

# INSERT CODE HERE

Categorical: unordered, binary

There are two conference in the NBA, eastern and western. Let’s take a look at the variable that indicates which conference the payer played in that season.

nba%>%select(idConference)%>%
  glimpse()

## Rows: 530
## Columns: 1
## $ idConference <int> 2, 2, 2, 2, 1, 1, 2, 1, 1, 2, 2, 1, 2, 1, 1, 1, 1, 2, 2, …

nba<-nba%>%
  mutate(west_conference=ifelse(idConference==1,1,0))

Once we’ve done that, we can see how many players played in each conference.

nba%>%
  summarize(mean(west_conference))

## # A tibble: 1 × 1
##   `mean(west_conference)`
##                     <dbl>
## 1                   0.508

Makes sense!

Quick Exercise 5:* create a variable for whether or not the player is from the USA. Calculate the proportion of players from the USA in the NBA. The coding on country is … decidedy US-centric, so you’ll need to think about this one a bit.

# INSERT CODE HERE

Analysis

Ok, now that we know how this works, we can do some summary analysis. First of all, what does the total number of field goals made look like by college?

We know that field goals are continuous (sort of) so let’s summarize them via the mean. We know that college is a categorical variable, so we’ll use that to group the data. This is one of our first examples of a conditiona mean, which we’ll use a lot.

Top 50 Colleges by Total FG

nba%>%
  filter(!is.na(org))%>%
  filter(!org=="Other")%>%
  filter(!str_detect(org,"CB|KK|rytas|FC|B.C.|S.K.|Madrid"))%>%
  group_by(org)%>%
  summarize(mean_fg=sum(fgm))%>%
  arrange(-mean_fg)%>%
  print(n=50)

## # A tibble: 57 × 2
##    org                    mean_fg
##    <fct>                    <dbl>
##  1 Kentucky                  6594
##  2 Duke                      4623
##  3 Texas                     3437
##  4 California-Los Angeles    3382
##  5 Kansas                    2765
##  6 Arizona                   2101
##  7 Oklahoma                  1767
##  8 Southern California       1758
##  9 Louisville                1679
## 10 North Carolina            1659
## 11 Indiana                   1522
## 12 Ohio State                1486
## 13 Michigan                  1392
## 14 Wake Forest               1364
## 15 Connecticut               1299
## 16 Villanova                 1222
## 17 Georgia Tech              1169
## 18 Tennessee                 1095
## 19 Stanford                   949
## 20 Utah                       943
## 21 Marquette                  873
## 22 Gonzaga                    863
## 23 Michigan State             820
## 24 Colorado                   818
## 25 Virginia                   816
## 26 Maryland                   811
## 27 Missouri                   756
## 28 California                 734
## 29 Florida State              733
## 30 Georgetown                 717
## 31 Memphis                    620
## 32 Florida                    618
## 33 North Carolina State       598
## 34 Boston College             586
## 35 Louisiana State            583
## 36 Syracuse                   567
## 37 Iowa State                 523
## 38 Butler                     459
## 39 Wisconsin                  456
## 40 Creighton                  432
## 41 Oregon                     352
## 42 Texas A&M                  322
## 43 Baylor                     312
## 44 Providence                 291
## 45 Purdue                     275
## 46 Notre Dame                 263
## 47 Ulkerspor                  252
## 48 Southern Methodist         246
## 49 Oklahoma State             242
## 50 West Virginia              236
## # ℹ 7 more rows

Next, what about field goal percentage?

Top 50 Colleges by Average Field Goal Percent

nba%>%
  filter(!is.na(org))%>%
  filter(!org=="Other")%>%
  filter(!str_detect(org,"CB|KK|rytas|FC|B.C.|S.K.|Madrid"))%>%
  group_by(org)%>%
  summarize(mean_ftp=mean(pctFT))%>%
  arrange(-mean_ftp)%>%
  print(n=50)

## # A tibble: 57 × 2
##    org                  mean_ftp
##    <fct>                   <dbl>
##  1 Tennessee               0.842
##  2 Virginia                0.833
##  3 Oklahoma                0.823
##  4 North Carolina State    0.817
##  5 West Virginia           0.804
##  6 Ulkerspor               0.803
##  7 Missouri                0.802
##  8 Wake Forest             0.802
##  9 Florida State           0.801
## 10 Murray State            0.798
## 11 Iowa State              0.795
## 12 Notre Dame              0.792
## 13 Memphis                 0.788
## 14 Florida                 0.784
## 15 Michigan                0.783
## 16 Stanford                0.779
## 17 Georgetown              0.775
## 18 Marquette               0.774
## 19 Utah                    0.770
## 20 Kansas State            0.767
## 21 Butler                  0.762
## 22 Gonzaga                 0.761
## 23 North Carolina          0.756
## 24 Villanova               0.755
## 25 Texas                   0.752
## 26 Connecticut             0.748
## 27 Providence              0.747
## 28 Boston College          0.742
## 29 Michigan State          0.730
## 30 Kansas                  0.729
## 31 Indiana                 0.729
## 32 Duke                    0.728
## 33 Baylor                  0.726
## 34 Arizona                 0.721
## 35 Pallacanestro Biella    0.718
## 36 Wisconsin               0.712
## 37 Kentucky                0.712
## 38 Georgia Tech            0.712
## 39 Louisiana State         0.709
## 40 Creighton               0.698
## 41 Maryland                0.695
## 42 Vanderbilt              0.688
## 43 Washington              0.680
## 44 Louisville              0.679
## 45 Ohio State              0.679
## 46 California              0.675
## 47 Southern Methodist      0.673
## 48 Oregon                  0.662
## 49 Texas A&M               0.652
## 50 Southern California     0.648
## # ℹ 7 more rows

Quick Exercise 6 Calculate field goals made by player season.

# INSERT CODE HERE

Quick Exercise 7 Calculate free throw percent made by player season.

# INSERT CODE HERE

Conditional relationships: The “gender” gap in electoral politics

Conditional variation involves examining how the values of two or more variables are related to one another. Earlier we made these comparisons by creating different tibbles and then comparing across tibbles, but we can also make comparisons without creating multiple tibbles.

So load in the Michigan 2020 Exit Poll Data.

library(tidyverse)
library(scales)
mi_ep <- read_rds("https://github.com/rweldzius/PSC4175/raw/main/static/data/MI2020_ExitPoll_small.rds")
MI_final_small <- mi_ep %>%
  filter(preschoice=="Donald Trump, the Republican" | preschoice=="Joe Biden, the Democrat") %>%
  mutate(BidenVoter=ifelse(preschoice=="Joe Biden, the Democrat",1,0),
         TrumpVoter=ifelse(BidenVoter==1,0,1),
         AGE10=ifelse(AGE10==99,NA,AGE10))

We learned that if we count using multiple variables that R will count within values. Can we use this to analyze how this varies by groups? Let’s see!

MI_final_small %>%
  filter(AGE10==1) %>%
  count(preschoice,SEX) %>%
  mutate(PctSupport = n/sum(n),
         PctSupport = round(PctSupport, digits=2))

## # A tibble: 4 × 4
##   preschoice                     SEX     n PctSupport
##   <chr>                        <dbl> <int>      <dbl>
## 1 Donald Trump, the Republican     1     7       0.22
## 2 Donald Trump, the Republican     2     1       0.03
## 3 Joe Biden, the Democrat          1     9       0.28
## 4 Joe Biden, the Democrat          2    15       0.47

Here we have broken everything out by both preschoice and SEX but the PctSupport is not quite what we want because it is the fraction of responses (out of 1) that are in each row rather than the proportion of support for each candidate by sex.

To correct this and to perform the functions within a value we need to use the group_by function.

We can use the group_by command to organize our data a bit better. What group_by does is to run all subsequent code separately according to the defined group.

So instead of running a count or summarize separately for both Males and Females as we did above, we can group_by the variable SEX.chr (or FEMALE or SEX – it makes no difference as they are all equivalent) and then preform the subsequent commands. So here we are going to filter to select those who are 24 and below and then we are going to count the number of Biden and Trump supporters within each value of SEX.chr

MI_final_small %>%
  filter(AGE10==1) %>%
  group_by(SEX) %>%
  count(preschoice)

## # A tibble: 4 × 3
## # Groups:   SEX [2]
##     SEX preschoice                       n
##   <dbl> <chr>                        <int>
## 1     1 Donald Trump, the Republican     7
## 2     1 Joe Biden, the Democrat          9
## 3     2 Donald Trump, the Republican     1
## 4     2 Joe Biden, the Democrat         15

Note that any functions of the data are also now organized by that grouping, so if we were to manually compute the proportions using the mutation approach discussed above we would get:

MI_final_small %>%
  filter(AGE10==1) %>%
  group_by(SEX) %>%
  count(preschoice) %>%
  mutate(PctSupport = n/sum(n),
         PctSupport = round(PctSupport, digits=2))

## # A tibble: 4 × 4
## # Groups:   SEX [2]
##     SEX preschoice                       n PctSupport
##   <dbl> <chr>                        <int>      <dbl>
## 1     1 Donald Trump, the Republican     7       0.44
## 2     1 Joe Biden, the Democrat          9       0.56
## 3     2 Donald Trump, the Republican     1       0.06
## 4     2 Joe Biden, the Democrat         15       0.94

So you can see that PctSupport sums to 2.0 because it sums to 1.0 within each value of the grouping variable SEX.

If we wanted the fraction of voters who are in each unique category - so that the percentage of all the categories sum to 1.0 – we would want to ungroup before doing the mutation that calculates the percentage. So here we are doing the functions after the group_by() separately for each value of the grouping variables (here SEX) and then we are going to then undo that and return to the entire dataset.

MI_final_small %>%
  filter(AGE10==1) %>%
  group_by(SEX) %>%
  count(preschoice) %>%
  ungroup() %>%
  mutate(PctSupport = n/sum(n),
         PctSupport = round(PctSupport, digits=2))

## # A tibble: 4 × 4
##     SEX preschoice                       n PctSupport
##   <dbl> <chr>                        <int>      <dbl>
## 1     1 Donald Trump, the Republican     7       0.22
## 2     1 Joe Biden, the Democrat          9       0.28
## 3     2 Donald Trump, the Republican     1       0.03
## 4     2 Joe Biden, the Democrat         15       0.47

If we are just interested in the proportion and we do not care about the number of respondents in each value (although here it seems relevant!) we could also group_by and then summarize as follows:

MI_final_small %>%
  filter(AGE10==1) %>%
  group_by(SEX) %>%
  summarize(PctBiden = mean(BidenVoter),
          PctTrump = mean(TrumpVoter)) %>%
  mutate(PctBiden = round(PctBiden, digits =2),
         PctTrump = round(PctTrump, digits =2))

## # A tibble: 2 × 3
##     SEX PctBiden PctTrump
##   <dbl>    <dbl>    <dbl>
## 1     1     0.56     0.44
## 2     2     0.94     0.06

Because we have already filtered to focus only on Biden and Trump voters, we don’t actually need both since PctBiden = 1 - PctTrump and PctTrump = 1 - PctBiden.

Note that we can have multiple groups. So if we want to group by age and by sex we can do the following…

MI_final_small %>%
  group_by(SEX, AGE10) %>%
  summarize(PctBiden = mean(BidenVoter)) %>%
  mutate(PctBiden = round(PctBiden, digits =2))

## # A tibble: 22 × 3
## # Groups:   SEX [2]
##      SEX AGE10 PctBiden
##    <dbl> <dbl>    <dbl>
##  1     1     1     0.56
##  2     1     2     0.58
##  3     1     3     0.58
##  4     1     4     0.76
##  5     1     5     0.58
##  6     1     6     0.42
##  7     1     7     0.46
##  8     1     8     0.56
##  9     1     9     0.61
## 10     1    10     0.57
## # ℹ 12 more rows

We can also save it for later analysis and then filter or select the results. For example:

SexAge <- MI_final_small %>%
  group_by(SEX, AGE10) %>%
  summarize(PctBiden = mean(BidenVoter)) %>%
  mutate(PctBiden = round(PctBiden, digits =2)) %>%
  drop_na()

So if we want to look at the Biden support by age among females (i.e., SEX==2) we can look at:

SexAge %>%
  filter(SEX == 2)

## # A tibble: 10 × 3
## # Groups:   SEX [1]
##      SEX AGE10 PctBiden
##    <dbl> <dbl>    <dbl>
##  1     2     1     0.94
##  2     2     2     0.93
##  3     2     3     0.69
##  4     2     4     0.71
##  5     2     5     0.52
##  6     2     6     0.6 
##  7     2     7     0.63
##  8     2     8     0.74
##  9     2     9     0.69
## 10     2    10     0.61

Quick Exercise 8 What is the Biden support by age among males?

# INSERT CODE HERE

Dicrete Variable By Discrete Variable (Barplot)

If we are working with discrete/categorical/ordinal/data — i.e., variables that take on a finite (and small) number of unique values then we are interested in how to compare across bar graphs.

Before we used geom_bar to plot the number of observations associated with each value of a variable. But we often want to know how the number of observations may vary according to a second variable. For example, we care not only about why voters reported that they supported Biden or Trump in 2020 but we are also interested in knowing whether Biden and Trump voters were voting for similar or different reasons. Did voters differ in terms of why they were voting for a candidate in addition to who they were voting for? If so, this may suggest something about what each set of voters were looking for in a candidate.

Let’s first plot the barplot and then plot the barplot by presidential vote choice for the Michigan Exit Poll we were just analyzing.

We are interested in the distribution of responses to the variable Quality and we only care about voters who voted for either Biden or Trump (preschoice) so let’s select those variables and filter using preschoice to select those respondents. We have an additional complication that the question was only asked of half of the respondents and some that were asked refused to answer. To remove these respondents we want to drop_na (note that this will drop every observation with a missing value – this is acceptable because we have used select to focus on the variables we are analyzing, but if we did not use select it would have dropped an observation with missing data in any variable. We could get around this using drop_na(Quality) if we wanted). A final complication is that some respondents did not answer the question they were asked so we have to use filter to remove respondents with missing observations.

Now we include labels – note how we are suppressing the x-label because the value labels are self-explanatory in this instance and add the geom_bar as before.

mi_ep %>% 
    select(Quality,preschoice) %>%
    filter(preschoice == "Joe Biden, the Democrat" | preschoice == "Donald Trump, the Republican") %>%
    drop_na() %>%
    filter(Quality != "[DON'T READ] Don’t know/refused") %>%
    ggplot(aes(x= Quality)) +     
    labs(y = "Number of Voters",
         x = "",
         title = "Michigan 2020 Exit Poll: Reasons for voting for a candidate") +
    geom_bar(color="black")

Note that if we add coord_flip that we will flip the axes of the graph. (We could also have done this by changing aes(y= Quality), but then we would also have to change the associated labels.)

mi_ep %>% 
    select(Quality,preschoice) %>%
    filter(preschoice == "Joe Biden, the Democrat" | preschoice == "Donald Trump, the Republican") %>%
    drop_na() %>%
    filter(Quality != "[DON'T READ] Don’t know/refused") %>%
    ggplot(aes(x= Quality)) +     
    labs(y = "Number of Voters",
         x = "",
         title = "Michigan 2020 Exit Poll: Reasons for voting for a candidate") +
    geom_bar(color="black") + 
  coord_flip()

So enough review, lets add another dimension to the data. To show how the self-reported reasons for voting for a presidential candidate varied by vote choice we are going to use the fill of the graph to create different color bars depending on the value of the character or factor variable that is used to fill.

So we are going to include as a ggplot aesthetic a character or factor variable as a fill (here fill=preschoice) and then we are going to also include fill in the labs function to make sure that we label the meaning of the values being plotted. The other change we have made is in geom_bar where we used position=dodge to make sure that the bars are plotted next to one-another rather than on top of one another.

mi_ep %>% 
    select(Quality,preschoice) %>%
    filter(preschoice == "Joe Biden, the Democrat" | preschoice == "Donald Trump, the Republican") %>%
    drop_na() %>%
    filter(Quality != "[DON'T READ] Don’t know/refused") %>%
    ggplot(aes(x= Quality, fill = preschoice)) +     
    labs(y = "Number of Voters",
         x = "",
         title = "Michigan 2020 Exit Poll: Reasons for voting for a candidate",
         fill = "Self-Reported Vote") +
    geom_bar(color="black", position="dodge") +
    coord_flip()

For fun, see what happens when you do not use postion=dodge. Also see what happens if you do not flip the coordinates using coord_flip.

It is important to note that the fill variable has to be a character or a factor. If we want to graph self-reported vote by sex, for example, we need to redefine the variable for the purposes of ggplot as follows. Note that because we are not mutating it and we are only defining it to be a factor within the `ggplot object, this redefinition will not stick. Note also the problem caused by uninformative values in SEX – can you change it.

mi_ep %>% 
    filter(preschoice == "Joe Biden, the Democrat" | preschoice == "Donald Trump, the Republican") %>%
    ggplot(aes(x= preschoice, fill = factor(SEX))) +     
    labs(y = "Number of Respondents",
         x = "",
         title = "Vote by Respondent Sex",
         fill = "Sex") +
    geom_bar(color="black", position="dodge") +
    coord_flip()

Quick Exercise 9 The barplot we just produced does not satisfy our principles of visualization because the fill being used is uninterpretable to those unfamiliar with the dataset. Redo the code to use a fill variable that produces an informative label. Hint: don’t overthink.

# INSERT CODE HERE

A new question

Suppose we were concerned with whether some polls might give different answers because of variation in who the poll is able to reach using that method. People who take polls via landline phones (do you even know what that is?) might differ from those who take surveys online. Or people contacted using randomly generated phone numbers (RDD) may differ from those contacted from a voter registration list that has had telephone numbers merged onto it.

Polls were done using lots of different methods in 2020.

Loading the data

require(tidyverse)
Pres2020.PV <- read_rds(file="https://github.com/rweldzius/PSC4175/raw/main/static/data/Pres2020_PV.Rds")
Pres2020.PV <- Pres2020.PV %>%
                mutate(Trump = Trump/100,
                      Biden = Biden/100,
                      margin = Biden - Trump)

Pres2020.PV %>%
  count(Mode)

## # A tibble: 9 × 2
##   Mode                 n
##   <chr>            <int>
## 1 IVR                  1
## 2 IVR/Online          47
## 3 Live phone - RBS    13
## 4 Live phone - RDD    51
## 5 Online             366
## 6 Online/Text          1
## 7 Phone - unknown      1
## 8 Phone/Online        19
## 9 <NA>                29

This raises the question of – how do we visualization variation in a variable by another variable? More specifically, how can we visualize how the margin we get using one type of survey compares to the margin from another type of poll? (We cannot use a scatterplot because the data is from different observations (here polls).)

We could do this using earlier methods by selecting polls with a specific interview method (“mode”) and then plotting the margin (or Trump or Biden), but that will produce a bunch of separate plots that may be hard to directly compare. (In addition to having more things to look at we would want to make sure that the scale of the x-axis and y-axis are similar.)

We can plot another “layer” of data in `ggplot using the fill paramter. Previously we used it to make the graphs look nice by choosing a particular color. But if we set fill to be a variable in our tibble then ggplot will plot the data seperately for each unique value in the named variable. So if we want to plot the histogram of margin for two types of polls we can use the fill argument in ggplot to tell R to produce different fills depending on the value of that variable.

Pres2020.PV %>% 
  filter(Mode == "IVR/Online" | Mode == "Live phone - RDD") %>%
    ggplot(aes(x= margin, fill = Mode)) +     
  labs(y = "Number of Polls",
         x = "Biden- Trump Margin",
         title = "Biden-Trump Margin for Two Types of Polls",
        fill = "Mode of Interview") +
    geom_histogram(bins=10, color="black", position="dodge") + 
    scale_x_continuous(breaks=seq(-.1,.2,by=.05),
                     labels= scales::percent_format(accuracy = 1))

Quick Exercise 10 Try running the code without the filter. What do you observe? How useful is this? Why or why not?

# INSERT CODE

While informative, it can be hard to compare the distribution of more than two categories using such methods. To compare the variation across more types of surveys we need to use a different visualization that summarizes the variation in the variable of interest a bit more. One common visualization is the boxplot which reports the mean, 25th percentile (i.e., the value of the data if we sort the data from lowest to highest and take the value of the observation that is 25% of the way through), the 75th percentile, the range of values, and notable outliers.

Let’s see what the boxplot of survey mode looks like after we first drop surveys that were conducted using modes that were hardly used (or missing).

Pres2020.PV %>% 
  filter(Mode != "IVR" & Mode != "Online/Text" & Mode != "Phone - unknown" & Mode != "NA") %>%
  ggplot(aes(x = Mode, y = margin)) + 
    labs(x = "Mode of Survey Interview",
         y = "Biden- Trump Margin",
         title = "2020 Popular Vote Margin by Type of Poll") +
    geom_boxplot(fill = "slateblue") +
    scale_y_continuous(breaks=seq(-.1,.2,by=.05),
                     labels= scales::percent_format(accuracy = 1))

We can also flip the graph if we think it makes more sense to display it in a different orientation using coord_flip. (We could, of course, also redefine the x and y variables in the `ggplot object, but it is useful to have a command to do this to help you determine which orientiation is most useful).

Pres2020.PV %>% 
  filter(Mode != "IVR" & Mode != "Online/Text" & Mode != "Phone - unknown" & Mode != "NA") %>%
  ggplot(aes(x = Mode, y = margin)) + 
    labs(x = "Mode of Survey Interview",
         y = "Biden- Trump Margin",
         title = "2020 Popular Vote Margin by Type of Poll") +
    geom_boxplot(fill = "slateblue") +
    scale_y_continuous(breaks=seq(-.1,.2,by=.05),
                     labels= scales::percent_format(accuracy = 1)) +
    coord_flip()

A downside of the boxplot is that it can be hard to tell how the data varies within each box. Is it equally spread out? How much data are contained in the lines (which are simply 1.5 times the height of the box)? To get a better handle on this we can use a “violin” plot that dispenses with a standard box and instead tries to plot the distribution of data within each category.

Pres2020.PV %>% 
  filter(Mode != "IVR" & Mode != "Online/Text" & Mode != "Phone - unknown" & Mode != "NA") %>%
  ggplot(aes(x=Mode, y=margin)) + 
    xlab("Mode") + 
    ylab("Biden- Trump Margin") +
    geom_violin(fill="slateblue")

It is also hard to know how much data is being plotted. If some modes have 1000 polls and others have only 5 that seems relevant.

Quick Exercise 11 We have looked at the difference in margin. How about differences in the percent who report supporting Biden and Trump? What do you observe. Does this suggest that the different ways of contacting respondents may matter in terms of who responds? Is there something else that may explain the differences (i.e., what are we assuming when making this comparison)?

# INSERT CODE HERE

Quick Exercise 12 Some claims have been made that polls that used multiple ways of contacting respondents were better than polls that used just one. Can you evaluate whether there were differences in so-called “mixed-mode” surveys compared to single-mode surveys? (This requires you to define a new variable based on Mode indicating whether survey is mixed-mode or not.)

# INSERT CODE HERE

Continuous Variable By Continuous Variable (Scatterplot)

When we have two continuous variables we use a scatterplot to visualize the relationship. A scatterplot is simply a graph of every point in (x,y) where x is the value associated with the x-variable and y is the value associated with the y-variable. For example, we may want to see how support for Trump and Biden within a poll varies. So each observation is a poll of the national popular vote and we are going to plot the percentage of respondents in each poll supporting Biden against the percentage who support Trump.

To include two variables we are going to change our aesthetic to define both an x variable and a y variable – here aes(x = Biden, y = Trump) and we are going to label and scale the axes appropriately.

Pres2020.PV %>%
  ggplot(aes(x = Biden, y = Trump)) + 
  labs(title="Biden and Trump Support in 2020 National Popular Vote",
       y = "Trump Support",
       x = "Biden Support") + 
  geom_point(color="purple") + 
    scale_y_continuous(breaks=seq(0,1,by=.05),
                     labels= scales::percent_format(accuracy = 1)) +
  scale_x_continuous(breaks=seq(0,1,by=.05),
                     labels= scales::percent_format(accuracy = 1))

The results are intriguing! First the data seems like it falls along a grid. This is because of how poll results are reported in terms of percentage points and it highlights that even continuous variables may be reported in discrete values. This is consequential because it is hard to know how many polls are associated with each point on the graph. How many polls are at the point (Biden 50%, Trump 45%)? This matters for trying to determine what the relationship might be. Second, it is clear that there are some questions that need to be asked – why doesn’t Biden + Trump = 100\%?

To try to display how many observations are located at each point we have two tools at our disposal. First, we can alter the “alpha transparency” by setting alpha-.5 in the geom_point call. By setting a low level of transparency, this means that the point will become less transparent as more points occur at the same coordinate. Thus, a faint point indicates that only a single poll (observation) is located at a coordinate whereas a solid point indicates that there are many polls. When we apply this to the scatterplot you can immediately see that most of the polls are located in the neighborhood of Biden 50%, Trump 42%.

Pres2020.PV %>%
  ggplot(aes(x = Biden, y = Trump)) + 
  labs(title="Biden and Trump Support in 2020 National Popular Vote",
       y = "Trump Support",
       x = "Biden Support") + 
  geom_point(color="purple",alpha = .3) + 
    scale_y_continuous(breaks=seq(0,1,by=.05),
                     labels= scales::percent_format(accuracy = 1)) +
  scale_x_continuous(breaks=seq(0,1,by=.05),
                     labels= scales::percent_format(accuracy = 1))

However, the grid-like nature of the plot is still somewhat hard to interpret as it can be hard to discern variations in color gradient. Another tool is to add a tiny bit of randomness to the x and y values associated with each plot. Instead of values being constrained to vary by a full percentage point, for example, the jitter allows it to vary by less. To do so we replace geom_point with geom_jitter.

Pres2020.PV %>%
  ggplot(aes(x = Biden, y = Trump)) + 
  labs(title="Biden and Trump Support in 2020 National Popular Vote",
       y = "Trump Support",
       x = "Biden Support") + 
  geom_jitter(color="purple",alpha = .5) + 
    scale_y_continuous(breaks=seq(0,1,by=.05),
                     labels= scales::percent_format(accuracy = 1)) +
  scale_x_continuous(breaks=seq(0,1,by=.05),
                     labels= scales::percent_format(accuracy = 1))

Note how much the visualization changes. Whereas before the eye was focused on – and arguably distracted by – the grid-like orientation imposed by the measurement, once we jitter the points we are immediately made aware of the relationship between the two variables. While we are indeed slightly changing our data by adding random noise, the payoff is that the visualization arguably better highlights the nature of the relationship. Insofar the goal of visualization is communication, this trade-off seems worthwhile in this instance. But here again is where data science is sometimes art as much as science. The decision of which visualization to use depends on what you think most effectively communicates the nature of the relationship to the reader.

We can also look at the accuracy of a poll as a function of the sample size. This is also a relationship between two continuous variables – hence a scatterplot! Are polls with more respondents more accurate? There is one poll with nearly 80,000 respondents that we will filter out to me able to show a reasonable scale. Note that we are going to use labels = scales::comma when plotting the x-axis to report numbers with commas for readability.

Pres2020.PV %>%
  filter(SampleSize < 50000) %>%
  mutate(TrumpError = Trump - RepCertVote/100,
         BidenError = Biden - DemCertVote/100) %>%
  ggplot(aes(x = SampleSize, y = TrumpError)) + 
  labs(title="Trump Polling Error in 2020 National Popular Vote as a function of Sample Size",
       y = "Error: Trump Poll - Trump Certified Vote",
       x = "Sample Size in Poll") + 
  geom_jitter(color="purple",alpha = .5) +
  scale_y_continuous(breaks=seq(-.2,1,by=.05),
                     labels= scales::percent_format(accuracy = 1)) +
  scale_x_continuous(breaks=seq(0,30000,by=5000),
                     labels= scales::comma)

In sum, we have tested Trump’s theory that the MSM was biased against him. We found that polls that underpredicted Trump also underpredicted Biden. This is not what we would expect if the polls favored one candidate over another.

Pres2020.PV %>%
  ggplot(aes(x = Biden, y = Trump)) + 
  labs(title="Biden and Trump Support in 2020 National Popular Vote",
       y = "Trump Support",
       x = "Biden Support") + 
  geom_jitter(color="purple",alpha = .5) + 
    scale_y_continuous(breaks=seq(0,1,by=.05),
                     labels= scales::percent_format(accuracy = 1)) +
  scale_x_continuous(breaks=seq(0,1,by=.05),
                     labels= scales::percent_format(accuracy = 1))

What is an alternative explanation for these patterns? Why would polls underpredict both Trump and Biden?

Perhaps they were fielded earlier in the year, when more people were interested in third party candidates, or hadn’t made up their mind. We’ll turn to testing this theory next time!