---
title: "Lab 08 - Exploring data in the 2024 National Elections Study"
author: "Your Name Here"
date: "Last Updated `r format(Sys.Date())`"
embed-resources: true
format:
  html:
    toc: true
    toc-location: right
    toc-float: true
    toc-depth: 2
    number-sections: true
execute: 
  eval: true
  echo: true
  warning: false
  message: false
  cache: true
---


# Overview {.unnumbered}

In this lab, we'll explore data from the National Election Studies 2024 Pilot Study. You find an outcome of interest and a variable you think predicts interesting variation in that outcome. You'll figure out what recoding you need to do, do that recoding and describe the data. I'll do the same, so can some template code to compare your work to.

Everything we'll do today is something we've done before and is also something you'll likely have to do a version of in your final project. Here's the plan

1. Set up your work space 

2. Download and load data from the NES into R 

3. Explore the codebook for the 2024 Pilot Study 

4. Get a high level overview of the data to figure out what recoding needs to be done 

5. Recode the data 

6. Describe the data 

7. Formulate a set of research questions 

8. Estimate models to explore your question 

9. Interpret the results of your model 



# Goals {.unnumbered}

This week's lab will give you practice:

- Download and loading data from your own computers (Q1,Q2)

- Exploring a codebook to find interesting relevant variables (Q3)

- Exploring data to understand what needs to be recoded (Q4)
  
- Recoding data in a clear and precise manner (Q5)

  - Demonstrate how to recode multiple variables using `across()`

- Describing, summarizing, and exploring data through tables and figures (Q6)

  - Using `kable()` and functions from the `kableExtra` package to format tables
  - Combining multiple figures into single plots using `ggarrange()`from the ``ggpubr` pacakge

- Formulating research questions based on initial explorations of the data (Q7)

- Estimating linear models (Q8)

- Interpreting the substantive and statistical significance of these models (Q9)


# Workflow {.unnumbered}

## Please render this .qmd file {.unnumbered}

As with every lab, you should:

-   Download the file
-   Save it in your course folder
-   **Update the `author:` section of the YAML header.**
-   Render the document
-   Open the html file in your browser (Easier to read)
-   Write your code in the **chunks provided under each section**
-   Comment out or delete any test code you do not need
-   **Render the document again after completing a section or chunk** (Error checking)
-   Upload the final lab to [Canvas](https://canvas.brown.edu/courses/1097425/assignments){target="_blank"}.



# Set up your workspace

In the code chunk below, please add code to load the package `DeclareDesign`


## Load Packages

```{r}
#| label: packages
#| message: false

# Libraries
library(tidyverse)
library(haven)
library(labelled)
library(kableExtra)
library(ggpubr)
## ADD DeclareDesign

```

## Set your working directory in R Studio

In R studio **set your working directory** to the **folder where this lab is** saved by clicking > Session > Set Working Directory > To Source File Location

![](images/09-nes6.png){width=50%}

After doing so uncomment `getwd()` Should print out something like

> "~/Desktop/pols2580/labs/"

Depending on where your lab is saved

```{r}
#| label: check_wd

# In the Top Panel of RStudio Click
# Session > Set Working Directory > Source File Location

# Uncomment to Check Where Your File is Saved 
# getwd()
```

:::{.callout-note}
If `getwd()` says something like '~/Downloads/' click: "File > Save As" and **save this lab** in your **course folder**. Then **close** the version `09-lab.qmd` that was opened from your Downloads folder and **open** the version of `09-lab.qmd` that now exists in your course folder.
:::


# Download and load the NES data into R

Please click [here](https://electionstudies.org/data-center/2024-pilot-study/) to go to the download page for the National Election Studies 2024 Pilot Study

- Click the **Log-in Button**

![](images/09-nes1.png){width=50%}

- Create an account with the NES

![](images/09-nes2.png){width=30%}

- Right click (Ctrl-click) on the DTA button. This will allow you to select `Save Link As...` Which should in turn allow you to chose where the file is saved. Save it in the **same folder as 09-lab.qmd**

![](images/09-nes3.png){width=50%}
![](images/09-nes4.png){width=50%}

- Unzip `anes_pilot_2024_dta_20240319.zip`. 
  - On a Mac this creates a new folder called `anes_pilot_2024_dta_20240319` in your course folder which contains the following files:
  - `anes_pilot_2024_dta_20240319.dta` the data
  - `anes_pilot_2024_userguidecodebook_20240319.pdf` the codebook for the data
  - On a PC i think i it asks you where you want to unzip the files. Please unzip them directly into your course folder.  

![](images/09-nes5.png){width=50%}

- Load the data using some version of the following commands:

```{r}
#| label: data

# # IF .dta file is in subfolder where lab is:
# df <- read_dta("~/anes_pilot_2024_dta_20240319/anes_pilot_2024_20240319.dta")
# 
# # IF .dta file is in SAME folder as lab:
# df <- read_dta("anes_pilot_2024_20240319.dta")
# 
# # IF nothing works, fear not, you can load the data from the web as a backup
# df <- read_dta(url("https://pols2580.paultesta.org/files/data/anes_pilot_2024_20240319.dta"))
```



# Explore the codebook

Please open the file `anes_pilot_2024_userguidecodebook_20240319.pdf`. 

It should be in same folder as the data.

Use Control+F for keywords to quickly navigate through the codebook looking for questions and variables that interest you.

## Identify a potential outcome of interest


In this and next week's lab, I'll be exploring factors that explain variation in the following outcome variables:

A measure 

- `vchoice_rematch` "Vote Trump or Biden in 2024"
  
  - `1` = Donald Trump
  - `2` = Joe Biden
  - `-7` = No Answer
  - `-1` = Inapplicable

And five measures of political participation in the 2020 campaign
  
- `mobil_talk` "2020 campaign - Talk to others about candidates"
- `mobil_online` "2020 campaign - Participate in online rallies"
- `mobil_rally` "2020 campaign - Attend in person rallies"
- `mobil_button` "2020 campaign - Wear a button or campaign sticker"
- `mobil_work` "2020 campaign - Any other work to support candidates"

  - `1` = Yes
  - `2` = No
  - `-1` = Inapplicable

**Please find a variable that describes some outcome of interest to you and fill in the following**

- `outcome_variable_name` Question topic
  - variable values 

## Identify at least one variable that might predict variation in your outcome.

From a quick skim, I've selected the following potential predictors, which I will recode below:

- `age` Age
- `educ` Education
- `faminc_new` Income
- `race` Race
- `pid7` 7 point party identification


**Please find at least one more predictor which you think might explain variation in your outcome of interest and fill in the following**

- `predictor_variable_name` Question topic
  - variable values 

For example, perhaps you're interested in differences by gender, or ideology, or social media use. See if you can find variables that measure these concepts. 

You only needed to identify one, but you can choose to explore more if you want. Don't choose 50, unless you really like recoding data.


# Get a high level overview of the data

In this section, we'll get practice quickly looking at variables **to see what, if anything needs to be recoded**. 

I had you download the `.dta` instead of the `.csv` version of the data, because the `.dta` includes value labels for the data, which makes it easier to understand what a specific number corresponds to substantively.


## Examine the distributions and values of your outcome variable

Please uncomment and run the code below

```{r}
#| label: dvhlo_me

# # Vote Choice
# get_variable_labels(df$vchoice_rematch)
# get_value_labels(df$vchoice_rematch)
# table(df$vchoice_rematch,useNA = "ifany")
# 
# # Acts of Participation
# # All variables start with mobil_ prefix
# df %>% select(starts_with("mobil")) %>% names()
# 
# # Political Talk
# get_variable_labels(df$mobil_talk)
# get_value_labels(df$mobil_talk)
# table(df$mobil_talk,useNA = "ifany")
# 
# # Save the names all variables related to acts of participation in 2020
# the_participation_vars <- df %>% select(starts_with("mobil")) %>% names()
# # Only keep the variables that measure participation and not survey timing
# the_participation_vars <- the_participation_vars[1:5]

```

From quickly looking at my outcome variables, I know that I will want to:


- Recode `vchoice_rematch` to `dv_vote_trump2024` which 
  - equals 1 if `vchoice_rematch == 1` 
  - equals 0 if `vchoice_rematch == 2` 
  - equals `NA` if `vchoice_rematch < 0`

- Recode variables that start with `mobil_*` to variables that start with `polpart_*` and:
  - equal 1 if `mobil_* == 1` 
  - equal 0 if `mobil_* == 2` 
  - equals `NA` if `mobil_*` < 0`

- Create `dv_participation*` which is the sum of respondents' five responses to the recoded `polpart_*` variables 

## Describe any recoding of your outcome variable

In the code chunk below, please repeat this process for the outcome variable you selected in the previous section:

```{r}
#| label: dvhlo_YOU

# Get a HLO of your outcome variable

```


- Recode `YOUR OUTCOME VARIABLE HERE` to `NAME FOR RECODED VARIABLE`
  - Describe what values need to be recoded in the new variable
  


## Examine the distributions and values of your predictor variable

Now I'll repeat this process for my potential predictor variables.

Please uncomment and run the code below

```{r}
#| label: ivhlo_me

# # Age
# get_variable_labels(df$age)
# get_value_labels(df$age)
# summary(df$age)
# 
# 
# # Education
# get_variable_labels(df$educ)
# get_value_labels(df$educ)
# table(df$educ)
# summary(df$educ)
# 
# 
# # Income
# get_variable_labels(df$faminc_new)
# get_value_labels(df$faminc_new)
# table(df$faminc_new)
# summary(df$faminc_new)
# 
# 
# # Race
# get_variable_labels(df$race)
# get_value_labels(df$race)
# summary(df$race)
# table(df$race,useNA = "ifany")
# 
# 
# # Partisanship
# get_variable_labels(df$pid7)
# get_value_labels(df$pid7)
# summary(df$pid7)
# table(df$pid7)


```

After taking a quick look at each variable, I know that I'll want to do the following recoding:

- `age` to `age`^[In general, I try not to recode the original variables, but instead create new columns, with different names. But, like this footnote, it seems overly verbose to create something like `age_recoded`, so I'll break my  general rule] 
  - recode `-9`s to `NA`
- `educ` no recoding needed
  - create indicator `has_college_degree` which equals `1` is `educ > 4` and `0` otherwise
- `faminc_new` to `income`
  - recode `-7` and `97` to `NA`
- `race` to `race_5cat`
  - `race == 1 ~ "White"`
  - `race == 2 ~ "Black"`
  - `race == 3 ~ "Hispanic"`
  - `race == 4 ~ "Asian"`
  - `T ~ "Other"` (Collapse other racial categories)
- `race` to `is_*` binary indicators:
  - `is_white = 1` if `race==1`, `0` otherwise
- `pid7` to `partyid`
  - recode `pid7 == 8` to `4` (Classify `Don't Knows` as Independents)
- `pid7` to `is_*`: binary indicators:
  - `is_dem = 1` if `partyid < 4`, 0 otherwise 
  - `is_rep = 1` if `partyid > 4`, 0 otherwise 
  - `is_ind = 1` if `partyid == 4`, 0 otherwise 

## Describe any recoding of your predictor(s)

In the code chunk below, please repeat this process for the additional predictor(s) you selected in the previous section:

```{r}
#| label: ivhlo_YOU

# Get a HLO of your outcome variable

```


- Recode `YOUR OUTCOME VARIABLE HERE` to `NAME FOR RECODED VARIABLE`
  - Describe what values need to be recoded in the new variable

# Recode the data

Now we've got a plan of action for how we need to recode the data.


## Recode the outcome variables

Please uncomment and run the following code chunk:

```{r}
#| label: dvrecode_me

# df %>%
#   # Recode 2024 Vote Choice
#   mutate(
#     dv_vote_trump2024 = case_when(
#       vchoice_rematch == 1 ~ 1,
#       vchoice_rematch == 2 ~ 0,
#       T ~ NA
#     )
#   ) %>% 
#   # Recode Individual Acts of Participation
#   mutate(across(all_of(the_participation_vars), 
#                 \(x) case_when(
#                   x == 1 ~ 1,
#                   x == 2 ~ 0,
#                   T ~ NA
#                 ),
#                 .names = "polpart_{.col}"
#                 )
#                 
#                 ) %>% 
#   # Create Additive Measure of Participation
#   mutate(
#     dv_participation = rowSums(
#       select(.,starts_with("polpart")),
#       na.rm = T)
#     
#   ) -> df

```

**Please recode your outcome of interest as needed**

Remember to save the output of your recode back into the dataframe `df`

```{r}
#| label: dvrecode_YOU

# Recode your outcome of interest


```


## Check the recoding of your outcome

It's a good habit to compare your recoded variables to their original values, to make sure your code did what you thought it did.

Please uncomment and run the following:

```{r}
#| label: check_recode_me
# Check recodes

# table(
#   recode = df$dv_vote_trump2024,
#   original = df$vchoice_rematch, 
#   useNA = "ifany"
#   )
# 
# table(
#   recode = df$polpart_mobil_button,
#   original = df$mobil_button, 
#   useNA = "ifany"
#   )
# table(
#   total = df$dv_participation,
#   item = df$polpart_mobil_button,
#   useNA = "ifany"
#   )

```

So everything looks in order. I could have probably checked the `dv_participation` variable against all of its constituent items, but based off comparing it to `polpart_mobil_button` everything looks in order since:
 - there are no cases where `polpart_mobil_button` is 1 but `dv_participation` is 0
 - there are no cases where `dv_participation` is at it's max but `polpart_mobil_button` is 0. 
 - `dv_participation` has the correct theoretical range from 0 acts to 5 acts.

Now do the same for your outcome variable.

**Please check your recoded outcome against its original values**

```{r}
#| label: check_recode_YOU
# Check recodes

```

## Recode your predictor variables

Again, I've provide some demonstration code to recode the predictors listed above. 

Please uncomment and run the following

```{r}
#| label: ivrecode_me

# df %>% 
#   mutate(
#     # Age
#     age = ifelse(age < 0, NA, age),
#     # Education
#     education = educ,
#     educ_f = to_factor(educ), #Convert to Factor for Plotting
#     is_college_grad = ifelse(educ > 4,1,0),
#     # Income
#     income = case_when(
#       faminc_new < 0 ~ NA,
#       faminc_new > 0 & faminc_new >16 ~ NA,
#       T ~ faminc_new
#     ),
#     # Race
#     race_5cat = case_when(
#       race < 5 ~ to_factor(race),
#       T ~ "Other"
#     ) %>% factor(., levels = c("White","Black","Hispanic","Asian","Other")),
#     is_white = ifelse(race == 1, 1, 0),
#     is_black = ifelse(race == 2, 1, 0),
#     is_hispanic = ifelse(race == 3, 1, 0),
#     is_asian = ifelse(race == 4, 1, 0),
#     is_other = ifelse(race == 5, 1, 0),
#     # Partisanship
#     partyid = case_when(
#       pid7 == 8 ~ 4,
#       T ~ pid7
#     ),
#     is_dem = ifelse(partyid  < 4, 1, 0),
#     is_rep = ifelse(partyid  > 4, 1, 0),
#     is_ind = ifelse(partyid  == 4, 1, 0),
#   ) -> df


```

**Please recode your additional predictor(s) as needed**

```{r}
#| label: ivrecode_YOU

# Recode your additional predictor(s)

```

It's a good habit to check your all your recoding -- particularly if you're doing something like summing over multiple columns -- but for this lab, we'll live dangerously.

# Describe the Data

Now let's get some practice **summarizing our data**, presenting these summaries as **tables** and **figures**, and interpreting our results


## Create a table of summary statistics

Please uncomment and run the code below which demonstrates how to **produce a nicely formatted table** of summary statistics

```{r}
#| label: datasummary_me

# # Vector of numeric variables to summarize
# the_vars <- c(
#   "dv_vote_trump2024", 
#   "dv_participation",
#   "age","education","income",
#   "is_white","is_black","is_hispanic","is_asian","is_other",
#   "partyid","is_dem","is_rep","is_ind"
# )
# 
# # Vector of nicely formatted labels for variables
# the_labels <- c(
#   "Vote for Trump in '24",
#   "Acts of Participation in `20",
#   "Age","Education", "Income",
#   "White", "Black","Hispanic","Asian","Other",
#   "Party ID", "Democrat","Republican","Independent"
# )
# 
# df_summary <- df %>% 
#   select(all_of(the_vars)) %>%
#   rename_with(~the_labels) %>% 
#   pivot_longer(
#     cols = everything(),
#     names_to = "Variable"
#   ) %>% 
#   mutate(
#     Variable = factor(Variable, levels = the_labels)
#   ) %>% 
#   group_by(Variable) %>% 
#   summarise(
#     Min = min(value,na.rm = T),
#     p25 = quantile(value, prob = .25,na.rm = T),
#     Median = quantile(value, prob = .5,na.rm = T),
#     Mean = mean(value, na.rm = T),
#     p75 = quantile(value, prob = .75,na.rm = T),
#     Max = max(value,na.rm = T),
#     `N missing` = sum(is.na(value))
#   )
# 
# # Look at results
# df_summary
```


We can then format `df_summary` as table using `knitr()` and styling options from the `kableExtra` package:


```{r}
#| label: summarytab_me
#| echo: false

# kable(df_summary,
#       digits = 2) %>% 
#   kable_styling() %>% 
#   pack_rows("Outcomes", start_row = 1, end_row = 2) %>% 
#   pack_rows("Demographic Predictors", 3, 10) %>% 
#   pack_rows("Political Predictors", 11, 14)
```

## Modify the table to include your predictors

Using the two **previous code chunks as a template**, update the code so that the table includes your chosen outcome and predictors.

```{r}
#| label: datasummary_YOU

# Copy, paste, and update code from datasummary_me to include your variables


```

```{r}
#| label: summarytab_YOU
#| echo: false

# Copy, paste, and update code from summarytab_me to display your results

```

## Interpret the results of your table.

**Please write a few sentences that provide a substantive interpretation of your table of descriptive statistics** 

Your reader should come away with an understanding of the characteristics of the respondents to this sample.

The National Election Study's 2024 Pilot Study contains responses from 1909 individuals^[See note below]. The typical respondent in the data was just under 50 years old, with some college, with an income in the range of \$50k-\$59k. Approximately two-thirds of the sample identified as white, with 13 percent of respondents identifying as Black, 13 percent as Hispanic, 2 percent as Asian. Forty-three percent of respondents identified as Democrats, 38 percent as Republicans, and 20 percent as Independents. The respondents were evenly split in who they would vote for 2024, with 50 percent saying they would Vote for Donald Trump, and 50 percent saying Joe Biden. In the 2020 campaign, the average respondent reported engaging in about 1 act of political participation. 



## Visualize the Data

Please a choose a variable or variables whose distribution or relationship you think may be substantively interesting to the potential story you want to tell.

In the code below, I visualize: 

- the distribution of age by race using `geom_boxplot()`
- average partisanship by race using `stat_summary()`
- how partisanship changes with age by race using `geom_smooth()`

And combine these 3 plots into a single figure using two calls to the `ggarrange()` function from the `ggpubr` package




```{r}
#| label: dataviz_me
#| fig-height: 8
#| fig-cap: "**Figure:** Age, Race, and Partisanship in the ANES 2024 Pilot Study"


# fig_age_race <- df %>% 
#   ggplot(aes(race_5cat,age,
#              col = race_5cat))+
#   geom_boxplot()+
#   labs(
#     x = "Race",
#     y = "Age",
#     col = "Race",
#     title = "Distribution of Age by Race"
#   )+
#   theme_minimal()
# 
# fig_pid_race <- df %>% 
#   ggplot(aes(race_5cat,partyid,
#              col = race_5cat))+
#   stat_summary(position = position_dodge(width=.5))+
#   labs(
#     x = "Race",
#     y = "Partisanship",
#     col = "Race",
#     title = "Average Partisanship by Race"
#   )+
#   theme_minimal()
# 
# fig_age_race_pid <- df %>% 
#   mutate(
#     Race = race_5cat
#   ) %>% 
#   ggplot(aes(age,partyid,
#              col = race_5cat
#              ))+
#   geom_smooth(se = F) +
#   geom_jitter(size=.5, alpha=.3) +
#   labs(
#     x = "age",
#     y = "Partisanship",
#     col = "Race",
#     title = "Distribution of Partisanship by Age and Race"
#   )+
#   theme_minimal()
# 
# fig_desc <- ggarrange(
#   # Top Row, two columns
#   ggarrange(
#     fig_age_race, fig_pid_race,
#     ncol =2,
#     legend = "none"
#     ), 
#   # Bottom row, 1 column
#   fig_age_race_pid, 
#   nrow=2,
#   common.legend = T,
#   legend = "bottom",
#   heights = c(1,1.5)
#   )
# 
# fig_desc
```

From the figure, we  see that whites in sample have the highest median age (55 years) followed by Blacks (46 years). Hispanic and Asian respondents have the youngest median age of (40 years). Whites are also tend to lean more Republican in their partisanship than other racial minority groups. This is particularly true for older whites in the sample. Interestingly, average partisanship stays roughly constant with age for Asians and Hispanics, but older Black respondents are more likely to identify as Democrats than younger Blacks, whose partisan identification is more independent.

**Please produce your own figure and provide a similar interpretation of what it conveys.**

```{r}
#| label: dataviz_You
#| fig-height: 8
#| fig-cap: "**Figure:** Your title here"

```

# Formulate a research question and expectations

Please take a moment, to formulate some research questions you could ask of these data:

- A clear research question
- A set of expectations and potential alternative explanations
- The formula for at least two linear models to test these expectations

## Research question

**ME:** How does support for Trump in the 2024 election vary with age and race?

**YOU:** 

## Expectations

**ME:** On average, I expect that older voters will be more supportive of Trump, but suspect that this trend varies by race. I expect it will be particularly true among White voters, but less so among people of color. Since, partisanship is likely to be strong predictor of vote choice, I will explore whether these specific relationships hold, once we control for variations in partisan identification which we know varies both by age and race.

**YOU:**

## Linear Model

**ME:** 

I will estimate the following models:

$$
y = \beta_0 + \beta_1 age + \sum\beta_k race_k + \epsilon
$$
If my expectations hold, I expect the coefficient on `age` in this model to be positive, indicating older voters are more likely to vote for Trump. White respondents are the reference category in this model^[Because `white` is first level the factor variable `race`] and so the coefficients on the racial indicators ($\beta_k race$) correspond to how members of each racial group differ from white respondents in their propensity to vote for Trump. I expect all of these coefficients to be negative.

To explore whether the relationship between age and vote choice varies by race, I will fit an interaction model:

$$
y = \beta_0 + \beta_1 age + \sum\beta_k race_k + \epsilon + \sum\beta_{jk} age \times race_k  + \epsilon
$$
This model allows the relationship between age and vote choice to vary by race. For white respondents, the relationship is described by $\beta_1$. Again I expect it to be positive, suggesting older white voters are more likely to vote for trump. For racial minorities, the marginal effect of age for the racial or ethnic group $k$ is described by $\beta_1 + \beta_{jk}$. In general, I expect that the coefficients on $\beta_{jk}$ to be negative such that older racial minorities are less likely to support Trump than older white respondents. 

Finally, I will estimate a model that controls for partisanship. If the relationships between age, and race and vote choice are simply a reflection of differences in partisan identification, then coefficients on these predictors should no longer be statistically significant, while the coefficient on partisanship should positive and statistically significant.

$$
y = \beta_0 + \beta_1 pid + \beta_2 age + \sum\beta_k race_k + \epsilon + \sum\beta_{jk} age \times race_k \epsilon
$$

**You:** 

We will estimate the following models:

$$
y = \beta_0 + \beta_1 ...
$$

$$
y = \beta_0 + \beta_1 ...
$$

# Estimate your models

Below I estimate the three models described above

```{r}
#| label: modelsME

# # Fit models
# m1vc <- lm_robust(dv_vote_trump2024 ~ age + race_5cat, df)
# m2vc <- lm_robust(dv_vote_trump2024 ~ age*race_5cat, df)
# m3vc <- lm_robust(dv_vote_trump2024 ~ age*race_5cat + partyid, df)

```

Please estimate the models described in the previous section


```{r}
#| label: modelsYOU

# # Fit models


```



# Interpret your results

Please produce 

- A regression table presenting of your model
- At least one figure showing predicted values from one model

Interpret your results using both confidence intervals and hypothesis tests to assess the **statistical significance** of your claims and predicted values to help interpret the **substantive significance** of your results

## Regression Table

Here is some template code I used, demontstrating how to update the labels of the columns and rows in the model

```{r}
#| label: regtabME
#| results: asis

# htmlreg(list(m1vc, m2vc, m3vc),
#         custom.model.names = c(
#           "Baseline", "Interaction", "Alternative"
#         ),
#         caption = "Support for Trump in 2024",
#         caption.above = T,
#         custom.coef.names = c(
#           "(Intercept)",
#           "Age",
#           "Black",
#           "Hispanic",
#           "Asian",
#           "Other",
#           "Age:Black",
#           "Age:Hispanic",
#           "Age:Asian",
#           "Age:Other",
#           "Party ID"
#         ) ,
#         include.ci = F,
#         digits = 3)
```

**Please produce a similar table for your models**


## Visualize predicted values 

Similarly here is some code to produce predicted values for `m2vc` and `m3vc`. The basic steps are:

1. Create a prediction data frame varying the values of some predictors from a model, while holding others constant using `expand_grid()`

2. Produce predicted values with confidence intervals from your regression model using the `predict()` function

3. Bind those predictions and CIs to the orginal prediction dataframe using `cbind()`

4. Produce a figure using `ggplot()`

```{r}
#| label: figME

# # Predictors for m2
# pred_dfm2 <- expand_grid(
#   age = seq(min(df$age, na.rm =T), max(df$age, na.rm = T)),
#   race_5cat = sort(unique(df$race_5cat))
# )
# 
# # Predictions with confidence intervals
# pred_dfm2 <- cbind(
#   pred_dfm2,
#   predict(m2, newdata = pred_dfm2, interval = "confidence")$fit
# )
# 
# # Plot predictions from m2
# 
# fig_m2 <- pred_dfm2 %>% 
#   ggplot(aes(age, fit, col = race_5cat))+
#   geom_ribbon(aes(ymin = lwr, ymax = upr, 
#     fill = race_5cat
#     ),
#     alpha = .5)+
#   geom_line()+
#   facet_wrap( ~ race_5cat)+
#   theme_minimal()+
#   guides(
#     col = "none",
#     fill = "none"
#   )+
#   labs(
#     y = "Predicted Vote Choice",
#     title = "Support for Trump by Age and Race"
#   )
# 
# # Display figure
# fig_m2
# 
# # Predictors for m3
# pred_dfm3 <- expand_grid(
#   age = seq(min(df$age, na.rm =T), max(df$age, na.rm = T)),
#   race_5cat = sort(unique(df$race_5cat)),
#   partyid = mean(df$partyid, na.rm=T)
# )
# 
# # Predictions with confidence intervals
# pred_dfm3 <- cbind(
#   pred_dfm3,
#   predict(m3, newdata = pred_dfm3, interval = "confidence")$fit
# )
# 
# # Plot predictions from m2
# 
# fig_m3 <- pred_dfm3 %>% 
#   ggplot(aes(age, fit, col = race_5cat))+
#   geom_ribbon(aes(ymin = lwr, ymax = upr, 
#     fill = race_5cat
#     ),
#     alpha = .5)+
#   geom_line()+
#   facet_wrap( ~ race_5cat)+
#   theme_minimal()+
#   guides(
#     col = "none",
#     fill = "none"
#   )+
#   labs(
#     y = "Predicted Vote Choice",
#     title = "Support for Trump by Age and Race Controlling for Partisanship"
#   )
# 
# fig_m3
```

Please produce at least one figure showing predicted values from at least one of your models

```{r}
#| label: figYOU

# Create a prediction data frame

# Bind predicted values to prediction data frame

# Produce Figure

# Dispaly figure

```


## Interperet results

Here is my interpretation of the models:

**ME:** Our baseline model confirms our initial expectations. Controlling for race, older respondents have higher predicted levels of support for Trump by 0.002 percentage points. Controlling for race, the model predicts that a 60 year old respondent is about 6.3 percentage points more likely to vote for Trump than a 30 year-old respondent. The test statistic for this coefficient is 3.10 corresponding to a p-value < 0.05, suggesting that if there were no relationship between age and vote choice in this model, it would be very unlikely that we observed a test statistic of this magnitude. Similarly the confidence interval for this estimate has suggests that coefficients as small as 0.0008 and as large as 0.0034 are plausible values for the relationship between age and vote choice in these data. Similarly, controlling for age, Black, Hispanic, and Asian respondents report significantly lower levels of support for Trump than white respondents (p < 0.05). 

Turning to the interaction model, we see that the magnitude of the coefficient on age (which corresponds to the marginal effect of age for white respondents) increases, while the coefficients on the interactions between age and racial indicators are generally negative, suggesting that the relationship between age and support for Trump is less strong for these racial and ethnic groups. Figure 1 helps clarify these marginal effects, as we see that slope for age is clearly positive for white respondents, clearly negative for Black respondents. The confidence intervals for the predicted values of the other racial and ethnic groups are generally wide, and consisent with positive, negative, or no relationship between age and vote choice.

Finally, looking at the model controlling for partisanship, we see that none of the relationships between age, race, and vote choice, remain statistically significant once we account for the relationships between partisanship and vote choice, and the relationships between partisanship and age and race. In sum, apparent demographic differences in support for Trump appear driven by the differences in partisan identification across racial groups and within age groups.

**YOU:**
