SDPanalyze.Rmd

---
title: "ANALYZE: ANALYSIS GUIDE"
author: "Strategic Data Project"
date: "Center for Education Policy Research at Harvard University"
output:
  pdf_document:
    toc: yes
    toc_depth: 4
    latex_engine: xelatex
    includes:
      in_header: harvardheader.tex
      before_body: harvard_prefix.tex
  html_document:
    toc: yes
    toc_depth: 4
---

```{r knitrSetup, echo=FALSE, error=FALSE, message=FALSE, warning=FALSE, comment=NA}
# Set options for knitr
library(knitr)
knitr::opts_chunk$set(comment=NA, warning=FALSE, echo=TRUE,
                      error=FALSE, message=FALSE, fig.align='center',
                      fig.width=8, fig.height=6, dpi = 144, 
                      fig.path = "figure/Analyze_")
options(width=80)
```

\clearpage

# Analyze

**Analyze:** College Going Success Analysis Guide is a set of step-by-step 
instructions to help you generate data visualizations about student pathways 
through high school and college. Through **Analyze**, your previous work 
identifying, cleaning, and connecting data will generate actual analyses to 
inform decision making in your agency!

## College Going Success Analysis Guide

So far you have identified, cleaned, and connected your data into a single 
analysis file named `CG_Analysis`. **Analyze** uses this final analysis file to 
generate a number of analyses along the student pipeline through high school 
and college.

### Analyze Structure

With each analysis, you will find:

- A picture of the analysis, based on the synthetic data;
- **Purpose:** an explanation of each analysis’ value and its ability to 
support understanding of high school completion and college-going success in 
your agency;
- **Required Analysis File Variables:** the variables from the analysis file you 
will need;
- **Analysis-Specific Sample Restrictions:** a list of restrictions that you 
will apply to define the sample for the analysis;
- **Ask Yourself:** a set of questions to help interpret results and invite 
deeper inquiry;
- **Possible Next Steps or Action Plans:** further analyses you may conduct to
understand underlying causes or interventions needed (this section is included 
in some but not all analyses) 
- **Analytic Technique:** how to produce the analysis step-by-step using your 
analysis file and code in R.

### Analysis-Specific Sample Restrictions

One of the most important decisions in running each analysis is defining the 
sample. Each analysis corresponds to a different part of the education pipeline 
and as a result require different cohorts of students.

If you are using the synthetic data we have provided (available for download at
[sdp.cepr.harvard.edu/toolkit](www.sdp.cepr.harvard.edu/toolkit)), the sample
restrictions have been predefined and are included on the next page.

If you are using your own agency data, change these sample restrictions based 
on your data. 

Note that you will have to run these sample restrictions at the beginning of 
your **Analyze** R script so they will feed into the rest of your R code.

```{r preliminaries}
library(tidyverse) # main suite of R packages to ease data analysis
library(magrittr) # allows for some easier pipelines of data
# Read in some R functions that are convenience wrappers
source("R/functions.R")
library(haven) # required for importing .dta files

# Read in global variables for sample restriction
# Agency name
agency_name <- "Agency"

# Ninth grade cohorts you can observe persisting to the second year of college
chrt_ninth_begin_persist_yr2 = 2005
chrt_ninth_end_persist_yr2 = 2005

# Ninth grade cohorts you can observe graduating high school on time
chrt_ninth_begin_grad = 2005
chrt_ninth_end_grad = 2006

# Ninth grade cohorts you can observe graduating high school one year late
chrt_ninth_begin_grad_late = 2005
chrt_ninth_end_grad_late = 2005

# High school graduation cohorts you can observe enrolling in college the 
# fall after graduation
chrt_grad_begin = 2008
chrt_grad_end = 2009

# High school graduation cohorts you can observe enrolling in college 
# two years after hs graduation
chrt_grad_begin_delayed = 2008
chrt_grad_end_delayed = 2008

# In RStudio these variables will appear in the Environment pane under "Values"

```

Based on the sample data, you will have no more than two cohorts (sometimes only 
one) for analysis. If your own agency data is more extensive, you may decide 
to aggregate results for three or four cohorts to report your results. This 
decision depends on 1) how much historical data you have (you may only have two 
cohorts of data) and 2) what balance to strike between reliability and averaging
away information on recent trends. We suggest you average results for the last 
three cohorts to take advantage of larger sample sizes and improve reliability. 
However, if you have data for more than three cohorts, you may decide to not 
average data out for fear of losing information about trends and recent changes 
in your agency.

### Strategic Performance Indicators (SPIs)

Three of the analyses in the College Enrollment section of **Analyze** include 
the Strategic Performance Indicators (SPIs) SDP has released to provide deeper 
insight into the college-going performance of educational systems. These SPIs 
were produced using data from a number of SDP's partner agencies. You will be 
able to conduct these analyses yourself through **Analyze**. You can read more 
about the SPIs at [sdp.cepr.harvard.edu/spi](http://sdp.cepr.harvard.edu/spi).

### Summary

After completing Analyze, you will have:

- Used your final analysis file from Connect to generate many different 
analyses to display student outcomes along the education pipeline;
- Obtained new and confirmatory information about high school and college-going 
outcomes in your agency; and
- Learned essential methodologies to embark on your own "deeper dives" into the 
data.

Share these analyses with colleagues, peers, and senior leadership in your agency.

- Ask yourself how these analyses might further inquiry and inform policy.
- How might you adapt these analyses to track performance over time?
- What relationships were particularly informative?
- How might you extend certain analyses to be even more informative?
- Who should have this information?

As a final note, the analyses presented here do not capture all of our research
team’s efforts to understand college-going success. We believe the analyses
presented are the most widely applicable to drive discussions about change.
Moreover, we believe these analyses serve as a model to seek answers about
postsecondary success. We would love to hear how these model analyses inspired
different analyses and "deeper dives" in your agency. As always, if you require
additional support, feel free to email us at sdp@gse.harvard.edu.

# A: Attainment Along the Education Pipeline

Attainment along the Education Pipeline analyses summarize student attainment 
from ninth grade through college using three milestones: 1) on-time high school
completion, 2) seamless college transition, and 3) persistence to the second 
year of college. 

Through these analyses, you identify drop-offs along the education pipeline for 
students as a group and as subgroups. For different subgroups, these analyses 
illuminate disparities in college attainment by race, family income, high school
attended, and academic achievement. A steep decline in college enrollment from 
high school completion date for specific subgroups may indicate barriers to 
college access. On the other hand, a steep decline from initial college 
enrollment to second-year persistence might suggest students were not prepared 
for rigorous college coursework during high school. 

<!-- The analyses exploring attainment along the pipeline include: -->

<!-- 1. OVERALL PROGRESSION -->

<!-- \includegraphics[width=0.3\linewidth]{figure/Analyze_A1graph-1.pdf} -->

<!-- 2. PROGRESSION BY STUDENT RACE/ETHNICITY -->

<!-- \includegraphics[width=0.3\linewidth]{figure/Analyze_A2plot-1.pdf} -->

<!-- 3. PROGRESSION BY STUDENT RACE/ETHNICITY, AMONG FRPL-ELIGIBLE STUDENTS -->

<!-- \includegraphics[width=0.3\linewidth]{figure/Analyze_A3plot-1.pdf} -->

<!-- 4. PROGRESSION BY STUDENTS' ON-TRACK STATUS AFTER NINTH GRADE -->

<!-- \includegraphics[width=0.3\linewidth]{figure/Analyze_A4plot-1.pdf} -->

## Task 1: Overall Progression

**Purpose:** This analysis tracks the overall percent of ninth graders who 
complete high school on-time, seamlessly enroll in college, and persist to the 
second year of college. To examine the range of attainment at each milestone, 
the minimum and maximum values of any high school are shown. 

**Required Analysis File Variables:**

- `sid`
- `chrt_ninth`
- `first_hs_name`
- `ontime_grad`
- `enrl_1oct_ninth_yr1_any`
- `enrl_1oct_ninth_yr2_any`

**Analysis-Specific Sample Restrictions:** Keep students in ninth
grade cohorts for which persistence to the second year of college
can be reported.

**Ask Yourself** 

- Do you notice drop-offs along the pipeline?
- Are differences in agency maxima and minima at different points along the 
pipeline surprising? What might be different about these high schools?
- Are your numbers in line with agency-reported figures in other publicly 
available reports? What might account for differences?

**Analytic Technique:** Calculate the proportion of first-time ninth graders that 
progress to each step along the education pipeline.


```{r loadCGdataAttainment}
# Step 1: Load the college-going analysis file into Stata
# library(haven) # commented out, we've already read it in above
# To read data from a zip file and unzip it in R we can 
# create a connection to the path of the zip file
tmpfileName <- "analysis/CG_Analysis.dta"
# This assumes analysis is a subfolder from where the file is read, in this 
# case inside the zipfile
con <- unz(description = "data/analysis.zip", filename = tmpfileName, 
           open = "rb")
# The zipfile is located in the subdirectory data, called analysis.zip
cgdata <- read_stata(con) # read data in the data subdirectory
close(con) # close the connection to the zip file, keeps data in memory
```

```{r Remindersetglobals}

# Step 2: Read in global variables if you have not already done so
# Ninth grade cohorts you can observe persisting to the second year of college
chrt_ninth_begin_persist_yr2 = 2005
chrt_ninth_end_persist_yr2 = 2005

# Ninth grade cohorts you can observe graduating high school on time
chrt_ninth_begin_grad = 2005
chrt_ninth_end_grad = 2006

# Ninth grade cohorts you can observe graduating high school one year late
chrt_ninth_begin_grad_late = 2005
chrt_ninth_end_grad_late = 2005

# High school graduation cohorts you can observe enrolling in college the 
# fall after graduation
chrt_grad_begin = 2008
chrt_grad_end = 2009

# High school graduation cohorts you can observe enrolling in college 
# two years after hs graduation
chrt_grad_begin_delayed = 2008
chrt_grad_end_delayed = 2008

# In RStudio these variables will appear in the Environment pane under "Values"
```


```{r A1filterCalculate}
# Step 3: Keep students in ninth grade cohorts you can observe persisting to the 
# second year of college

plotdf <- filter(cgdata, chrt_ninth >= chrt_ninth_begin_persist_yr2 & 
                   chrt_ninth <= chrt_ninth_end_persist_yr2)

# Step 4: Create variables for the outcomes "regular diploma recipients", 
#  "seamless transitioners" and "second year persisters"

plotdf$grad <- ifelse(!is.na(plotdf$chrt_grad) & plotdf$ontime_grad ==1, 1, 0)
plotdf$seamless_transitioners_any <- as.numeric(plotdf$enrl_1oct_ninth_yr1_any == 1 &
                                                 plotdf$ontime_grad == 1)
plotdf$second_year_persisters = as.numeric(plotdf$enrl_1oct_ninth_yr1_any == 1 &
                                             plotdf$enrl_1oct_ninth_yr2_any == 1 &
                                             plotdf$ontime_grad == 1)
# // Step 4: Create agency-level average outcomes

# // 2. Calculate the mean of each outcome variable by agency

agencyData <- plotdf %>%  
  summarize(grad = mean(grad), 
            seamless_transitioners_any = mean(seamless_transitioners_any, na.rm=TRUE), 
            second_year_persisters = mean(second_year_persisters, na.rm=TRUE), 
            N = n())

agencyData$school_name <- "AGENCY AVERAGE"
# // 2. Calculate the mean of each outcome variable by first high school attended
schoolData <- plotdf %>% group_by(first_hs_name) %>% 
  summarize(grad = mean(grad), 
            seamless_transitioners_any = mean(seamless_transitioners_any,
                                               na.rm=TRUE), 
            second_year_persisters = mean(second_year_persisters, na.rm=TRUE), 
            N = n())
# // 1. Create a variable school_name that takes on the value of students’ first 
## high school attended
names(schoolData)[1] <- "school_name"

# // 3. Identify the agency maximum values for each of the three outcome variables
maxSchool <- schoolData %>% summarize_all(.funs = funs("max"))
maxSchool$school_name <- "AGENCY MAX HS"

# // 4. Identify the agency minimum values for each of the three outcome variables
minSchool <- schoolData %>% summarize_all(.funs = funs("min"))
minSchool$school_name <- "AGENCY MIN HS"
# // 5. Append the three tempfiles to the school-level file loaded into R
schoolData <- bind_rows(schoolData, agencyData, 
                        minSchool, maxSchool)
rm(agencyData, minSchool, maxSchool)
```

```{r A1tidydata}
# // Step 6: Prepare to graph the results
library(tidyr)
schoolData$cohort <- 1
schoolData <- schoolData %>% gather(key = outcome, 
                             value = measure, -N, -school_name)
schoolData$subset <- grepl("AGENCY", schoolData$school_name)
library(ggplot2)
library(scales)

schoolData$outcome[schoolData$outcome == "cohort"] <- "Ninth Graders"
schoolData$outcome[schoolData$outcome == "grad"] <- "On-time Graduates"
schoolData$outcome[schoolData$outcome == "seameless_transitioners_any"] <- 
  "Seamless College Transitioner"
schoolData$outcome[schoolData$outcome == "second_year_persisters"] <- 
  "Second Year Persisters"
```


```{r A1graph}
## // Step 7: Graph the results

ggplot(schoolData[schoolData$subset,], 
       aes(x = outcome, y = measure, group = school_name, 
           color = school_name, linetype = school_name)) + 
  geom_line(size = 1.1) + geom_point(aes(group = 1), color = I("black")) +
  geom_text(aes(label = round(measure * 100, 1)), vjust = -0.8, hjust = -0.25, 
            color = I("black")) +
  scale_y_continuous(limits = c(0, 1), label = percent) + 
  theme_bw() + theme(legend.position = c(0.825, 0.825)) + 
  guides(color = guide_legend("", keywidth = 6, 
                              label.theme = element_text(face = "bold", 
                                                         size = 8,
                                                         angle = 0)), 
         linetype = "none") +
  labs(y = "Percent of Ninth Graders", 
       title = "Student Progression from 9th Grade Through College", 
       subtitle = "Agency Average", x = "",
       caption = paste0("Sample: 2004-2005 Agency first-time ninth graders. \n", 
                  "Postsecondary enrollment outcomes from NSC matched records. \n",
                        "All other data from Agency administrative records."))


```


## Task 2: Progression by Student Race/Ethnicity

**Purpose:** This analysis tracks the percent of ninth graders of 
different races/ethnicities who complete high school on-time, seamlessly enroll 
in college, and persist to the second year of college.

**Required Analysis File Variables:**

- `sid`
- `race_ethnicity`
- `chrt_ninth`
- `ontime_grad`
- `enrl_1oct_ninth_yr1_any`
- `enrl_1oct_ninth_yr2_any`


**Analysis-Specific Sample Restrictions:** 

- Keep students in ninth grade cohorts for which persistence
to the second year of college can be reported.
- Restrict the sample to include students from the most representative
racial/ethnic sub-groups.

**Ask Yourself** 

- Which races/ethnicities face larger drop-offs along the pipeline?
- Might certain groups face different barriers to progressing along the education pipeline?

**Analytic Technique:** Calculate the proportion of first-time ninth graders 
that progress to each step along the education pipeline.

```{r A2filterCalculate}
# // Step 1: Keep students in ninth grade cohorts you can observe persisting to 
## the second year of college

plotdf <- filter(cgdata, chrt_ninth >= chrt_ninth_begin_persist_yr2 & 
                   chrt_ninth <= chrt_ninth_end_persist_yr2)

# // Step 2: Create variables for the outcomes "regular diploma recipients", 
## "seamless transitioners" and "second year persisters"
plotdf$grad <- ifelse(!is.na(plotdf$chrt_grad) & plotdf$ontime_grad ==1, 1, 0)
plotdf$seamless_transitioners_any <- as.numeric(plotdf$enrl_1oct_ninth_yr1_any == 1 &
                                                 plotdf$ontime_grad == 1)
plotdf$second_year_persisters = as.numeric(plotdf$enrl_1oct_ninth_yr1_any == 1 &
                                             plotdf$enrl_1oct_ninth_yr2_any == 1 &
                                             plotdf$ontime_grad == 1)
# // Step 3: Create agency-level average outcomes
progressRace <- plotdf %>% group_by(race_ethnicity) %>% 
  summarize(grad = mean(grad), 
            seameless_transitioners_any = mean(seamless_transitioners_any, na.rm=TRUE), 
            second_year_persisters = mean(second_year_persisters, na.rm=TRUE), 
            N = n())
```

```{r A2tidyandFormat}
# // Step 4: Reformat the data for plotting
progressRace$cohort <- 1
progressRace <- progressRace %>% gather(key = outcome, 
                             value = measure, -N, -race_ethnicity)

# // Step 5: Recode variables for plot-friendly labels
progressRace$outcome[progressRace$outcome == "cohort"] <- "Ninth Graders"
progressRace$outcome[progressRace$outcome == "grad"] <- "On-time Graduates"
progressRace$outcome[progressRace$outcome == "seameless_transitioners_any"] <- 
  "Seamless College Transitioner"
progressRace$outcome[progressRace$outcome == "second_year_persisters"] <- 
  "Second Year Persisters"

progressRace$subset <- ifelse(progressRace$race_ethnicity %in% c(1, 3, 2, 5), 
                              TRUE, FALSE)
progressRace$race_ethnicity[progressRace$race_ethnicity == 1] <- "Black"
progressRace$race_ethnicity[progressRace$race_ethnicity == 2] <- "Asian"
progressRace$race_ethnicity[progressRace$race_ethnicity == 3] <- "Hispanic"
progressRace$race_ethnicity[progressRace$race_ethnicity == 4] <- "Native American"
progressRace$race_ethnicity[progressRace$race_ethnicity == 5] <- "White"
progressRace$race_ethnicity[progressRace$race_ethnicity == 6] <- "Multiple/Other"
progressRace$race_ethnicity <- as.character(zap_labels(progressRace$race_ethnicity))
```


```{r A2plot}
# Step 6: Graph the results
ggplot(progressRace[progressRace$subset,], 
       aes(x = outcome, y = measure, group = race_ethnicity, 
           color = race_ethnicity, linetype = race_ethnicity)) + 
  geom_line(size = 1.1) + geom_point(aes(group = 1), color = I("black")) +
  geom_text(aes(label = round(measure * 100, 1)), vjust = -0.8, hjust = -0.25, 
            color = I("black")) +
  scale_y_continuous(limits = c(0, 1), label = percent) + 
  theme_bw() + theme(legend.position = c(0.825, 0.825)) + 
  guides(color = guide_legend("", keywidth = 6, 
                          label.theme = 
                            element_text(face = "bold", size = 8,
                                         angle = 0)), linetype = "none") +
  labs(y = "Percent of Ninth Graders", 
       title = "Student Progression from 9th Grade Through College", 
       subtitle = "By Student Race/Ethnicity", x = "",
       caption = paste0("Sample: 2004-2005 Agency first-time ninth graders. \n", 
                  "Postsecondary enrollment outcomes from NSC matched records. \n",
                       "All other data from Agency administrative records."))

```

## Task 3: Progression by Student Race/Ethnicity, Among FRPL Students

**Purpose:**  This analysis tracks the percent of ninth graders of different
races/ethnicities who ever qualified for free or reduce price lunch who complete 
high school on-time, seamlessly enroll in college, and persist to the second 
year of college.

**Required Analysis File Variables:**

- `sid`
- `race_ethnicity`
- `frpl_ever`
- `chrt_ninth`
- `ontime_grad`
- `enrl_1oct_ninth_yr1_any`
- `enrl_1oct_ninth_yr2_any`

**Analysis-Specific Sample Restrictions:** 

- Keep students in ninth grade cohorts for which persistence to the second year 
of college can be reported. 
- Restrict the analysis to include only students who were ever eligible to 
receive free-or reduced-price lunch throughout their time in your agency, and 
drop any race/ethnic groups with less than 20 students at any point along the 
pipeline.

**Ask Yourself** 

- How do differences between races/ethnicities change along the pipeline when 
only students whoever qualifying for free or reduced price lunch are examined?

**Analytic Technique:** Calculate the proportion of first-time ninth graders 
that progress to each step along the education pipeline.

```{r A3 filterSample}
## Step 1: Keep students in ninth grade cohorts you can observe persisting to 
## the second year of college AND are ever FRPL-eligible

plotdf <- filter(cgdata, chrt_ninth >= chrt_ninth_begin_persist_yr2 & 
                   chrt_ninth <= chrt_ninth_end_persist_yr2) %>% 
  filter(frpl_ever > 0)

# // Step 2: Create variables for the outcomes "regular diploma recipients", 
## "seamless transitioners" and "second year persisters"

plotdf$grad <- ifelse(!is.na(plotdf$chrt_grad) & plotdf$ontime_grad == 1, 1, 0)
plotdf$seamless_transitioners_any <- ifelse(plotdf$enrl_1oct_ninth_yr1_any == 1 &
                                                 plotdf$ontime_grad == 1, 1, 0)
plotdf$second_year_persisters = ifelse(plotdf$enrl_1oct_ninth_yr1_any == 1 &
                                             plotdf$enrl_1oct_ninth_yr2_any == 1 &
                                             plotdf$ontime_grad == 1, 1, 0)

# // Step 4: Create agency-level average outcomes
# // Calculate the mean of each outcome variable by race/ethnicity

progressRaceFRL <- plotdf %>% group_by(race_ethnicity) %>% 
  summarize(grad = mean(grad), 
            seameless_transitioners_any = mean(seamless_transitioners_any, na.rm=TRUE), 
            second_year_persisters = mean(second_year_persisters, na.rm=TRUE), 
            N = n())

# // Step 5: Reformat the data file so that one variable contains all the 
# outcomes of interest

progressRaceFRL %<>% filter(N >= 20)
```

```{r A3reshapeRecode}

# // Step 6: Prepare to graph the results
## Reshape the data 
progressRaceFRL$cohort <- 1
progressRaceFRL <- progressRaceFRL %>% gather(key = outcome, 
                             value = measure, -N, -race_ethnicity)

## Recode the variables for plot friendly labels

progressRaceFRL$outcome[progressRaceFRL$outcome == "cohort"] <- 
  "Ninth Graders"
progressRaceFRL$outcome[progressRaceFRL$outcome == "grad"] <- 
  "On-time Graduates"
progressRaceFRL$outcome[progressRaceFRL$outcome == "seameless_transitioners_any"] <-
  "Seamless College Transitioner"
progressRaceFRL$outcome[progressRaceFRL$outcome == "second_year_persisters"] <- 
  "Second Year Persisters"

progressRaceFRL$subset <- ifelse(progressRaceFRL$race_ethnicity %in% c(1, 3, 5), 
                              TRUE, FALSE)
progressRaceFRL$race_ethnicity[progressRaceFRL$race_ethnicity == 1] <- "Black"
progressRaceFRL$race_ethnicity[progressRaceFRL$race_ethnicity == 2] <- "Asian"
progressRaceFRL$race_ethnicity[progressRaceFRL$race_ethnicity == 3] <- "Hispanic"
progressRaceFRL$race_ethnicity[progressRaceFRL$race_ethnicity == 4] <- "Native American"
progressRaceFRL$race_ethnicity[progressRaceFRL$race_ethnicity == 5] <- "White"
progressRaceFRL$race_ethnicity[progressRaceFRL$race_ethnicity == 6] <- "Multiple/Other"
progressRaceFRL$race_ethnicity <- as.character(zap_labels(progressRaceFRL$race_ethnicity))
```

```{r A3plot}
ggplot(progressRaceFRL[progressRaceFRL$subset,], 
       aes(x = outcome, y = measure, group = race_ethnicity, 
           color = race_ethnicity, linetype = race_ethnicity)) + 
  geom_line(size = 1.1) + geom_point(aes(group = 1), color = I("black")) +
  geom_text(aes(label = round(measure * 100, 1)), vjust = -0.8, hjust = -0.25, 
            color = I("black")) +
  scale_y_continuous(limits = c(0, 1), label = percent) + 
  theme_bw() + theme(legend.position = c(0.825, 0.825)) + 
  guides(color = guide_legend("", keywidth = 6, 
                              label.theme = element_text(face = "bold", 
                                                         size = 8,
                                                         angle = 0)), 
         linetype = "none") +
  labs(y = "Percent of Ninth Graders", 
       title = "Student Progression from 9th Grade Through College", 
       subtitle = paste0(c(
         "Among Students Qualifying for Free or Reduced Price Lunch \n", 
                           "By Student Race/Ethnicity")), 
       x = "",
       caption = paste0("Sample: 2004-2005 Agency first-time ninth graders. \n",
                   "Postsecondary enrollment outcomes from NSC matched records.\n", 
                        "All other data from Agency administrative records."))
```

## Task 4: Progression by Students' On-Track Status After Ninth Grade

**Purpose:** This analysis tracks the percent of ninth graders at different 
levels of being on-track for graduation who complete high school on-time, 
seamlessly enroll in college, and then persist to the second year of college.


**Required Analysis File Variables:**

- `sid`
- `chrt_ninth`
- `ontrack_sample`
- `ontrack_end_yr*`
- `cum_gpa_yr*`
- `ontime_grad`
- `enrl_1oct_ninth_yr1_any`
- `enrl_1oct_ninth_yr2_any`


**Analysis-Specific Sample Restrictions:** 

- Only include the three most recent ninth grade cohorts for
which persistence to second year of college can be reported.
- Restrict the sample to include only students in the on-track
analytic sample (students who attended the first semester of
ninth grade in the system and never transferred into, or out
of the system).
- Students that obtain Special Education diplomas upon high
school entry should be excluded from the analytic sample if
these students are not required to meet the same graduation
requirements as general education students, and if the
designation can be made.


**Ask Yourself** 

- How does being on-track for graduation after ninth grade relate to on-time 
graduation, seamless enrollment, and second year persistence?
- How does being on-track after ninth grade with a higher GPA compare to being 
on-track with a lower GPA?


**Analytic Technique:** Calculate the proportion of first-time ninth graders 
that progressed along the education pipeline.

```{r A4filterAndSortData}

#  // Step 1: Keep students in ninth grade cohorts you can observe persisting 
#  to the second year of college AND are included in the on-track analysis sample

plotdf <- filter(cgdata, chrt_ninth >= chrt_ninth_begin_persist_yr2 & 
                   chrt_ninth <= chrt_ninth_end_persist_yr2) %>% 
  filter(ontrack_sample == 1)

# // Step 2: Create variables for the outcomes "regular diploma recipients", 
# "seamless transitioners" and "second year persisters"

plotdf$grad <- ifelse(!is.na(plotdf$chrt_grad) & plotdf$ontime_grad ==1, 1, 0)
plotdf$seamless_transitioners_any <- as.numeric(plotdf$enrl_1oct_ninth_yr1_any == 1 &
                                                 plotdf$ontime_grad == 1)
plotdf$second_year_persisters = as.numeric(plotdf$enrl_1oct_ninth_yr1_any == 1 &
                                             plotdf$enrl_1oct_ninth_yr2_any == 1 &
                                             plotdf$ontime_grad == 1)

# // Step 3: Generate on track indicators that take into account students’ GPAs 
# upon completion of their first year in high school

plotdf$ot <- NA
plotdf$ot[plotdf$ontrack_endyr1 == 0] <- "Off-Track to Graduate"

# Check for correctness
plotdf$ot[plotdf$ontrack_endyr1 == 1 & plotdf$cum_gpa_yr1 < 3 & 
            !is.na(plotdf$cum_gpa_yr1)] <- "On-Track to Graduate, GPA < 3.0"
plotdf$ot[plotdf$ontrack_endyr1 == 1 & plotdf$cum_gpa_yr1 >= 3 & 
            !is.na(plotdf$cum_gpa_yr1)] <- "On-Track to Graduate, GPA >= 3.0"

```


```{r A4reshapeAndFormat}
#  // Step 4: Calculate aggregates for the Agency by on track status
progressTrack <- plotdf %>% group_by(ot) %>% 
  summarize(grad = mean(grad), 
            seameless_transitioners_any = mean(seamless_transitioners_any, na.rm=TRUE), 
            second_year_persisters = mean(second_year_persisters, na.rm=TRUE), 
            N = n())

# // Step 5: Reformat the data file so that one variable contains all the outcomes 
#  of interest
progressTrack$cohort <- 1
progressTrack <- progressTrack %>% gather(key = outcome, 
                             value = measure, -N, -ot)

progressTrack$outcome[progressTrack$outcome == "cohort"] <- "Ninth Graders"
progressTrack$outcome[progressTrack$outcome == "grad"] <- "On-time Graduates"
progressTrack$outcome[progressTrack$outcome == "seameless_transitioners_any"] <-
  "Seamless College Transitioner"
progressTrack$outcome[progressTrack$outcome == "second_year_persisters"] <- 
  "Second Year Persisters"

```

```{r A4plot}
# Annotate for direct labels
ann_txt <- data.frame(outcome = rep("Second Year Persisters", 3), 
                      measure = c(0.22, 0.55, 0.85), 
                      textlabel = c("Off-Track \nto Graduate", 
                                    "On-Track to Graduate,\n GPA < 3.0", 
                                    "On-Track to Graduate,\n GPA >= 3.0"))
ann_txt$ot <- ann_txt$textlabel

ggplot(progressTrack, 
       aes(x = outcome, y = measure, group = ot, 
           color = ot, linetype = ot)) + 
  geom_line(size = 1.1) + geom_point(aes(group = 1), color = I("black")) +
  geom_text(aes(label = round(measure * 100, 1)), vjust = -0.8, hjust = -0.25, 
            color = I("black")) +
  geom_text(data = ann_txt, aes(label = textlabel)) + 
  scale_y_continuous(limits = c(0, 1), label = percent) + 
  theme_bw() + theme(legend.position = c(0.825, 0.825)) + 
  scale_color_brewer(type = "qual", palette = 2) +
  guides(color = "none", 
         linetype = "none") +
  labs(y = "Percent of Ninth Graders", 
       title = "Student Progression from 9th Grade Through College", 
       subtitle = "By Course Credits and GPA after First High School Year", x = "",
       caption = paste0("Sample: 2004-2005 Agency first-time ninth graders. \n",
                "Postsecondary enrollment outcomes from NSC matched records. \n",
                 "All other data from Agency administrative records."))
```

# B: Ninth to Tenth Grade Transition by On-Track Status

Research suggests that academic performance in ninth grade strongly predicts 
the likelihood of a student dropping out of high school. In this section, you 
examine patterns of student retention and on-time transitions from ninth to 
tenth grade. This information can provide an early warning to an agency with 
students at-risk of dropping out, and might benefit from targeted support early 
in their high school careers.

To explore transitions from ninth to tenth grade, use the following model analyses:

1. Proportion of Students On-Track at the End of Ninth Grade, by high school

2. Ninth to tenth grade transition by on-track status

## Task 1 Proportion of Students On-Track by High School

**Purpose:** This analysis illustrates what percent of students are on-track 
after ninth grade graduate from each high school and the agency as a whole. 
Different levels of on-track for graduation are distinguished by high school.


**Required Analysis File Variables:**

- `sid`
- `chrt_ninth`
- `first_hs-Name`
- `first_hs_code`
- `ontrack_endyr1*`
- `cum_gpa_yr1`

**Analysis-Specific Sample Restrictions:** Keep students in ninth grade cohorts 
you can observe graduating high school on time AND are part of the on-track 
sample (attended the first semester of ninth grade and never transferred into 
or out of the system).

**Ask Yourself**

- How does the percent of students on-track differ by high school (consider 
the overall height of each bar)?
- How does the percent of students on-track for an advanced versus general 
diploma differ by high school (consider the different components of each bar)?

**Possible Next Steps or Action Plans:** Overall school-level results can be 
disaggregated by student subgroups of interest, (race, FRPL status, and eighth 
grade academic achievement). 

**Analytic Technique:** Calculate the proportion of students on-track at each 
school, and across the agency.

 

```{r B1filterAndSort}
#  // Step 1: Keep students in ninth grade cohorts you can observe graduating 
#  high school on time AND are part of the ontrack sample (attended the first 
#  semester of ninth grade and never transferred into or out of the system)

plotdf <- filter(cgdata, chrt_ninth >= chrt_ninth_begin_grad & 
                   chrt_ninth <= chrt_ninth_end_grad) %>% 
  filter(ontrack_sample == 1)

# // Step 2: Create variables for the outcomes "regular diploma recipients", 
#           "seamless transitioners" and "second year persisters"
plotdf$grad <- ifelse(!is.na(plotdf$chrt_grad) & plotdf$ontime_grad ==1, 1, 0)
plotdf$seamless_transitioners_any <- as.numeric(plotdf$enrl_1oct_ninth_yr1_any == 1 &
                                                 plotdf$ontime_grad == 1)
plotdf$second_year_persisters = as.numeric(plotdf$enrl_1oct_ninth_yr1_any == 1 &
                                             plotdf$enrl_1oct_ninth_yr2_any == 1 &
                                             plotdf$ontime_grad == 1)

# // Step 3: Generate on track indicators that take into account students’ GPAs 
# upon completion of their first year in high school

plotdf$ot <- NA
plotdf$ot[plotdf$ontrack_endyr1 == 0] <- "Off-Track to Graduate"
plotdf$ot[plotdf$ontrack_endyr1 == 1 & plotdf$cum_gpa_yr1 < 3 &
            !is.na(plotdf$cum_gpa_yr1)] <- "On-Track to Graduate, GPA < 3.0"
plotdf$ot[plotdf$ontrack_endyr1 == 1 & plotdf$cum_gpa_yr1 >= 3 &
            !is.na(plotdf$cum_gpa_yr1)] <- "On-Track to Graduate, GPA >= 3.0"

```

```{r B1reshape}
# // Step 4: Obtain the agency average for the key variables
# and obtain mean rates for each school and append the agency average

progressBars <- bind_rows(
  plotdf %>% group_by(ot) %>% tally() %>% ungroup %>% 
    mutate(count = sum(n), first_hs_name = "Agency Average"), 
  plotdf %>% group_by(first_hs_name, ot) %>% tally() %>% ungroup %>% 
    group_by(first_hs_name) %>%
    mutate(count = sum(n))
)

# replace first_hs_name = subinstr(first_hs_name, " High School", "", .)
progressBars$first_hs_name <- gsub(" High School", "", progressBars$first_hs_name)

# // Step 5: For students who are off-track upon completion of their first year 
#  of high school, convert the values to be negative for ease of 
#  visualization in the graph

progressBars$n[progressBars$ot == "Off-Track to Graduate"] <- 
  -progressBars$n[progressBars$ot == "Off-Track to Graduate"] 
```


```{r B1plot}
# // Step 6: Plot
ggplot(progressBars, aes(x = reorder(first_hs_name, n/count), 
                         y = n/count, group = ot)) + 
  geom_bar(aes(fill = ot), stat = 'identity') + 
  geom_text(aes(label = round(100* n/count, 0)), 
            position = position_stack(vjust=0.3)) + 
  theme_bw() + 
  scale_y_continuous(limits = c(-0.8,1), label = percent, 
                    name = "Percent of Ninth Graders", 
                    breaks = seq(-0.8, 1, 0.2)) + 
  scale_fill_brewer(name = "", type = "qual", palette = 6) + 
  theme(axis.text.x = element_text(angle = 30, color = "black", vjust = 0.5), 
        legend.position = c(0.15, 0.875)) +
  labs(title = "Proportion of Students On-Track to Graduate by School", 
       subtitle = "End of Ninth Grade On-Track Status \n By High School", x = "",
       caption = paste0("Sample: 2004-2005 and 2005-20065 Agency first-time ninth
                      graders. \n", 
              "Postsecondary enrollment outcomes from NSC matched records. \n",
                        "All other data from Agency administrative records."))

```


## Task 2: Ninth To Tenth Grade Transition by On-Track Status

**Purpose:** This analysis explores how on-track status after ninth grade 
(the horizontal axis) predicts ontrack status in tenth grade (the vertical axis). 
This analysis is useful for developing early dropout warning indicators for 
at-risk students as early as the second semester of ninth grade. 

**Required Analysis File Variables:**

- `sid`
- `chrt_ninth`
- `first_hs_name`
- `first_hs_code`
- `ontrack_endyr1*`
- `cum_gpa_yr1*`

**Analysis-Specific Sample Restrictions:** Keep students in ninth grade cohorts 
you can observe graduating high school on time AND are part of the on-track 
sample (attended the first semester of ninth grade and never transferred into 
or out of the system).

**Ask Yourself:**

- What percent of those in a specific on-track category at the end of ninth 
grade stay in that same on-track category? For example, what percent of 
off-track ninth graders continue off-track in tenth grade?
- How might you use an early warning system to help students get back on-track 
for graduation?

**Possible Next Steps or Action Plans:** Identify additional risk factors, 
(chronic absenteeism, prior academic achievement etc.) which can be 
incorporated into analyses like the one above. This could be used to further 
understand which students struggle, why they struggle, and interventions to keep 
them enrolled and engaged.

 

```{r B2filterAndSort}
# // Step 1: Keep students in ninth grade cohorts you can observe graduating 
# high school on time AND are part of the ontrack sample (attended the first 
# semester of ninth grade and never transferred into or out of the system)

plotdf <- filter(cgdata, chrt_ninth >= chrt_ninth_begin_grad & 
                   chrt_ninth <= chrt_ninth_end_grad) %>% 
   filter(ontrack_sample == 1)

# // Step 2: Create variables for the outcomes "regular diploma recipients", 
#  "seamless transitioners" and "second year persisters"

plotdf$grad <- ifelse(!is.na(plotdf$chrt_grad) & plotdf$ontime_grad ==1, 1, 0)
plotdf$seamless_transitioners_any <- as.numeric(plotdf$enrl_1oct_ninth_yr1_any == 1 &
                                                 plotdf$ontime_grad == 1)
plotdf$second_year_persisters = as.numeric(plotdf$enrl_1oct_ninth_yr1_any == 1 &
                                             plotdf$enrl_1oct_ninth_yr2_any == 1 &
                                             plotdf$ontime_grad == 1)

# // Step 3: Generate on track indicators that take into account students’ GPAs 
# upon completion of their first year in high school

plotdf$ot <- NA
plotdf$ot[plotdf$ontrack_endyr1 == 0] <- "Off-Track to Graduate"
plotdf$ot[plotdf$ontrack_endyr1 == 1 & plotdf$cum_gpa_yr1 < 3 &
            !is.na(plotdf$cum_gpa_yr1)] <- "On-Track, GPA < 3.0"
plotdf$ot[plotdf$ontrack_endyr1 == 1 & plotdf$cum_gpa_yr1 >= 3 &
            !is.na(plotdf$cum_gpa_yr1)] <- "On-Track, GPA >= 3.0"

# // Step 4: Create indicators for students upon completion of their second 
#  year of high school

plotdf$ot_10 <- NA
plotdf$ot_10[plotdf$ontrack_endyr2 == 0] <- "Off-Track to Graduate"
plotdf$ot_10[plotdf$ontrack_endyr2 == 1 & plotdf$cum_gpa_yr2 < 3 &
               !is.na(plotdf$cum_gpa_yr2)] <- "On-Track, GPA < 3.0"
plotdf$ot_10[plotdf$ontrack_endyr2 == 1 & plotdf$cum_gpa_yr2 >= 3 &
               !is.na(plotdf$cum_gpa_yr2)] <- "On-Track, GPA >= 3.0"
plotdf$ot_10[plotdf$status_after_yr2 == 3 | plotdf$status_after_yr2 == 4] <-
  "Dropout/Disappear"
```

```{r B2reshapeAndFormat}
# // Step 5: Obtain mean rates for each school and append the agency average
onTrackBar <- plotdf %>% group_by(ot, ot_10) %>% 
  select(ot) %>% tally() %>% 
  ungroup %>% group_by(ot) %>%
  mutate(count = sum(n))


# // Step 6: For students who are off-track upon completion of their first year 
#  of high school, convert the values to be negative for ease of visualization 
#  in the graph

onTrackBar <- na.omit(onTrackBar) # drop missing
onTrackBar$n[onTrackBar$ot_10 == "Off-Track to Graduate"] <- 
  -onTrackBar$n[onTrackBar$ot_10 == "Off-Track to Graduate"] 
onTrackBar$n[onTrackBar$ot_10 == "Dropout/Disappear"] <- 
  -onTrackBar$n[onTrackBar$ot_10 == "Dropout/Disappear"] 

```


```{r B2plot}
ggplot(onTrackBar, aes(x = reorder(ot, n/count), 
                         y = n/count, group = ot_10)) + 
  geom_bar(aes(fill = ot_10), stat = 'identity') + 
  geom_text(aes(label = round(100* n/count, 1)), 
            position = position_stack(vjust=0.3)) + 
  theme_bw() + 
  scale_y_continuous(limits = c(-1, 1), label = percent, 
      name = "Percent of Tenth Grade Students \n by Ninth Grade Status") + 
  scale_fill_brewer(name = "End of Tenth Grade \n On-Track Status", 
                    type = "div", palette = 5) + 
  theme(axis.text.x = element_text(color = "black"), 
        legend.position = c(0.15, 0.825)) +
  labs(title = "Proportion of Students On-Track to Graduate by School", 
       x = "Ninth Grade On-Track Status",
       subtitle = "End of Ninth Grade On-Track Status \n By High School", 
       caption = paste0("Sample: 2004-2005 and 2005-2006 Agency first-time ninth
                        graders. \n", 
              "Postsecondary enrollment outcomes from NSC matched records. \n",
                        "All other data from Agency administrative records."))
```


# C: High School Graduation

High school graduation is a critical step to higher education. Understanding
trends and variations in high school completion rates across schools and student
subgroups is essential. These analyses reveal the extent to which high schools
may differentially influence student trajectories towards high school
completion. After identifying these high schools, you may conduct deeper
analyses on your own to explore what drives these outcomes. To begin exploring
high school graduation further, use the analyses below:

 

1. High School Completion Rates By School
2. High School Completion Rates by Average 8th Grade Achievement
3. High School Completion Rates by 8th Grade Achievement Quartiles
4. Racial gaps in completion overall and By 8th Grade Achievement Quartiles
5. Enrollment Outcome in Year 4 by On-Track Status at the End of Ninth Grade


## Task 1: High School Completion Rates By School

**Purpose:** This analysis explores variation in high school completion rates 
across high schools in the system for both on-time and late high school 
graduates.

**Required Analysis File Variables:**

- `sid`
- `chrt_ninth`
- `hs_diploma`
- `ontime_grad`
- `late_grad`
- `first_hs_code`
- `first_hs_name`

**Analysis-Specific Sample Restrictions:** Keep students in ninth
grade cohorts you can observe graduating high school one year late

**Ask Yourself**

- Does the ordering of high school completion rates coincide with beliefs key 
stakeholders have about these high schools?

- Which high schools have the highest and lowest completion rates? Do you know 
why?

**Analytic Technique:** Calculate the proportion of students who complete high 
school by school.

```{r C1filterandSort}

# // Step 1: Keep students in ninth grade cohorts you can observe 
#  graduating high school one year late

plotdf <- filter(cgdata, chrt_ninth >= chrt_ninth_begin_grad_late & 
                   chrt_ninth <= chrt_ninth_end_grad_late) 

```


```{r C1ReshapeCalculate}
# // Step 2: Obtain agency level high school and school level graduation 
#  rates

schoolLevel <- bind_rows(
  plotdf %>% group_by(first_hs_name) %>% 
    summarize(ontime_grad = mean(ontime_grad, na.rm=TRUE), 
              late_grad = mean(late_grad, na.rm=TRUE), 
              count = n()), 
  plotdf %>% ungroup %>%  
    summarize(first_hs_name = "Agency AVERAGE",
              ontime_grad = mean(ontime_grad, na.rm=TRUE), 
              late_grad = mean(late_grad, na.rm=TRUE), 
              count = n())
)

#  // Step 3: Reshape the data wide
schoolLevel <- schoolLevel %>% gather(key = outcome, 
                             value = measure, -count, -first_hs_name)
schoolLevel$first_hs_name <- gsub(" High School", "", schoolLevel$first_hs_name)

#  // Step 4: Recode variables for plotting

schoolLevel$outcome[schoolLevel$outcome == "ontime_grad"] <- "On-Time HS Graduate"
schoolLevel$outcome[schoolLevel$outcome == "late_grad"] <- "Graduate in 4+ Years"
```


```{r C1plot}
#  // Step 5: Plot
ggplot(schoolLevel, aes(x = reorder(first_hs_name, measure), y = measure, 
                        group = first_hs_name, fill = outcome)) + 
  geom_bar(aes(fill = outcome), stat = 'identity') + 
  geom_text(aes(label = round(100 * measure, 0)), 
            position = position_stack(vjust = 0.8)) + 
  theme_bw() + theme(panel.grid = element_blank(), axis.ticks.x = element_blank()) +
  scale_y_continuous(limits = c(0, 1), label = percent, 
                    name = "Percent of Ninth Graders") + 
  scale_fill_brewer(name = "", 
                    type = "qual", palette = 7) + 
  theme(axis.text.x = element_text(color = "black", angle = 30, vjust = 0.5), 
        legend.position = c(0.15, 0.825)) +
  labs(title = "High School Graduation Rates by High School", 
       x = "",
       caption = paste0("Sample: 2004-2005 Agency first-time ninth graders. \n", 
                        "Data from Agency administrative records."))
```

## Task 2: High School Completion Rates by Average 8th Grade Achievement

**Purpose:**  This analysis examines the relationship between academic 
achievement at high school entry and high school completion rates. This 
analysis is useful to identify high schools that beat the odds. High schools 
with similar incoming student achievement profiles but different high school 
graduation rates.


**Required Analysis File Variables:**

- `sid`
- `chrt_ninth`
- `test_math_8_std`
- `hs_diploma`
- `first_hs_code`
- `first_hs_name`

**Analysis-Specific Sample Restrictions:** 

- Keep students in ninth grade cohorts you can observe
graduating high school AND have non-missing eighth grade
math scores.
- Drop any high schools with less than 20 students enrolled in
ninth grade across the cohorts.

**Ask Yourself** 

What might explain differences in high school graduation rates for high schools 
with similar incoming achievement? What might explain differences in incoming
achievement for high schools with similar graduation rates?

**Possible Next Steps or Action Plans:** If substantial variation exists after
controlling for average student achievement at high school entry, think about 
how to share this information across schools. To explore mechanisms that drive
school-level differences in high school completion rates, replicate this 
analysis where the x-axis is a middle school at-risk index (e.g. an index that 
accounts for whether students failed a core class, were chronically absent, and 
other information predictive of student achievement in high school) in place of 
8th grade test scores.

**Analytic Technique:** Bivariate scatterplot of school-level average student 
test scores and high school completion rates.

 

```{r C2filterandSort}

# // Step 1: Keep students in ninth grade cohorts you can observe graduating 
# high school AND have non-missing eighth grade math scores

plotdf <- filter(cgdata, chrt_ninth >= chrt_ninth_begin_grad & 
                   chrt_ninth <= chrt_ninth_end_grad) %>% 
  filter(!is.na(test_math_8_std))

```


```{r C2reshapeandCalculate}
# // Step 2: Obtain agency and school level completion and prior achievement 
#  rates

schoolLevel <- bind_rows(
  plotdf %>% group_by(first_hs_name) %>% 
    summarize(ontime_grad = mean(ontime_grad, na.rm=TRUE), 
              std_score = mean(test_math_8_std, na.rm=TRUE), 
              count = n()), 
  plotdf %>% ungroup %>%  
    summarize(first_hs_name = "Agency AVERAGE",
              ontime_grad = mean(ontime_grad, na.rm=TRUE), 
              std_score = mean(test_math_8_std, na.rm=TRUE), 
              count = n())
  )

# // Step 3: Recode HS Name for display
schoolLevel$first_hs_name <- gsub(" High School", "", schoolLevel$first_hs_name)

```

```{r C2plot}
# // Step 4: Plot
ggplot(schoolLevel[schoolLevel$first_hs_name != "Agency AVERAGE", ], 
       aes(x = std_score, y = ontime_grad)) + 
  geom_vline(xintercept = as.numeric(schoolLevel[schoolLevel$first_hs_name == 
                                                   "Agency AVERAGE", "std_score"]), 
               linetype = 4, color = I("goldenrod"), size = 1.1) +
  geom_hline(yintercept = as.numeric(schoolLevel[schoolLevel$first_hs_name == 
                                                   "Agency AVERAGE", "ontime_grad"]), 
               linetype = 4, color = I("purple"), size = 1.1) +
  geom_point(size = I(2)) + 
  theme_bw() + theme(panel.grid = element_blank()) +
  coord_cartesian() +
  annotate(geom = "text", x = -.85, y = 0.025, 
           label = "Below average math scores & \n below average graduation rates", 
           size = I(2.5)) +
  annotate(geom = "text", x = .85, y = 0.025, 
           label = "Above average math scores & \n below average graduation rates", 
           size = I(2.5)) +
  annotate(geom = "text", x = .85, y = 0.975, 
           label = "Above average math scores & \n above average graduation rates", 
           size = I(2.5)) +
  annotate(geom = "text", x = -.85, y = 0.975, 
           label = "Below average math scores & \n above average graduation rates", 
           size = I(2.5)) + 
  annotate(geom = "text", x = .205, y = 0.025, 
           label = "Agency Average \n Test Score", 
           size = I(2.5), color = I("goldenrod")) + 
  annotate(geom = "text", x = .85, y = 0.61, 
           label = "Agency Average Graduation Rate", 
           size = I(2.5)) + 
  scale_x_continuous(limits = c(-1, 1), breaks = seq(-1, 1, 0.2)) + 
  scale_y_continuous(limits = c(0, 1), label = percent, 
                     name = "Percent of Ninth Graders", breaks = seq(0, 1, 0.1)) + 
  geom_text(aes(label = first_hs_name), nudge_y = 0.065, vjust = "top", size = I(4), 
            nudge_x = 0.01) +
  labs(title = "High School Graduation Rates by High School", 
       x = "Average 8th Grade Math Standardized Score",
       subtitle = "By Student Achievement Profile Upon High School Entry",
       caption = paste0("Sample: 2004-2005 through 2005-2006 Agency first-time ", 
                        "ninth graders with eighth grade math test scores. \n", 
                        "Data from Agency administrative records."))
```


## Task 3: High School Completion Rates by 8th Grade Achievement Quartiles


**Purpose:** This analysis examines variation in completion rates for high 
schools  among students with 8th grade test scores in the same quartile. The 
analysis is useful to explore high school completion rates across schools with 
students in the same quartile or range of achievement. Each high school is 
repeated as a blue bar in each quartile.


**Required Analysis File Variables:**

- `sid`
- `chrt_ninth`
- `test_math_8_std`
- `hs_diploma`
- `first_hs_code`
- `first_hs_name`

**Analysis-Specific Sample Restrictions:**

- Keep students in ninth grade cohorts you can observe
graduating high school AND have non-missing eighth grade
math scores.
- Drop high schools with less than 20 students in each quartile
enrolled in ninth grade across the cohorts.

**Ask Yourself**

- Looking at the average in each quartile (orange bars), how do 8th grade test 
scores relate to high school graduation?
- For each quartile of 8th grade test scores (the blue bars), how do graduation 
rates vary by high school? What is the difference between top and bottom high 
schools in each quartile?

**Possible Next Steps or Action Plans:** Highlight comparison schools to show 
variation across quartiles and explore reasons why students at different 
schools, but with similar academic profiles at high school entry, are more or 
less likely to graduate.

**Analytic Technique:** Calculate the proportion of students, by high school, who 
complete high school and an 8th grade test score quartile for each. 

 

```{r C3filterAndSort}
# // Step 1: Keep students in ninth grade cohorts you can observe graduating 
# high school AND have non-missing eighth grade math scores

plotdf <- filter(cgdata, chrt_ninth >= chrt_ninth_begin_grad & 
                   chrt_ninth <= chrt_ninth_end_grad) %>% 
  filter(!is.na(test_math_8_std))

```

```{r C3reshapeAndRecode}
# // Step 2: btain the agency-level and school level high school graduation 
# rates by test score quartile

schoolLevel <- bind_rows(
  plotdf %>% group_by(qrt_8_math, first_hs_name) %>% 
    summarize(ontime_grad = mean(ontime_grad, na.rm=TRUE), 
              count = n()), 
  plotdf %>% ungroup %>% 
    summarize(first_hs_name = "Agency AVERAGE",
              qrt_8_math = 1,
              ontime_grad = mean(ontime_grad, na.rm=TRUE), 
              count = n())
)

# // Step 3: Recode HS Name for display
schoolLevel$first_hs_name <- gsub(" High School", "", schoolLevel$first_hs_name)

```

```{r C3plot}
# //  Step 4: Create plot template
#  Load library for arranging multiple plots into one
library(gridExtra); library(grid)

# Create a plot template that you can drop different data elements into
p2 <-  ggplot(schoolLevel[schoolLevel$qrt_8_math == 2 & 
                       schoolLevel$first_hs_name != "Agency AVERAGE", ], 
       aes(x = reorder(first_hs_name, ontime_grad), y = ontime_grad)) +
      geom_hline(yintercept =
                   as.numeric(schoolLevel$ontime_grad[schoolLevel$first_hs_name ==
                                                        "Agency AVERAGE"]),
               linetype = 2, size = I(1.1)) +
  geom_bar(stat = "identity", fill = "lightsteelblue4", color = I("black")) + 
    scale_y_continuous(limits = c(0,1), breaks = seq(0, 1, 0.2), 
                       expand = c(0, 0), label = percent) + 
    theme_bw() + 
    theme(panel.grid = element_blank(),
                       axis.text.x = element_text(angle = 30, color = "black", 
                                                  vjust = 0.5, size = 6),
          axis.ticks = element_blank(),
          axis.text.y = element_blank(), axis.line.y = element_blank(), 
          panel.border = element_blank()) +
    labs(y = "", x = "") + 
    geom_text(aes(label = round(ontime_grad * 100, 0)), vjust = -0.2) +
    expand_limits(y = 0, x = 0)

# Step 5: Create four plots, three using the template above and with the legend, 
# put these in a list

grobList <- list(
  ggplot(schoolLevel[schoolLevel$qrt_8_math == 1 & 
                       schoolLevel$first_hs_name != "Agency AVERAGE", ], 
       aes(x = reorder(first_hs_name, ontime_grad), y = ontime_grad)) + 
        geom_hline(yintercept =
                     schoolLevel$ontime_grad[schoolLevel$first_hs_name ==
                                                          "Agency AVERAGE"],
                   linetype = 2, size = I(1.1)) +
  geom_bar(stat = "identity", fill = "lightsteelblue4", color = I("black")) + 
    scale_y_continuous(limits = c(0,1), breaks = seq(0, 1, 0.2), 
                       expand = c(0, 0), label = percent) + 
    theme_bw() + 
    theme(panel.grid = element_blank(),
                       axis.text.x = element_text(angle = 30, size = 6,
                                                  color = "black", vjust = 0.5),
          axis.line.y = element_line(),
          axis.ticks.x = element_blank(),panel.border = element_blank()) +
    labs(y = "Percent of Ninth Graders", x = "") + 
    annotate(geom = "text", x = 5, 
    y = 0.025 + schoolLevel$ontime_grad[schoolLevel$first_hs_name == "Agency AVERAGE"], 
          label = "Agency Average") +
    geom_text(aes(label = round(ontime_grad * 100, 0)), vjust = -0.2) +
    expand_limits(y = 0, x = 0),
  p2, 
  # Use the %+% argument to pass a different data element to the p2 plot template
  p2 %+% schoolLevel[schoolLevel$qrt_8_math == 3 & 
                       schoolLevel$first_hs_name != "Agency AVERAGE", ],
  p2 %+% schoolLevel[schoolLevel$qrt_8_math == 4 & 
                       schoolLevel$first_hs_name != "Agency AVERAGE", ]
)

# Step 6: Apply a label to the bottom of each plot object
wrap <- mapply(arrangeGrob, grobList, 
               bottom = c("Bottom Quartile", "2nd Quartile", 
                          "3rd Quartile", "Top Quartile"), 
               SIMPLIFY=FALSE)

# Step 7: Draw the plot
grid.arrange(grobs=wrap, nrow=1, 
    top = "On-Time High School Graduation Rates \n by Prior Student Achievement", 
    bottom = textGrob(
      label = paste0("Sample: 2004-2005 through 2005-2006 Agency first-time",
      "ninth graders with eighth grade math test scores. \n",
      "Data from Agency administrative records."), 
      gp=gpar(fontsize=10,lineheight=1), just = 1, x = unit(0.99, "npc")))

```

## Task 4: Racial Gaps in Completion Overall and by 8th Grade Achievement Quartiles

**Purpose:** This analysis displays an overall graduation gap by race, and 
examines the extent to which this gap is explained by average differences in 
academic achievement between racial sub-groups at high school entry. The 
analysis is useful to diagnose whether racial gaps in high school result from 
persistent academic achievement gaps that emerge in early grades, or if other 
factors unique to the high school experience drive high school completion rate
differences by race.

**Required Analysis File Variables:**

- `sid`
- `chrt_ninth`
- `test_math_8_std`
- `hs_diploma`
- `first_hs_code`
- `first_hs_name`

**Analysis-Specific Sample Restrictions:**

- Keep students in ninth grade cohorts you can observe
graduating high school AND have non-missing eighth grade
math scores.
- Drop any race/ethnic sub-groups with at least 20 students
in each quartile (for the second graph). You may further
restrict the sample to only include students from the most
representative racial/ethnic sub-groups in your agency.

**Ask Yourself**

- How do racial gaps in graduation rates change after prior achievement is 
accounted for? Do these gaps change for different prior achievement quartiles?

**Possible Next Steps or Action Plans:** Repeat analyses for only students that 
qualify for free or reduced price lunch (FRPL) to explore if racial gaps are 
better explained by disparities in prior academic achievement and family 
socioeconomic status.

**Analytic Technique:** Calculate the proportion of students who complete high 
school by race/ethnicity overall, and by race/ethnicity and 8th grade test 
score quartile.

 

```{r C4filterandSort}
# // Step 1: Keep students in ninth grade cohorts you can observe graduating 
# high school AND have non-missing eighth grade math scores

plotdf <- filter(cgdata, chrt_ninth >= chrt_ninth_begin_grad & 
                   chrt_ninth <= chrt_ninth_end_grad) %>% 
  filter(!is.na(test_math_8_std))

plotdf$race <- as_factor(plotdf$race_ethnicity)
```


```{r C4reshapeRecode}
# // Step 2: Obtain average on-time completion by race for agency
plotOne <- plotdf %>% group_by(race) %>% 
  summarize(ontimeGrad = mean(ontime_grad, na.rm = TRUE), 
            N = n()) %>% ungroup %>% 
  filter(N > 100)

# // Step 3: Obtain average on-time completion by race for agency by 
# math score quartile
plotTwo <- plotdf %>% group_by(race, qrt_8_math) %>% 
  summarize(ontimeGrad = mean(ontime_grad, na.rm=TRUE), 
            N = n()) %>% ungroup %>% 
  filter(race %in% c("Black", "Asian", "Hispanic", "White"))

# // Step 4: Make labels
plotTwo$qrt_label <- NA
plotTwo$qrt_label[plotTwo$qrt_8_math == 1] <- "Bottom Quartile"
plotTwo$qrt_label[plotTwo$qrt_8_math == 2] <- "2nd Quartile"
plotTwo$qrt_label[plotTwo$qrt_8_math == 3] <- "3rd Quartile"
plotTwo$qrt_label[plotTwo$qrt_8_math == 4] <- "Top Quartile"

plotTwo$qrt_label <- factor(plotTwo$qrt_label, 
                            ordered = TRUE, 
                            levels = c("Bottom Quartile", 
                                       "2nd Quartile", 
                                       "3rd Quartile", 
                                       "Top Quartile"))
```

```{r C4plot}
# // Step 5: Plot
ggplot(plotOne, aes( x= reorder(race, -N), y = ontimeGrad, fill = race)) + 
  geom_bar(stat = "identity", color = I("black")) + 
  scale_fill_brewer(type = "qual", palette = 4, guide = "none") + 
  geom_text(aes(label = round(ontimeGrad*100, 0)), vjust = -0.4) + 
  theme_bw() + theme(panel.grid = element_blank(), panel.border = element_blank(),
                     axis.line = element_line()) + 
  scale_y_continuous(limits = c(0, 1), expand = c(0, 0), 
                     breaks = seq(0, 1, 0.2), name = "Percent of Ninth Graders", 
                     label = percent) + 
  labs(x = "", title = "On-Time High School Graduation Rates",
       subtitle = "by Race", 
       caption = paste0(
         "Sample: 2004-2005 through 2005-2006 Agency first-time ninth graders. \n", 
         "All data from Agency administrative records."))

ggplot(plotTwo, aes( x = qrt_label, 
                     group= reorder(race, -N), y = ontimeGrad, fill = race)) + 
  geom_bar(stat = "identity", color = I("black"), position = "dodge") + 
  scale_fill_brewer(type = "qual", palette = 4) + 
  guides(fill = guide_legend(nrow=1, title = "", keywidth = 2)) +
  geom_text(aes(label = round(ontimeGrad*100, 0)), position = position_dodge(0.9), vjust = -0.3) + 
  theme_bw() + theme(panel.grid = element_blank(), panel.border = element_blank(),
                     axis.line = element_line(), legend.position = "top") + 
  scale_y_continuous(limits = c(0, 1), expand = c(0, 0), 
                     breaks = seq(0, 1, 0.2), name = "Percent of Ninth Graders", 
                     label = percent) + 
  labs(x = "", title = "On-Time High School Graduation Rates",
       subtitle = "by Race", 
       caption = paste0(
         "Sample: 2004-2005 through 2005-2006 Agency first-time ninth graders. \n ", 
         "All data from Agency administrative records."))

  
```

## Task 5: Enrollment Outcome in Year Four By On-Track Status At the End of Ninth Grade

**Purpose:** This analysis explores how strongly student performance in ninth grade 
predicts high school graduation three years later. Building upon our analysis 
of the relationship between student performance in ninth and tenth grade, the 
analysis assesses the utility of using course-level performance data early in 
students’ high school careers to assess risk of non-completion, and target 
students in need of academic and/or socio-emotional support.


**Required Analysis File Variables:**

- `sid`
- `chrt_ninth`
- `ontrack_grad_hs_sample*`
- `ontrack_endyr1*`
- `cum_gpa_yr1*`
- `status_after_yr4*`

**Analysis-Specific Sample Restrictions:**
- Keep students in ninth grade cohorts you can observe
graduating high school AND are part of the on-track sample
(attended the first semester of ninth grade and never transferred
into or out of the system).

**Ask Yourself**
- How does on-track status at the end of ninth grade relate to high school 
completion status at the end of four years?

**Possible Next Steps or Action Plans:** Repeat analyses for only students that 
qualify for free or reduced price lunch (FRPL) to explore whether racial gaps 
are better explained by disparities in prior academic achievement and family
socioeconomic status.

**Analytic Technique:** Calculate the proportion of students who graduate high 
school within four years, dropout, remain enrolled in high school for a fifth 
year, etc. based on on-track status upon completion of ninth grade.

 

```{r C5filterandsort}
# // Step 1: Keep students in ninth grade cohorts you can observe graduating 
# high school AND have non-missing eighth grade math scores AND are part of 
# the on-track sample
plotdf <- filter(cgdata, chrt_ninth >= chrt_ninth_begin_grad & 
                   chrt_ninth <= chrt_ninth_end_grad)  %>% 
  filter(!is.na(cum_gpa_yr1)) %>% 
  filter(ontrack_sample == 1)

# // Step 2: Recode status variables
plotdf$statusVar <- as_factor(plotdf$status_after_yr4)

# // Step 3: Generate on-track indicators that take into account students' 
# GPA upon completion of their first year in high school
plotdf$ontrackStatus <- NA
plotdf$ontrackStatus[plotdf$ontrack_endyr1 == 0] <- "Off-Track to Graduate"
plotdf$ontrackStatus[plotdf$ontrack_endyr1 == 1 & plotdf$cum_gpa_yr1 < 3 &
                       !is.na(plotdf$cum_gpa_yr1)] <- "On-Track, GPA < 3.0"
plotdf$ontrackStatus[plotdf$ontrack_endyr1 == 1 & plotdf$cum_gpa_yr1 >= 3 &
                       !is.na(plotdf$cum_gpa_yr1)] <- "On-Track, GPA >= 3.0"
```

```{r C5reshape}
# // Step 4: Create average outcomes by on-track status at the end of ninth grade
plotOne <- plotdf %>% group_by(ontrackStatus, statusVar) %>% 
  summarize(count = n()) %>% ungroup %>%
  group_by(ontrackStatus) %>% 
  mutate(sum = sum(count))

# // Step 5: Recode negative values for dropped out and disappeared

plotOne$count[plotOne$statusVar == "Dropped Out"] <- 
  -plotOne$count[plotOne$statusVar == "Dropped Out"]
plotOne$count[plotOne$statusVar == "Disappeared"] <- 
  -plotOne$count[plotOne$statusVar == "Disappeared"]  
plotOne$statusVar <- ordered(plotOne$statusVar, 
                             c("Graduated On-Time", "Enrolled, Not Graduated", 
                               "Disappeared", "Dropped Out"))
```

```{r C5plot}
ggplot(plotOne, aes(x = ontrackStatus, y = count/sum, fill = statusVar, 
                    group = statusVar)) + 
  geom_bar(stat="identity") + 
  geom_text(aes(label = round((count/sum) * 100, digits = 0))) + 
  scale_fill_brewer(type = "div", palette=7, direction = -1) + 
  geom_hline(yintercept = 0, size =1.1) + 
  scale_y_continuous(limits = c(-0.6, 1), label = percent, 
                     breaks = seq(-0.6, 1, 0.2), name = "Percent of Students") + 
  labs(x = "Ninth Grade On-Track Status", fill = "Status After Year Four", 
       title = "Enrollment Status After Four Years in High School", 
       subtitle = "By Course Credits and GPA after First Year of High School", 
       caption = paste0("Sample: 2004-2005 through 2005-2006 Agency", 
                        " first-time ninth graders. \n", 
                        "Students who transferred into or out of the agency are", 
                        " excluded from the sample. \n",
                        "All data from Agency administrative records.")) + 
  theme_classic() + theme(legend.position = c(0.8, 0.2),
                          axis.text = element_text(color = "black")) 
```

# D: College Enrollment

Given the substantial economic and social benefits of a college degree, 
understanding a high schools’ role in preparing students to persist through 
college is essential. This section provides a series of analyses that highlight
college-going rates across high schools in your agency. You will consider 
whether high school graduates enroll in colleges and universities well-aligned 
to their  incoming academic qualifications. This is one factor that may increase 
a students’ likelihood of college persistence and degree attainment.

To explore these questions, consider the following model analyses:

1. College Enrollment Rates by High School
2. Seamless and Delayed College Enrollment Rate by High School
3. College Enrollment Rates by Average 8th Grade Achievement
4. College Enrollment Rates by 8th Grade Achievement Quantiles
5. Rates of Non-Enrollment Among Graduates Highly Qualified to Attend Four-Year
Colleges

The following three analyses in College Enrollment include the three Strategic
Performance Indicators (SPIs) SDP has released to provide deeper insight into 
the college-going performance of educational systems. These SPIs were conducted 
using data from a number of SDP's partner agencies. This section of Analyze 
will help you conduct these analyses yourself. You can read more about the SPIs 
at [sdp.cepr.harvard.edu/spi](http://sdp.cepr.harvard.edu/spi).

6. Gaps in Rates of College Enrollment Between Latino High School Graduates and 
White High School Graduates
7. College Enrollment Rates by 8th Grade Achievement Quartiles
8. Undermatch Rates Among Highly Qualified High School Graduates

## Task 1: College Enrollment Rates by High School

**Purpose:** This analysis provides an agency snapshot of college enrollment 
to understand how patterns of college going for high school graduates vary 
across high schools. By illuminating the extent to which enrollment varies by 
entry time for seamless enrollers and college level (2- vs. 4-year), the 
analysis helps diagnose compositional differences for the college-bound 
population by high school attended.

**Required Analysis File Variables:**

- `sid`
- `chrt_grad` 
- `enrl_1oct_grad_yr1_any`
- `enrl_1oct_grad_yr1_2yr`
- `enrl_1oct_grad_yr1_4yr`
- `enrl_ever_w2_grad_2yr`
- `enrl_ever_w2_grad_4yr`
- `hs_diploma`
- `last_hs_code`
- `last_hs_name`

**Analysis-Specific Sample Restrictions:**

- Keep students in high school graduation cohorts you can observe enrolling in 
college the fall after graduation.
- Drop any high schools with less than 20 students in the sample.
- Include only graduates who received regular or advanced diplomas (i.e. 
exclude students who received SPED diplomas and other certificates).

**Ask Yourself**
- How do college enrollment rates differ by high schools? Why might certain 
schools have a greater percentage of high school graduates enrolling in college? 
Do certain schools have higher percentages of 2-year or delayed college enrollers?

**Possible Next Steps or Action Plans:** Replicate this analysis to include 
all first-time ninth graders (i.e. ninth grade cohorts) in place of graduates.
Additionally, create individual high school reports that provide more details 
for school administrators (top enrolling institutions of the school’s graduates).

**Analytic Technique:** Calculate the proportion of students who enroll in college 
by high school.

 

```{r D1filterAndSort}
# // Step 2: Keep students in high school graduation cohorts you can observe 
# enrolling in college the fall after graduation
plotdf <- cgdata %>% filter(chrt_grad >= chrt_grad_begin & 
                              chrt_grad <= chrt_grad_end)
```


```{r D1reshapeAndRecode}
# // Step 3: Obtain the agency-level and school averages for seamless enrollment

chartData <- 
  bind_rows(plotdf %>% select(last_hs_name, enrl_1oct_grad_yr1_2yr,
                              enrl_1oct_grad_yr1_4yr, hs_diploma) %>%
              group_by(last_hs_name) %>% 
              summarize_all(funs(sum), na.rm=TRUE),
  plotdf %>% select(enrl_1oct_grad_yr1_2yr, enrl_1oct_grad_yr1_4yr, 
                               hs_diploma) %>% 
    summarize_all(funs(sum), na.rm=TRUE) %>% 
    mutate(last_hs_name = "Agency AVERAGE")
  )

# // Step 4: Reshape agency data for plotting
chartData <- chartData %>% gather(key = outcome, 
                             value = measure, -last_hs_name, -hs_diploma)

# // Step 5: Calculate rates
chartData %<>% group_by(last_hs_name) %>% 
  mutate(enroll_any = sum(measure) / hs_diploma[1]) %>% 
  ungroup

# // Step 6: Recode variables
chartData$last_hs_name <- gsub("High School", "", chartData$last_hs_name)
# Split levels
chartData$last_hs_name <- gsub(" ", "\n", chartData$last_hs_name)
chartData$outcome[chartData$outcome == "enrl_1oct_grad_yr1_2yr"] <- 
  "2-yr Seamless Enroller"
chartData$outcome[chartData$outcome == "enrl_1oct_grad_yr1_4yr"] <- 
  "4-yr Seamless Enroller"



```

```{r D1plot}
ggplot(chartData, aes(x = reorder(last_hs_name, enroll_any), 
                      y = measure/hs_diploma, 
                      fill = outcome, group = outcome)) + 
  geom_bar(stat = "identity", position = "stack", color = I("black")) + 
  geom_text(aes(label = round(100 * measure/hs_diploma)), 
            position = position_stack(vjust = 0.5)) +
  geom_text(aes(label = round(100 * enroll_any), y = enroll_any), 
            vjust = -0.5, color = I("gray60")) +
  theme_classic() + 
  scale_y_continuous(limits = c(0, 1), breaks = seq(0, 1, 0.2), 
                     expand = c(0,0),
                     label = percent) + 
  scale_fill_brewer(name = "", type = "qual", palette = 1) +
  labs(x = "", y = "Percent of High School Graduates", 
       title = "College Enrollment by High School", 
       subtitle = "Seamless Enrollers", 
       caption = paste0(
         "Sample: 2007-2008 through 2008-2009 Agency graduates.",
         "Postsecondary enrollment outcomes from NSC matched records.", 
         "\n All other data from administrative records.")) + 
  theme(axis.text.x = element_text(angle = 30, vjust = 0.8, color = "black"), 
        legend.position = c(0.1, 0.8), axis.ticks.x = element_blank())


```

## Task 2: Seamless and Delayed College Enrollment Rates by High School

**Purpose:** This analysis provides an agency snapshot of college enrollment 
to understand how patterns of college going for high school graduates vary 
across high schools. By illuminating the extent to which enrollment varies by 
entry time (seamless vs. delayed) and college level (2- vs. 4-year), the 
analysis helps diagnose compositional differences for the college-bound 
population by high school attended.


**Required Analysis File Variables:**

- `sid`
- `chrt_grad` 
- `enrl_1oct_grad_yr1_any`
- `enrl_1oct_grad_yr1_2yr`
- `enrl_1oct_grad_yr1_4yr`
- `enrl_ever_w2_grad_2yr`
- `enrl_ever_w2_grad_4yr`
- `hs_diploma`
- `last_hs_code`
- `last_hs_name`

**Analysis-Specific Sample Restrictions:**

- Keep students in high school graduation cohorts you can
observe enrolling in college the fall after graduation.
- Drop any high schools with less than 20 students in the
sample.
- Include only graduates who received regular or advanced
diplomas (i.e. exclude students who received SPED diplomas
and other certificates).

**Ask Yourself**

- How do college enrollment rates differ by high schools? Why might certain 
schools have a greater percentage of high school graduates enrolling in 
college? Do certain schools have higher percentages of 2-year or delayed 
college enrollers?

**Possible Next Steps or Action Plans:** Replicate this analysis to include 
all first-time ninth graders (i.e. ninth grade cohorts) in place of graduates.
Additionally, create individual high school reports that provide more details 
for school administrators (top enrolling institutions of the school’s graduates).

**Analytic Technique:** Calculate the proportion of graduates who enroll in 
four-year institutions across high schools according to the selectivity ranking 
of the postsecondary institutions attended.

 

```{r D2filterAndSort}
# // Step 1: Keep students in high school graduation cohorts you can observe 
# enrolling in college the fall after graduation

plotdf <- cgdata %>% filter(chrt_grad >= chrt_grad_begin & 
                              chrt_grad <= chrt_grad_end) %>% 
  select(sid, chrt_grad, enrl_1oct_grad_yr1_2yr, enrl_1oct_grad_yr1_4yr,
         enrl_1oct_grad_yr1_any, enrl_ever_w2_grad_2yr, enrl_ever_w2_grad_any,
         enrl_ever_w2_grad_4yr, hs_diploma, last_hs_code, last_hs_name)

```

```{r D2reshapeAndRecode}
# // Step 2: Create binary outcomes for late enrollers
plotdf$late_any <- ifelse(plotdf$enrl_1oct_grad_yr1_any == 0 & 
                            plotdf$enrl_ever_w2_grad_any == 1, 1, 0)
plotdf$late_4yr <- ifelse(plotdf$enrl_1oct_grad_yr1_any == 0 & 
                            plotdf$enrl_ever_w2_grad_4yr == 1, 1, 0)
plotdf$late_2yr <- ifelse(plotdf$enrl_1oct_grad_yr1_any == 0 & 
                            plotdf$enrl_ever_w2_grad_2yr == 1, 1, 0)

# // Step 3: Obtain the agency and school average for seamless and 
# delayed enrollment

chartData <-  bind_rows(
  plotdf %>% select(last_hs_name, enrl_1oct_grad_yr1_2yr, 
                              enrl_1oct_grad_yr1_4yr, late_4yr, late_2yr,
                              hs_diploma) %>%
              group_by(last_hs_name) %>% 
              summarize_all(funs(sum), na.rm=TRUE),
  plotdf %>% select(enrl_1oct_grad_yr1_2yr, 
                              enrl_1oct_grad_yr1_4yr, late_4yr, late_2yr,
                              hs_diploma) %>% 
    summarize_all(funs(sum), na.rm=TRUE) %>% 
    mutate(last_hs_name = "Agency AVERAGE")
  )

# // Step 4: Reshape for plotting

chartData <- chartData %>% gather(key = outcome, 
                             value = measure, -last_hs_name, -hs_diploma)

# // Step 5: Generate percentages of high school grads attending college. 

chartData %<>% group_by(last_hs_name) %>% 
  mutate(enroll_any = sum(measure) / hs_diploma[1]) %>% 
  ungroup

# // Step 6: Recode values for plotting
chartData$last_hs_name <- gsub("High School", "", chartData$last_hs_name)
chartData$last_hs_name <- gsub(" ", "\n", chartData$last_hs_name)
chartData$outcome[chartData$outcome == "enrl_1oct_grad_yr1_2yr"] <- "2-yr Seamless"
chartData$outcome[chartData$outcome == "enrl_1oct_grad_yr1_4yr"] <- "4-yr Seamless"
chartData$outcome[chartData$outcome == "late_2yr"] <- "2-yr Delayed"
chartData$outcome[chartData$outcome == "late_4yr"] <- "4-yr Delayed"

```

```{r D2Plot}
# // Step 7: Plot
ggplot(chartData, aes(x = reorder(last_hs_name, enroll_any), 
                      y = measure/hs_diploma, 
                      fill = outcome, group = outcome)) + 
  geom_bar(stat = "identity", position = "stack", color = I("black")) + 
  geom_text(aes(label = round(100 * measure/hs_diploma)), 
            position = position_stack(vjust = 0.5)) +
  geom_text(aes(label = round(100 * enroll_any), y = enroll_any), 
            vjust = -0.5, color = I("gray60")) +
  theme_classic() + 
  scale_y_continuous(limits = c(0, 1), breaks = seq(0, 1, 0.2), 
                     expand = c(0,0),
                     label = percent) + 
  scale_fill_brewer(name = "", type = "seq", palette = "YlGnBu") +
  labs(x = "", y = "Percent of High School Graduates", 
       title = "College Enrollment by High School", 
       subtitle = "Seamless and Delayed Enrollers", 
       caption = paste0("Sample: 2007-2008 through 2008-2009 Agency graduates.",
                        "Postsecondary enrollment outcomes from NSC matched records.", 
                        "\n All other data from administrative records.")) + 
  theme(axis.text.x = element_text(angle = 30, vjust = 0.8, color = "black"), 
        legend.position = c(0.1, 0.8), axis.ticks.x = element_blank())

```

## Task 3: College Enrollment Rates by Average 8th Grade Achievement

**Purpose:** This analysis displays variations in college enrollment rates across 
high schools by examining the extent to which academic achievement at high 
school entry explains variation in college going across high schools. This 
analysis is useful to identify high schools with similar incoming student 
achievement profiles but divergent college enrollment rates; or on the other 
hand, high schools with similar college-going rates but different academic 
performance at high school entry. 

**Required Analysis File Variables:**

- `sid`
- `chrt_grad` 
- `enrl_1oct_grad_yr1_any`
- `test_math_8_std`
- `last_hs_code`
- `last_hs_name`

**Analysis-Specific Sample Restrictions:**

- Keep students in high school graduation cohorts you can observe enrolling in 
college the fall after graduation AND have non-missing eighth grade test scores.
- Include only graduates who received regular or advanced diplomas (i.e. 
exclude students who received SPED diplomas and other certificates).

**Ask Yourself**
- What might explain variation in college enrollment rates for high schools 
with similar incoming achievement? What might explain variation in incoming 
achievement for high schools with similar college enrollment rates?

**Possible Next Steps or Action Plans:** Repeat this analysis to include all 
first-time ninth graders (i.e. ninth grade cohorts) in place of graduates, 
and explore college enrollment within two years of high school completion. 
Additionally, replicate this analysis to explore the relationship between 
college enrollment and students’ ELA achievement at high school entry. Consider 
why schools with similar incoming student profiles may report dramatically 
different college-going rates. Conversely, consider why schools with dissimilar 
student bodies report similar matriculation rates to college.

**Analytic Technique:** Bivariate scatterplot of school-level average student 
test scores and college enrollment rates.

 

```{r D3FilterAndSort}
# // Step 2: Keep students in high school graduation cohorts you can observe 
# enrolling in college the fall after graduation AND have non-missing eighth 
# grade math scores

plotdf <- cgdata %>% filter(chrt_grad >= chrt_grad_begin & 
                              chrt_grad <= chrt_grad_end) %>% 
  select(sid, chrt_grad, enrl_1oct_grad_yr1_any, test_math_8_std,
         last_hs_name) %>% 
  filter(!is.na(test_math_8_std))

```

```{r D3reshapeAndCalculate}
# // Step 2: Obtain agency-level college enrollment rate and prior 
# achievement score for dotted lines. Also get position of their labels

AGENCYLEVEL <- plotdf %>% 
  summarize(agency_mean_enroll = mean(enrl_1oct_grad_yr1_any, na.rm=TRUE), 
            agency_mean_test = mean(test_math_8_std)) %>% 
  as.data.frame

# // Step 3: Obtain school-level college enrollment rates and prior 
# achievement scores
chartData <- plotdf %>% group_by(last_hs_name) %>% 
  summarize(math_test = mean(test_math_8_std), 
            enroll_rate = mean(enrl_1oct_grad_yr1_any, na.rm=TRUE), 
            count = n())
# // Step 4: Shorten HS name for plotting
chartData$last_hs_name <- gsub("High School", "", chartData$last_hs_name)
chartData$last_hs_name <- gsub(" ", "\n", chartData$last_hs_name)
```


```{r D3plot}

# // Step 5: Plot
ggplot(chartData, aes(x = math_test, y = enroll_rate)) + 
  geom_point() + geom_text(aes(label = last_hs_name), 
                           nudge_x = -0.02, nudge_y= 0.02, angle = 30,
                           check_overlap = FALSE) +
  theme_classic() + 
  geom_hline(yintercept = AGENCYLEVEL$agency_mean_enroll, linetype = 2, 
             size = I(1.1), color = I("slateblue")) +
  geom_vline(xintercept = AGENCYLEVEL$agency_mean_test, linetype = 2, 
             size = I(1.1), color = I("goldenrod")) +
  scale_y_continuous(limits = c(0,1), breaks = seq(0, 1, 0.2), label = percent) + 
  scale_x_continuous(limits = c(-0.8, 1), breaks = seq(-0.8, 1, 0.2)) + 
  annotate(geom = "text", x = -.675, y = 0.025, 
           label = "Below average math scores & \n below average college enrollment", 
           size = I(2.5)) +
  annotate(geom = "text", x = .88, y = 0.025, 
           label = "Above average math scores & \n below average college enrollment", 
           size = I(2.5)) +
  annotate(geom = "text", x = .88, y = 0.975, 
           label = "Above average math scores & \n above average college enrollment", 
           size = I(2.5)) +
  annotate(geom = "text", x = -.675, y = 0.975, 
           label = "Below average math scores & \n above average college enrollment", 
           size = I(2.5)) + 
  annotate(geom = "text", x = .255, y = 0.125, 
           label = "Agency Average \n Test Score", 
           size = I(2.5), color = I("goldenrod")) + 
  annotate(geom = "text", x = -.675, y = 0.71, 
           label = "Agency Average \nCollege Enrollment Rate", 
           size = I(2.5)) + 
  labs(x = "Percent of High School Graduates", 
       y = "Average 8th Grade Math Standardized Score", 
       title = "College Enrollment Rates by Prior Student Achievement",
       subtitle = "Seamless Enrollers", 
       caption = paste0("Sample: 2007-2008 through 2008-2009 Agency graduates. Postsecondary", 
                        " enrollment outcomes from NSC matched records. \n ", 
                        "All other data from administrative records.")) + 
  theme(axis.text = element_text(color="black", size = 12))


```

## Task 4: College Enrollment Rates by 8th Grade Achievement Quartiles

**Purpose:** This analysis explores whether variation in college enrollment 
across high schools is similar among low-, middle, and top-achieving students. 
It also considers whether overall variation across schools derives from 
concentrated divergence among students scoring in a particular achievement 
range. Additionally, the analysis facilitates granular school-to-school 
comparisons to identify those especially under-, or over-performing within 
each achievement quartile. Finally, the analysis also helps identify which 
student subgroups require additional resources and support within each school. 


**Required Analysis File Variables:**

- `sid`
- `chrt_grad` 
- `enrl_1oct_grad_yr1_any`
- `qrt_8_math_std`
- `last_hs_code`
- `last_hs_name`

**Analysis-Specific Sample Restrictions:**

- Keep students in high school graduation cohorts you can observe enrolling in 
college the fall after graduation AND have non-missing eighth grade test scores.
- Drop high schools with less than 20 students in each quartile enrolled in 
ninth grade across the cohorts. 
- Keep only graduates who received regular or advanced diplomas (i.e. exclude 
students who received SPED diplomas and other certificates).

**Ask Yourself**

- After looking at the average in each quartile (the orange bars), how do 8th 
grade test scores relate to college enrollment? Within each quartile of 8th 
grade test scores (the blue bars), how do enrollment rates vary by high school? 
What is the difference between top and bottom performing high schools in each 
quartile?

**Possible Next Steps or Action Plans:** Repeat this analysis to include all 
first-time ninth graders (i.e. ninth grade cohorts) in place of graduates, and 
explore college enrollment within two years of high school completion. 
Additionally, replicate this analysis to explore the relationship between 
college enrollment and students’ ELA achievement at high school entry. Consider 
why schools with similar incoming student profiles may report dramatically 
different college-going rates. Conversely, consider why schools with distinct 
student bodies may report similar matriculation rates to college.

**Analytic Technique:** Calculate the proportion of graduates who enrolled in 
college by October 1st following their high school graduation year by high 
school and 8th grade test score quartile.


```{r D4filterAndSort}
# // Step 1: Keep students in high school graduation cohorts you can observe 
# enrolling in college the fall after graduation AND have non-missing eighth 
# grade math scores

plotdf <- cgdata %>% filter(chrt_grad >= chrt_grad_begin & 
                              chrt_grad <= chrt_grad_end) %>% 
  select(sid, chrt_grad, enrl_1oct_grad_yr1_any, qrt_8_math,
         last_hs_name) %>% 
  filter(!is.na(qrt_8_math))
```

```{r D4reshapeAndCalculate}
# // Step 2: Obtain the overall agency-level high school graduation rate for 
# dotted line along with the position of its label
AGENCYLEVEL <- plotdf %>% 
  summarize(agency_mean_enroll = mean(enrl_1oct_grad_yr1_any, na.rm=TRUE)) %>% 
  as.data.frame

# // Step 5: Obtain school-level and agency level college enrollment rates by 
# test score quartile and append the agency-level enrollment rates 
# by quartile
chartData <- bind_rows(
  plotdf %>% group_by(last_hs_name, qrt_8_math) %>% 
  summarize(enroll_rate = mean(enrl_1oct_grad_yr1_any, na.rm=TRUE), 
            count = n()),
  plotdf %>% group_by(qrt_8_math) %>% 
  summarize(enroll_rate = mean(enrl_1oct_grad_yr1_any, na.rm=TRUE), 
            count = n(), 
            last_hs_name = "Agency AVERAGE")
)

# // Step 6: Recode HS Name for plotting
chartData$last_hs_name <- gsub("High School", "", chartData$last_hs_name)
# chartData$last_hs_name <- gsub(" ", "\n", chartData$last_hs_name)
```

```{r D4plot}
# // Step 7: Make plot for first panel with legend and labels

p1 <- ggplot(chartData[chartData$qrt_8_math == 1, ], 
       aes(x = reorder(last_hs_name, enroll_rate), y = enroll_rate)) + 
        geom_hline(yintercept = as.numeric(AGENCYLEVEL$agency_mean_enroll),
               linetype = 2, size = I(1.1)) +
  geom_bar(stat = "identity", fill = "lightsteelblue4", color = I("black")) + 
    scale_y_continuous(limits = c(0,1), breaks = seq(0, 1, 0.2), 
                       expand = c(0, 0), label = percent) + 
    theme_bw() + 
  annotate(geom = "text", x = 6, y = 0.775, label = "Agency Average") +
    theme(panel.grid = element_blank(),
                       axis.text.x = element_text(angle = 30, size=6,
                                                  color = "black", vjust = 0.5),
          axis.line.y = element_line(),  axis.line.x = element_line(),
          axis.ticks.x = element_blank(),panel.border = element_blank()) +
    labs(y = "Percent of Ninth Graders", x = "") + 
    geom_text(aes(label = round(enroll_rate * 100, 0)), vjust = -0.2) +
    expand_limits(y = 0, x = 0)

# // Step 8 : Make Template for following 3 panels with fewer legends and 
# labels

p2 <-  ggplot(chartData[chartData$qrt_8_math == 2, ], 
       aes(x = reorder(last_hs_name, enroll_rate), y = enroll_rate)) +
      geom_hline(yintercept = as.numeric(AGENCYLEVEL$agency_mean_enroll),
               linetype = 2, size = I(1.1)) +
  geom_bar(stat = "identity", fill = "lightsteelblue4", color = I("black")) + 
    scale_y_continuous(limits = c(0,1), breaks = seq(0, 1, 0.2), 
                       expand = c(0, 0), label = percent) + 
    theme_bw() + 
    theme(panel.grid = element_blank(),
                       axis.text.x = element_text(angle = 30, size=6,
                                                  color = "black", vjust = 0.5),
          axis.ticks = element_blank(), axis.line.x = element_line(),
          axis.text.y = element_blank(), axis.line.y = element_blank(), 
          panel.border = element_blank()) +
    labs(y = "", x = "") + 
    geom_text(aes(label = round(enroll_rate * 100, 0)), vjust = -0.2) +
    expand_limits(y = 0, x = 0)

# schoolLevel$order <-

# // Step 9: Combine first plot with template applied to quartiles 2, 3, and 4
# Use %+% operator to replace the data in the plot template with another data
# set
grobList <- list(
  p1,
  p2, 
  p2 %+% chartData[chartData$qrt_8_math == 3, ],
  p2 %+% chartData[chartData$qrt_8_math == 4, ]
)

# // Step 10: Apply quartile labels to each panel
wrap <- mapply(arrangeGrob, grobList, 
               bottom = c("Bottom Quartile", "2nd Quartile", 
                          "3rd Quartile", "Top Quartile"), 
               SIMPLIFY=FALSE)

# // Step 11: Plot with labels
grid.arrange(grobs=wrap, nrow=1, 
             top = paste0("College Enrollment Rates ", 
                          "\n by Prior Student Achievement, Seamless Enrollers Only"), 
             bottom = textGrob(label = paste0(
               "Sample: 2007-2008 through 2008-2009.",
               "Agency graduates with eighth grade math scores. \n", 
               "Postsecondary enrollment outcomes from NSC matched records. \n", 
               "All other data from Agency administrative records."
               ), gp=gpar(fontsize=10,lineheight=1), just = 1, 
               x = unit(0.99, "npc")))
```

## Task 5: Rates of College Enrollment by College Type Among Highly Qualified Graduates

**Purpose:** Research consistently finds wide variation in rates of persistence 
and completion across postsecondary institutions. This analysis examines 
whether high school graduates enroll in colleges and universities that provide 
the right academic fit to maximize their chances of completion. "Match"describes 
the extent high school graduates with strong academic records attend colleges
and universities that allow them to take advantage of their ambition and 
abilities. While "matching" to an appropriately selective college is only one 
factor to consider when choosing a postsecondary institution, the implications 
of under-matching (i.e. lower rates of persistence and degree completion) 
suggest students should be encouraged to attend realistic, yet challenging 
postsecondary institutions. 

**Required Analysis File Variables:**

- `sid`
- `race_ethnicity`
- `chrt_grad` 
- `highly_qualified`
- `enrl_1oct_grad_yr1_any`
- `enrl_1oct_grad_yr1_4yr`
- `enrl_1oct_grad_yr1_2yr`

**Analysis-Specific Sample Restrictions:**

- Keep students in high school graduation cohorts you can
observe enrolling in college the fall after graduation.
- Include only graduates who received regular or advanced
diplomas (i.e. exclude students who received SPED diplomas
and other certificates).
- Include only highly qualified high school graduates (i.e.
students who have obtained a high school diploma on time
with 1) a cumulative GPA of 3.0 or higher and Math/Verbal
SAT score of 1300 or higher, or 2) a cumulative GPA of 3.3 or
higher and Math/Verbal SAT score of 1200 or higher, or 3) a
cumulative GPA of 3.7 or higher and Math/Verbal SAT score
of at least 1100).
- Drop race/ethnic groups with less than 20 students eligible
to attend a four-year university.

**Ask Yourself**

- Among highly qualified students, which race/ethnicities seem to face the 
greatest undermatch rates?

**Possible Next Steps or Action Plans:** This analysis leads to important 
questions that warrant further exploration. What factors drive undermatch 
differences across student subgroups and high schools? To what extent is 
undermatching concentrated among first-time college-goers? To what extent is
undermatching driven by students’ proximity to 2-year versus 4-year 
institutions? What college aspirations do incoming ninth graders hold, and do 
these aspirations change by the time they enter or complete 12th grade? To 
what extent are teachers, counselors, and administrators supported to work with
students to cultivate postsecondary aspirations and weigh factors in the college
selection process?

**Analytic Technique:** Calculate the proportion of highly qualified graduates 
who do not enroll in college, enroll in 2-year college, and enroll in least 
competitive and unranked 4-year colleges the fall following high school 
graduation.

 

```{r D5filterAndSort}
# // Step 1: Keep students in high school graduation cohorts you can observe 
# enrolling in college the fall after graduation

plotdf <- cgdata %>% filter(chrt_grad >= chrt_grad_begin & 
                              chrt_grad <= chrt_grad_end) %>% 
  select(sid, chrt_grad, race_ethnicity, highly_qualified, 
         enrl_1oct_grad_yr1_any, enrl_1oct_grad_yr1_4yr, enrl_1oct_grad_yr1_2yr)

# Use race_ethnicity as a labeled factor for plotting
plotdf$race_ethnicity <- as_factor(plotdf$race_ethnicity)
# // Step 2: Take total of all students in sample
totalCount <- nrow(plotdf)
```

```{r D5recodeAndReshape}
# // Step 3: Create "undermatch" outcomes
plotdf$no_college <- ifelse(plotdf$enrl_1oct_grad_yr1_any == 0, 1, 0)
plotdf$enrl_2yr <- ifelse(plotdf$enrl_1oct_grad_yr1_2yr == 1, 1, 0)
plotdf$enrl_4yr <- ifelse(plotdf$enrl_1oct_grad_yr1_4yr == 1, 1, 0)

# // Step 3: Create agency-level outcomes for total undermatching rates
agencyLevel <- plotdf %>% filter(highly_qualified == 1) %>% 
  summarize(no_college = mean(no_college, na.rm=TRUE), 
            enrl_2yr = mean(enrl_2yr, na.rm=TRUE), 
            enrl_4yr = mean(enrl_4yr, na.rm=TRUE), 
            total_count = n(), 
            race_ethnicity = "TOTAL")

# // Step 4: Create race/ethnicity-level outcomes for undermatching rates by 
# race/ethnicity
chartData <- plotdf %>% filter(highly_qualified == 1) %>% 
  group_by(race_ethnicity) %>%
  summarize(no_college = mean(no_college, na.rm=TRUE), 
            enrl_2yr = mean(enrl_2yr, na.rm=TRUE), 
            enrl_4yr = mean(enrl_4yr, na.rm=TRUE), 
            total_count = n())

chartData <- bind_rows(chartData, agencyLevel)

# // Step 5: Convert negative outcomes to negative values and reshape 
# data for plotting
chartData$no_college <- -chartData$no_college
chartData$enrl_2yr <- -chartData$enrl_2yr
chartData <- chartData %>% gather(key = outcome, value = measure, 
                                  -race_ethnicity, -total_count)

# // Step 7: Convert to percentages and relabel ethnicities for plot labels
chartData$groupPer <- round(100 * chartData$total_count/totalCount)
chartData$race_ethnicity[chartData$race_ethnicity == "Black"] <- "African American"
chartData$race_ethnicity[chartData$race_ethnicity == "Asian"] <- "Asian American"
chartData$race_ethnicity[chartData$race_ethnicity == "Hispanic"] <- "Hispanic American"
chartData$race_ethnicity[chartData$race_ethnicity == "TOTAL"] <- "Total"

chartData$label <- paste0(chartData$race_ethnicity, "\n ", 
                          chartData$groupPer, "% of Graduates")

chartData %<>% filter(chartData$race_ethnicity != "Multiple/Other")

# // Step 8: Create a label variable to label the outcomes on the plot
chartData$outcomeLabel <- NA
chartData$outcomeLabel[chartData$outcome == "no_college"] <- "Not Enrolled in College"
chartData$outcomeLabel[chartData$outcome == "enrl_2yr"] <- "Enrolled at 2-Yr College"
chartData$outcomeLabel[chartData$outcome == "enrl_4yr"] <- "Enrolled at 4-Yr College"

# // Step 9: Order the factor to plot in the correct order
chartData$outcomeLabel <- factor(chartData$outcomeLabel, 
                                 ordered = TRUE, 
                                 levels = c("Enrolled at 4-Yr College", 
                                            "Not Enrolled in College", 
                                            "Enrolled at 2-Yr College"))

```

```{r D5plot}
#// Step 10: Create a caption to put under the figure

myCap <- paste0(
        "Sample: 2007-2008 through 2008-2009 Agency first-time ninth graders. ", 
        "Students who transferred into or out of\nAgency are excluded ", 
        "from the sample. Eligibility to attend a public four-year university ", 
        "is based on students' cumulative GPA\nand ACT/SAT scores. ",
        "Sample includes 30 African American, 82 Asian American students, ",
        "53 Hispanic, \nand 198 White students. ", 
        "Post-secondary enrollment data are from NSC matched records.")

# // Step 11: Plot

ggplot(chartData, aes(x = reorder(label, total_count), y = measure, 
                      group = outcomeLabel, 
                      fill = outcomeLabel)) + 
  geom_bar(position = 'stack', stat = 'identity', color = I("black")) + 
  geom_hline(yintercept = 0) + 
  geom_text(aes(label = round(measure * 100, 0)), 
            position=position_stack(vjust = 0.85)) +
  scale_y_continuous(limits = c(-.25, 1), breaks = seq(-.25, 1, 0.2), 
                     label = percent) +
  theme_classic() + 
  guides(fill = guide_legend(nrow=1, title = "", keywidth = 2)) +
  scale_fill_brewer(type = "qual", palette = 2, direction = -1) + 
  theme(legend.position = "top", axis.text = element_text(color = "black"), 
        plot.caption = element_text(hjust = 0, size = 8), 
        plot.title = element_text(hjust = 0.5), 
        plot.subtitle = element_text(hjust = 0.5)) + 
  labs(x = "", y = "Percent of Highly-Qualified Graduates", 
       title = "Rates of Highly Qualified Students Attending College, by Race", 
       subtitle = "Among Graduates Eligible to Attend Four-Year Universities", 
       caption = myCap)

```

## Task 6: Gaps in Rates of College Enrollment Between Latino and White Graduates


**Purpose:** This Strategic Performance Indicator explores gaps in college 
enrollment rates by ethnicity, before and after accounting for differences in 
prior academic achievement, socioeconomic status, and both of these background
characteristics. While the analysis evaluates separately the college enrollment 
gaps between Black and White students and between Latino and White students, 
it can be modified to focus on the gap between any two races or ethnicities.

**Required Analysis File Variables:**

- `sid`
- `chrt_grad` 
- `last_hs_code`
- `race_ethnicity`
- `test_math_8`
- `frpl_ever`
- `enrl_1oct_grad_yr1_any`

**Analysis-Specific Sample Restrictions:**

- Keep students in high school graduation cohorts you can observe enrolling in 
college the fall after graduation.
-  Keep only graduates who received regular or advanced diplomas (i.e. exclude 
students who received SPED diplomas and other certificates).
- Drop race/ethnic groups with less than 20 students eligible to attend a 
four-year university. You may further restrict the sample to only include 
students from the most representative racial/ethnic sub-groups in your agency.

**Ask Yourself**

- How do racial gaps in college enrollment change after prior achievement is 
accounted for? How do these gaps change after socioeconomic status is accounted 
for?
- Do these gaps still exist when you account for both prior achievement and
socioeconomic status? Do they reverse direction, suggesting that minority 
students enroll in college at higher rates when compared with White students with
similar background characteristics?
- Do you observe differences in the degree to which the White-Black gap and 
the White-Latino gap decline after accounting for prior achievement and 
socioeconomic status? If the adjusted gap between White and Latino students, 
for example, is still sizable, what additional barriers may be impeding access 
to college for Latino students? 

**Analytic Technique:** Calculate the difference between the proportion of Black 
(or Latino) high school graduates and the proportion of White high school 
graduates who enrolled in college—in raw terms and after accounting for 8th 
grade test scores, for eligibility for Free or Reduced Price Lunch (FRPL), 
and for both of these characteristics. 

```{r D6filterAndSort}
# // Step 1: Keep students in high school graduation cohorts you can observe 
# enrolling in college the fall after graduation AND have non-missing eighth 
# grade test scores AND non-missing FRPL status

plotdf <- cgdata %>% filter(chrt_grad >= chrt_grad_begin & 
                              chrt_grad <= chrt_grad_end) %>% 
  select(sid, chrt_grad, race_ethnicity, test_math_8, frpl_ever,
         enrl_1oct_grad_yr1_any, last_hs_code) %>% 
  filter(!is.na(frpl_ever) & !is.na(test_math_8)) %>% 
  filter(race_ethnicity %in% c(1, 3, 5) & !is.na(race_ethnicity)) %>%
  filter(!is.na(enrl_1oct_grad_yr1_any))

# // Step 2: Recode variables and create cluster variable
plotdf$race_ethnicity <- as_factor(plotdf$race_ethnicity)
plotdf$race_ethnicity <- relevel(plotdf$race_ethnicity, ref = "White")
# // Step 3: Create a unique identifier for clustering standard errors 
# at the cohort/school level
plotdf$cluster_var <- paste(plotdf$chrt_grad, plotdf$last_hs_code, sep = "-")
```

```{r D6modelAndReshape}
# Load the broom library to make working with model coefficients simple 
# and uniform
library(broom)

# // Step 4: Estimate the unadjusted and adjusted differences in college 
# enrollment between Latino and white students and between black and white 
# students 

# Estimate unadjusted enrollment gap
#  Fit the model
mod1 <- lm(enrl_1oct_grad_yr1_any ~ race_ethnicity, data = plotdf)
#  Extract the coefficients
betas_unadj <- tidy(mod1)
#  Get the clustered variance-covariance matrix
#  Use the get_CL_vcov function from the functions.R script
clusterSE <- get_CL_vcov(mod1, plotdf$cluster_var)
#  Get the clustered standard errors and combine with the betas
betas_unadj$std.error <- sqrt(diag(clusterSE))
betas_unadj <- betas_unadj[, 1:3]
#  Label
betas_unadj$model <- "Unadjusted enrollment gap"

# Estimate enrollment gap adjusting for prior achievement
mod2 <- lm(enrl_1oct_grad_yr1_any ~ race_ethnicity + test_math_8, data = plotdf)
betas_adj_prior_ach <- tidy(mod2)
clusterSE <- get_CL_vcov(mod2, plotdf$cluster_var)
betas_adj_prior_ach$std.error <- sqrt(diag(clusterSE))
betas_adj_prior_ach <- betas_adj_prior_ach[, 1:3]
betas_adj_prior_ach$model <- "Gap adjusted for prior achievement"

# Estimate enrollment gap adjusting for frpl status
plotdf$frpl_ever <- ifelse(plotdf$frpl_ever > 0, 1, 0)
mod3 <- lm(enrl_1oct_grad_yr1_any ~ race_ethnicity + frpl_ever, data = plotdf)
betas_adj_frpl <- tidy(mod3)
clusterSE <- get_CL_vcov(mod3, plotdf$cluster_var)
betas_adj_frpl$std.error <- sqrt(diag(clusterSE))
betas_adj_frpl <- betas_adj_frpl[, 1:3]
betas_adj_frpl$model <- "Gap adjusted for FRPL status"

# Estimate enrollment gap adjusting for prior achievement and frpl status
mod4 <- lm(enrl_1oct_grad_yr1_any ~ race_ethnicity + frpl_ever + test_math_8, 
           data = plotdf)
betas_adj_frpl_prior <- tidy(mod4)
clusterSE <- get_CL_vcov(mod4, plotdf$cluster_var)
betas_adj_frpl_prior$std.error <- sqrt(diag(clusterSE))
betas_adj_frpl_prior <- betas_adj_frpl_prior[, 1:3]
betas_adj_frpl_prior$model <- "Gap adjusted for prior achievement & FRPL status"

# // Step 5. Transform the regression coefficients to a data object for plotting
chartData <- bind_rows(betas_unadj, betas_adj_frpl, betas_adj_prior_ach, 
                    betas_adj_frpl_prior)
# Cleanup workspace
rm(plotdf, betas_unadj, betas_adj_frpl, betas_adj_frpl_prior, 
   betas_adj_prior_ach)
```

```{r D6plot}
# // Step 6. Plot
ggplot(chartData[chartData$term == "race_ethnicityHispanic", ],
       aes(x = model, y = -estimate, fill = model)) + 
  geom_bar(stat = 'identity', color = I("black")) + 
  scale_fill_brewer(type = "seq", palette = 8) +
  geom_hline(yintercept = 0) + 
  guides(fill = guide_legend("", keywidth = 6, nrow = 2)) + 
  geom_text(aes(label = round(100 * -estimate, 0)), vjust = -0.3) +
  scale_y_continuous(limits = c(-0.2, 0.5), breaks = seq(-0.2, 0.5, 0.1), 
                     label = percent, name = "Percentage Points") + 
  theme_classic() + theme(legend.position = "bottom", axis.text.x = element_blank(), 
                          axis.ticks.x = element_blank()) + 
  labs(title = paste0("Differences in Rates of College Enrollment", 
                      " \nBetween Latino and White High School Graduates"), 
       x = "",
       caption = paste0(
                  "Sample: 2007-2008 through 2008-2009 high school graduates. \n",
                  "Postsecondary enrollment outcomes from NSC matched records. \n",
                  "All other data from Agency administrative records.")
       )

```

## Task 7: College Enrollment Rates by 8th Grade Achievement Quartile Bubbles

**Purpose:** This SPI highlights the variation in college-going rates across high 
schools when students with similar prior achievement are compared. To conduct 
these comparisons, we first sort all incoming ninth-graders into quartiles 
based on their 8th grade test scores. We then examine college-going rates by 
high school among graduates within each of these quartiles.

**Required Analysis File Variables:**

- `sid`
- `chrt_grad` 
- `last_hs_name`
- `hs_diploma`
- `qrt_8_math_std`
- `enrl_1oct_grad_yr1_any`

**Analysis-Specific Sample Restrictions:**

- Keep students in high school graduation cohorts you can observe
enrolling in college the fall after graduation AND have
non-missing eighth grade test scores.
- Drop high schools with less than 20 students in each quartile
enrolled in ninth grade across the cohorts.
- Keep only graduates who received regular or advanced diplomas
(i.e. exclude students who received SPED diplomas
and other certificates).

**Ask Yourself**

- How do college enrollment rates vary across high schools for students within 
the same quartile of 8th grade test scores (that is, when we compare students 
with similar prior achievement)?
- What is the difference between the high schools with the lowest and with the 
highest rates in each quartile?
- Are across-school differences in colleges enrollment rates particularly large 
for students of certain achievement profile—for example, for students with 8th 
grade test scores in the bottom quartile? 

**Analytic Technique:** Calculate the share of students in each 8th grade test 
score quartile at each high school who enroll in college seamlessly after high 
school graduation.

```{r D7filterAndSOrt}
# // Step 1: Keep students in high school graduation cohorts you can observe 
# enrolling in college the fall after graduation AND have non-missing eighth 
# grade test scores
plotdf <- cgdata %>% filter(chrt_grad >= chrt_grad_begin & 
                              chrt_grad <= chrt_grad_end) %>% 
  select(sid, chrt_grad, qrt_8_math, hs_diploma,
         enrl_1oct_grad_yr1_any, last_hs_name) %>% 
  filter(!is.na(qrt_8_math)) %>% 
  filter(!is.na(enrl_1oct_grad_yr1_any))
```


```{r D7reshapeAndCalculate}
# // Step 2: Create agency- and school-level average outcomes for each quartile

chartData <- plotdf %>% group_by(last_hs_name, qrt_8_math) %>% 
  summarize(enroll_count = sum(enrl_1oct_grad_yr1_any),
            diploma_count = sum(hs_diploma)) %>% 
  mutate(pct_enrl = enroll_count/diploma_count)

agencyData <- plotdf %>% group_by(qrt_8_math) %>% 
  summarize(enroll_count = sum(enrl_1oct_grad_yr1_any),
            diploma_count = sum(hs_diploma)) %>% 
  mutate(pct_enrl = enroll_count/diploma_count) %>% as.data.frame

```

```{r D7plot}
# // Step 3: Plot

ggplot(chartData, aes(x = factor(qrt_8_math), y = pct_enrl)) + 
  geom_point(aes(size = diploma_count), shape = 1) + 
  scale_size(range = c(3, 12), breaks = seq(0, 350, 75)) + 
  geom_point(data=agencyData, aes(x = factor(qrt_8_math), 
                                  y = pct_enrl, size = NULL), 
             color = I("red"), size = I(4)) +
  theme_classic() + 
  scale_y_continuous(limits = c(0, 1), breaks = seq(0, 1, 0.2), 
                     label = percent) +
  labs(y = "Percent of High School Graduates", 
       x = "Quartile of Prior Achievement", 
       title = "College Enrollment Rates Among High School Gradautes", 
       subtitle = "Within Quartile of Prior Achievement, by High School", 
        caption = paste0(
                  "Sample: 2007-2008 through 2008-2009 high school graduates. \n", 
                  "Postsecondary enrollment outcomes from NSC matched records. \n", 
                  "All other data from Agency administrative records.")
       )

```

## Task 8: Undermatch Rates Among Highly Qualified High School Graduates

**Purpose:** This Strategic Performance Indicator examines the prevalence of
"undermatch" in the agency—that is, the extent to which high school graduates 
with strong academic records pursue enrollment in colleges and universities 
less selective than those for which they are likely qualified. The SPI does so 
by illustrating the rates at which highly qualified graduates are enrolling at 
2-year colleges, less competitive 4-year colleges, or forgoing college 
altogether, instead of pursuing selective colleges that may provide a better 
academic and social fit for these students’ potential, ambition, and preparation.

**Required Analysis File Variables:**

- `sid`
- `chrt_grad` 
- `highly_qualified`
- `first_college_opeid_4yr`
- `enrl_1oct_grad_yr1_any`
- `enrl_1oct_grad_yr1_4yr`
- `enrl_1oct_grad_yr1_2yr`

**Analysis-Specific Sample Restrictions:**

- Keep students in high school graduation cohorts you can
observe enrolling in college the fall after graduation.
- Keep only highly qualified high school graduates (i.e. students
who have obtained a high school diploma on time
with 1) a cumulative GPA of 3.0 or higher and Math/Verbal
SAT score of 1300 or higher, or 2) a cumulative GPA of 3.3 or
higher and Math/Verbal SAT score of 1200 or higher, or 3) a
cumulative GPA of 3.7 or higher and Math/Verbal SAT score
of at least 1100).
- Keep only graduates who received regular or advanced diplomas
(i.e. exclude students who received SPED diplomas
and other certificates).

**A Note on College Selectivity**

To determine the selectivity of the postsecondary institutions in which high 
school graduates enroll, we typically rely on Barron’s College Rankings. Barron’s 
has developed well-established college selectivity ratings based on the degree 
of admissions competitiveness at four-year colleges and universities. Factors 
used in determining these rankings include the median SAT and ACT scores, high 
school class rankings, and grade point average among incoming college freshmen. 
The seven selectivity rankings Barron’s assigns are "Most Competitive", 
"Highly Competitive," "Very Competitive," "Competitive," "Less Competitive,"
"Non-Competitive," and "Special." As part of this exercise, we have provided 
a simplified table from which the selectivity ratings of the colleges and 
universities included in this dataset can be obtained. In conducting this 
analysis for your own agency, you need to select a source of college 
selectivity ratings, such as Barron’s, and use it in place of the college 
selectivity table used in this exercise.

**Ask Yourself**

- How do college enrollment rates vary across high schools for students within 
the same quartile of 8th grade test scores (that is, when we compare students 
with similar prior achievement)?
- What is the difference between the high schools with the lowest and with the 
highest rates in each quartile?
- Are across-school differences in colleges enrollment rates particularly large 
for students of certain achievement profile—for example, for students with 8th 
grade test scores in the bottom quartile?

```{r D8filterAndSort}
# // Step 1: Keep students in high school graduation cohorts you can observe 
# enrolling in college the fall after graduation AND are highy qualified

plotdf <- cgdata %>% filter(chrt_grad >= chrt_grad_begin & 
                              chrt_grad <= chrt_grad_begin) %>% 
  select(sid, chrt_grad, highly_qualified, first_college_opeid_4yr,
         enrl_1oct_grad_yr1_any, enrl_1oct_grad_yr1_4yr, enrl_1oct_grad_yr1_2yr) %>% 
  filter(!is.na(highly_qualified)) %>% 
  filter(highly_qualified ==1 )

# // Step 2: Link the analysis file with the college selectivity table to obtain 
# the selectivity level for each college. Use this selectivity information to 
# create college enrollment indicator variables for each college selectivity 
# level. This script assumes that there are 5 levels of selectivity, as in 
# Barron’s College Rankings—Most Competitive (1), Highly Competitive (2), 
# Very Competitive (3), Competitive (4), Least Competitive (5)—as well as a 
# category for colleges without assigned selectivity (assumed to be not 
# competitive).

# Read in college selectivity data
tmpfileName <- "analysis/college_selectivity.dta"
con <- unz(description = "data/analysis.zip", filename = tmpfileName, 
           open = "rb")
coll_select <- read_stata(con) # read data in the data subdirectory
close(con)

# Merge on to subset from above
plotdf <- left_join(plotdf, coll_select, 
                    by = c("first_college_opeid_4yr" = "college_id"))
# Filter out
plotdf %<>% filter(!(first_college_opeid_4yr == "" & enrl_1oct_grad_yr1_4yr == 1))
```

```{r D8recodeAndReshape}
# // Step 4. Create the undermatch outcomes
plotdf$rank[is.na(plotdf$rank)] <- 6
plotdf$outcome <- NA
plotdf$outcome[plotdf$enrl_1oct_grad_yr1_any == 0] <- "No college"
plotdf$outcome[plotdf$enrl_1oct_grad_yr1_2yr == 1] <- "Two year college"
plotdf$outcome[is.na(plotdf$outcome) & 
                 plotdf$enrl_1oct_grad_yr1_any == 1 & (plotdf$rank > 4)] <- "Undermatch"
plotdf$outcome[plotdf$enrl_1oct_grad_yr1_any == 1 & plotdf$rank <= 4] <- "Match"

# // Step 5 Create agency-average undermatch outcomes and transform them into % terms
chartData <- plotdf %>% group_by(outcome) %>% 
  summarize(count = n()) %>% ungroup %>% 
  mutate(totalCount = sum(count))


chartData %<>% filter(outcome != "Match") %>% 
  arrange(count)

```

```{r D8plot}
# // Step 6: Plot

ggplot(arrange(chartData, -count), 
       aes(x = factor(1), fill = outcome, y = count/totalCount)) +
  geom_bar(stat = 'identity', position = "stack", color = I("black")) +
  scale_fill_brewer(type = "qual", palette= 3, direction=1) +
  guides(fill = guide_legend("", keywidth = 6, nrow = 2)) + 
  geom_text(aes(label = round(100 * count/totalCount, 1)), 
            position = position_stack(vjust = 0.5)) +
  scale_y_continuous(limits = c(0, 0.40), breaks = seq(0, 0.4, 0.1), 
                     label = percent, name = "Percent of High School Graduates") + 
  theme_classic() + theme(legend.position = "bottom", axis.text.x = element_blank(), 
                          axis.ticks.x = element_blank()) + 
  labs(title = "Undermatch Rates by Agency", 
       subtitle = "Among Highly Qualified High School Graduates",
       x = "",
       caption = paste0(
                "Sample: 2007-2008 through 2008-2009 high school graduates. \n",
                 "Postsecondary enrollment outcomes from NSC matched records. \n", 
                "All other data from Agency administrative records."))

```

# E: College Persistence

For many high school graduates, college enrollment is just the first of many 
hurdles on the road to postsecondary success. While considerable attention has 
been paid to challenges that surround college preparedness, access, and 
enrollment, only recently has conversation expanded to consider barriers to 
degree completion. These barriers must be understood and addressed at both the 
secondary and postsecondary levels for college attainment rates to increase. In 
the last section of the education pipeline, you examine patterns of persistence 
to the second year of college to identify early indications of student progress 
towards degree attainment.

To explore college persistence, use the models below:

1. Persistence Rates to the Second Year of College By High School
2. Persistence Across Two-Year and Four-Year Colleges
3. Top Enrolling Colleges and Universities of Agency Graduates

## Task 1: Persistence Rates to the Second Year of College by High School

**Purpose:** Initial enrollment decisions can dramatically affect higher 
education trajectories and the likelihood of degree attainment. This analysis 
provides a snapshot of persistence to the second year of college by examining
persistence rates across high schools in the system. The analysis illuminates
differences in persistence by level of college first attended (two-year vs. 
four-year). Given another year of sample data, the analysis could also be 
conducted by time of initial entry (seamless vs. delayed enrollment). 

**Required Analysis File Variables:**

- `sid`
- `enrl_1oct_grad_yr1_any`
- `enrl_1oct_grad_yr1_4yr`
- `enrl_1oct_grad_yr1_2yr`
- `enrl_grad_persist_any`
- `enrl_grad_persist_4yr`
- `enrl_grad_persist_2yr`
- `last_hs_code`
- `last_hs_name`
- `enrl_ever_w2_grad_any`

**Analysis-Specific Sample Restrictions:**

- Keep students in high school graduation cohorts you can
observe enrolling in college the fall after graduation
- Keep only graduates who received regular or advanced diplomas
(i.e. exclude students who received SPED diplomas
and other certificates).
- Drop high schools with less than 20 students in the sample.

**Ask Yourself**

- How does college persistence for enrollers at 2-year colleges compare to 
enrollers at 4-year colleges? Given another year of sample data, how does 
college persistence for seamless enrollers compare to delayed enrollers?

**Possible Next Steps or Action Plans:** Consider establishing MOUs with local 
community colleges to obtain detailed data on graduates’ postsecondary pursuits 
at two-year colleges (Course enrollment and transcript data) allowing agencies 
to explore persistence rates by assignment to remediation coursework.

**Analytic Technique:** Calculate the proportion of students who persist to the 
second year of college by the high school those students first attended.

 

```{r E1filterAndSort}
# // Step 1: Keep students in high school graduation cohorts you can observe 
# enrolling in college the fall after graduation

plotdf <- cgdata %>% filter(chrt_grad >= chrt_grad_begin & 
                              chrt_grad <= chrt_grad_end) %>% 
  select(sid, chrt_grad, enrl_1oct_grad_yr1_2yr, enrl_1oct_grad_yr1_4yr,
         enrl_1oct_grad_yr1_any, enrl_grad_persist_any, 
         enrl_grad_persist_2yr, enrl_grad_persist_4yr, last_hs_name, 
         enrl_ever_w2_grad_any) 

# // Step 2: Rename and recode for simplicity
plotdf$groupVar <- NA
plotdf$groupVar[plotdf$enrl_1oct_grad_yr1_2yr == 1] <- "2-year College"
plotdf$groupVar[plotdf$enrl_1oct_grad_yr1_4yr == 1] <- "4-year College"
```

```{r E1ReshapeandRecode}
# // Step 3: Obtain the agency-level average for persistence and enrollment
agencyData <- plotdf %>% group_by(groupVar) %>%
  summarize(persistCount = sum(enrl_grad_persist_any, na.rm=TRUE),
            totalCount = n()) %>% 
  ungroup %>% 
  mutate(total = sum(persistCount)) %>% 
  mutate(persistRate = persistCount / totalCount, 
         last_hs_name = "Agency AVERAGE")

# // Step 4: Obtain the school-level average for persistence and enrollment
schoolData <- plotdf %>% group_by(groupVar, last_hs_name) %>%
  summarize(persistCount = sum(enrl_grad_persist_any, na.rm=TRUE), 
            totalCount = n()) %>% 
  ungroup %>% group_by(last_hs_name) %>%
  mutate(total = sum(persistCount)) %>% 
  mutate(persistRate = persistCount / totalCount)

# Combine for chart
chartData <- bind_rows(agencyData, schoolData)
# // Step 5: Recode variables for plotting 
chartData$last_hs_name <- gsub(" High School", "", chartData$last_hs_name)

# // STep 6: Filter rows out with missing values or small cell sizes
chartData <- na.omit(chartData)
chartData <- filter(chartData, totalCount > 20)

# // Step 7: Calculate rank for plot order
chartData <- chartData %>% group_by(groupVar) %>% 
  mutate(order = min_rank(-persistRate))
chartData %<>% arrange(last_hs_name)

# Make ranks the same for 2 and 4 year colleges
chartData$order[chartData$groupVar == "2-year College"] <-
  chartData$order[chartData$groupVar == "4-year College"] 
# Conver to a factor and order for ggplot purposes
chartData$groupVar <- factor(chartData$groupVar)
chartData$groupVar <- relevel(chartData$groupVar, ref = "4-year College")

```


```{r E1plot}
# // Step 8: Plot
ggplot(chartData, aes(x = reorder(last_hs_name, -order), 
                                      group = groupVar, 
                      y = persistRate, fill = groupVar, 
                      color = I("black"))) + 
  geom_bar(stat = 'identity', position = 'dodge') +
  geom_text(aes(label = round(persistRate * 100, 0)), 
            position = position_dodge(0.9), vjust = -0.4) +
  scale_y_continuous(limits = c(0, 1), breaks = seq(0, 1, 0.2), 
                     name = "% Of Seamless Enrollers", 
                     expand = c(0,0), label = percent) +
  theme_classic() + 
  guides(fill = guide_legend("", keywidth = 3, nrow = 2)) + 
  theme(axis.text.x = element_text(angle = 30, vjust = 0.5, color = "black"), 
        legend.position = c(0.1, 0.925), axis.ticks.x = element_blank(),
        legend.key = element_rect(color = "black")) +
  scale_fill_brewer(type = "div", palette = 2) + 
  labs(x = "", 
       title = "College Persistence by High School, at Any College", 
       subtitle = "Seamless Enrollers by Type of College", 
       caption = paste0(
         "Sample: 2007-2008 through 2008-2009 Agency high school graduates.\n",
                 "Postsecondary enrollment outcomes from NSC matched records. \n", 
                  "All other data from agency administrative records"))

```


## Task 2: Persistence Across Two-Year and Four-Year Colleges

**Purpose:** This analysis provides a snapshot of persistence to the second 
year of college from one type of college to another for different high schools 
in the system. The left analysis charts explores how seamless enrollers in 
4-year colleges either persist at a 4-year or switch to a 2-year. The right 
analysis charts how seamless enrollers in 2-year colleges either persist at a 
2-year or switch to a 4-year.

**Required Analysis File Variables:**

- `sid`
- `enrl_1oct_grad_yr1_any`
- `enrl_1oct_grad_yr1_4yr`
- `enrl_1oct_grad_yr1_2yr`
- `enrl_grad_persist_any`
- `enrl_grad_persist_4yr`
- `enrl_grad_persist_2yr`
- `last_hs_code`
- `last_hs_name`


**Analysis-Specific Sample Restrictions:**

- Keep the three most recent cohorts of graduates for which
persistence in college over four consecutive years can be
reported.
- Keep only graduates enrolled in 4-yr colleges and universities
the fall following high school graduation.
- Keep only graduates for whom cumulative high school GPAs
can be calculated (or obtained from the agency)
- Only include the top six enrolling 4-year colleges
- Only report persistence rates among students falling in each
high school GPA category if the sample includes 25 or more
students

**Ask Yourself**

- How do the rates of persistence or switching differ for seamless enrollers at 
4-year vs. 2-year colleges?

**Possible Next Steps or Action Plans:** Create individual school-level reports 
for administrators and college counselors to communicate which postsecondary
institutions are associated with greater rates of persistence. Additionally, 
conduct similar analyses that include more detailed institutional information
that may be associated with students’ prospects of persisting (e.g. cost of 
tuition and room/board, financial aid, etc.).

**Analytic Technique:** Calculate the proportion of 4-yr college-goers who 
persist through four years of college by the postsecondary institution first 
attended and cumulative high school GPA category.

 

```{r E2filterAndSort}
# // Step 1: Keep students in high school graduation cohorts you can observe 
# enrolling in college the fall after graduation

plotdf <- cgdata %>% filter(chrt_grad >= chrt_grad_begin & 
                              chrt_grad <= chrt_grad_end) %>% 
  select(sid, chrt_grad, enrl_1oct_grad_yr1_2yr, enrl_1oct_grad_yr1_4yr,
         enrl_1oct_grad_yr1_any, enrl_1oct_grad_yr2_2yr, enrl_1oct_grad_yr2_4yr,
         enrl_1oct_grad_yr2_any, enrl_grad_persist_any, 
         enrl_grad_persist_2yr, enrl_grad_persist_4yr, last_hs_name) 

```

```{r E2recodeAndReshape}
# Clean up missing data for binary recoding
plotdf$enrl_grad_persist_4yr <- zeroNA(plotdf$enrl_grad_persist_4yr)
plotdf$enrl_grad_persist_2yr <- zeroNA(plotdf$enrl_grad_persist_2yr)
plotdf$enrl_1oct_grad_yr1_2yr <- zeroNA(plotdf$enrl_1oct_grad_yr1_2yr)
plotdf$enrl_1oct_grad_yr1_4yr <- zeroNA(plotdf$enrl_1oct_grad_yr1_4yr)

# // Step 2: Create binary outcomes for enrollers who switch from 4-yr to 2-yr, 
# or vice versa and recode variables
plotdf$persist_pattern <- "Not persisting"
plotdf$persist_pattern[plotdf$enrl_grad_persist_4yr == 1 &
                         !is.na(plotdf$chrt_grad)] <- "Persisted at 4-Year College"
plotdf$persist_pattern[plotdf$enrl_grad_persist_2yr ==1 &
                         !is.na(plotdf$chrt_grad)] <- "Persisted at 2-Year College"
plotdf$persist_pattern[plotdf$enrl_1oct_grad_yr1_4yr == 1 & 
                        plotdf$enrl_1oct_grad_yr2_2yr == 1 & 
                         !is.na(plotdf$chrt_grad)] <- "Switched to 2-Year College"
plotdf$persist_pattern[plotdf$enrl_1oct_grad_yr1_2yr == 1 & 
                        plotdf$enrl_1oct_grad_yr2_4yr == 1 & 
                         !is.na(plotdf$chrt_grad)] <- "Switched to 4-Year College"

plotdf$groupVar <- NA
plotdf$groupVar[plotdf$enrl_1oct_grad_yr1_2yr == 1] <- "2-year College"
plotdf$groupVar[plotdf$enrl_1oct_grad_yr1_4yr == 1] <- "4-year College"
# Drop NA
plotdf %<>% filter(!is.na(groupVar))
# // Step 3: Obtain agency and school level average for persistence outcomes
chartData <- plotdf %>% 
  group_by(last_hs_name, groupVar, persist_pattern) %>% 
  summarize(tally = n()) %>% # counts the occurrence persist_pattern
  ungroup %>% 
  group_by(last_hs_name, groupVar) %>% # regroup by grouping variable and school
  mutate(denominator = sum(tally)) %>% # sum all levels of persist_pattern
  mutate(persistRate = tally / denominator) %>% # calculate rate
  filter(persist_pattern != "Not persisting") %>%
  mutate(rankRate = sum(persistRate))

agencyData <- plotdf %>%
  group_by(groupVar, persist_pattern) %>% 
  summarize(tally = n(), 
            last_hs_name = "Agency AVERAGE") %>% 
  ungroup %>% 
  group_by(last_hs_name, groupVar) %>% 
  mutate(denominator = sum(tally)) %>% 
  mutate(persistRate = tally / denominator) %>% 
  filter(persist_pattern != "Not persisting") %>%
  mutate(rankRate = sum(persistRate))

chartData <- bind_rows(chartData, agencyData)

# // Step 4: Recode variable names, sort data frame, and code labels for plot
chartData$last_hs_name <- gsub(" High School", "", chartData$last_hs_name)
chartData$last_hs_name <- gsub(" ", "\n", chartData$last_hs_name)
# chartData %<>% filter(persist_pattern != "Not persisting")
chartData %<>% arrange(persist_pattern)
chartData <- as.data.frame(chartData)
chartData$persist_pattern <- factor(as.character(chartData$persist_pattern), 
                                    ordered = TRUE, 
                                    levels = c("Switched to 4-Year College", 
                                               "Switched to 2-Year College", 
                                               "Persisted at 2-Year College", 
                                               "Persisted at 4-Year College"))
```


```{r E2plot}
# // Step 5: Prepare plot for 2-year colleges
p1 <- ggplot(chartData[chartData$groupVar == "2-year College",], 
       aes(x = reorder(last_hs_name, rankRate), 
           y = persistRate, group = persist_pattern, 
           fill = persist_pattern)) + 
  scale_y_continuous(limits = c(0, 1), expand = c(0, 0), 
                     label = percent, breaks = seq(0, 1, 0.2)) + 
  geom_bar(stat = 'identity', position = 'stack', 
           color = I("black")) + 
  geom_text(aes(label = round(persistRate * 100, 0)), 
            position = position_stack(vjust = 0.5)) +
  geom_text(aes(label = round(rankRate * 100, 0), y = rankRate), vjust = -0.7) +
  guides(fill = guide_legend("", keywidth = 2, nrow = 2)) +
  scale_fill_brewer(type = "qual", palette = 1) +
  labs(x = "", y = "Percent of Seamless Enrollers") + 
  theme_classic() + theme(axis.text.x = element_text(angle = 30, vjust = 0.2), 
                          axis.ticks.x = element_blank(), 
                          legend.position = c(0.3, 0.875), 
                          plot.caption = element_text(hjust = 0, size = 7)) + 
  labs(subtitle = "Seamless Enrollers at 2-year Colleges", 
       caption = paste0(
          "Sample: 2007-2008 through 2008-2009 Agency high school graduates.\n", 
              "Postsecondary enrollment outcomes from NSC matched records. \n", 
              "All other data from agency administrative records"))

# // Step 6: Prepare plot for 4-year colleges by replacing data in plot 
# above with 4 year data
p2 <- p1 %+% chartData[chartData$groupVar == "4-year College",] + 
  labs(subtitle = "Seamless Enrollers at 4-year Colleges")

# // Step 7: Print out plots with labels
grid.arrange(grobs= list(p2, p1), nrow=1, 
             top = "College Persistence by High School")

```

## Task 3: Top-Enrolling Colleges/Universities of Agency Graduates

**Purpose:** This analysis reports enrollment and persistence rates among 
top-enrolling two- and four- year institutions attended by graduates. This 
analysis illuminates differences in persistence rates to the second year of 
college among top-enrolling postsecondary institutions. Agency staff that 
advise students during their senior year may find this information useful when 
meeting to weigh college options.

**Required Analysis File Variables:**

- `sid`
- `enrl_1oct_grad_yr1_any`
- `enrl_1oct_grad_yr1_4yr`
- `enrl_1oct_grad_yr1_2yr`
- `enrl_grad_persist_any`
- `enrl_grad_persist_4yr`
- `enrl_grad_persist_2yr`
- `first_college_name_any`
- `first_college_name_2yr`
- `first_college_name_4yr`

** Analysis-Specific Sample Restrictions:**

- Keep only the most recent cohort of seamless college-goers
for which persistence to the second year of college can be
reported
- Only include postsecondary institutions with 25 or more
agency graduates attending.

**Ask Yourself**

- What are the top enrolling 4-year and 2-year colleges or universities in your 
agency? What are the persistence rates at those colleges and universities?

**Analytic Technique:** Calculate the proportion of college-goers attending
top-enrolling 2- and 4-year institutions, as well as the proportion of seamless
enrollers who persist to the second year of any college, by the postsecondary
institution graduates first attended.

```{r E3filterAndSort}
# // Step 1: Keep students in high school graduation cohorts you can observe 
# enrolling in college the fall after graduation

plotdf <- cgdata %>% filter(chrt_grad >= chrt_grad_begin & 
                              chrt_grad <= chrt_grad_end) %>% 
  select(sid, chrt_grad, enrl_1oct_grad_yr1_2yr, enrl_1oct_grad_yr1_4yr,
         enrl_1oct_grad_yr1_any, enrl_1oct_grad_yr2_2yr, enrl_1oct_grad_yr2_4yr,
         enrl_1oct_grad_yr2_any, enrl_grad_persist_any, 
         enrl_grad_persist_2yr, enrl_grad_persist_4yr, 
         first_college_name_any, first_college_name_2yr, first_college_name_4yr) 

# // Step 2: Indicate the number of institutions you would like listed

num_inst <- 5

```

```{r E3reshapeAndCalculate}
# // Step 3: Calculate the number and % of students enrolled in each college 
# the fall after graduation, and the number and % of students persisting, by 
# college type

chart4year <- bind_rows(
  plotdf %>% group_by(first_college_name_4yr) %>% 
  summarize(enrolled = sum(enrl_1oct_grad_yr1_4yr, na.rm=TRUE), 
            persisted = sum(enrl_grad_persist_4yr, na.rm=TRUE)) %>% 
  ungroup %>% 
  mutate(total_enrolled = sum(enrolled)) %>% 
  mutate(perEnroll = round(100 * enrolled/total_enrolled, 1), 
         perPersist = round(100 * persisted/enrolled, 1)),
  plotdf %>% 
  summarize(enrolled = sum(enrl_1oct_grad_yr1_4yr, na.rm=TRUE), 
            persisted = sum(enrl_grad_persist_4yr, na.rm=TRUE), 
            first_college_name_4yr = "All 4-Year Colleges") %>% 
  ungroup %>% 
  mutate(total_enrolled = sum(enrolled)) %>% 
  mutate(perEnroll = round(100 * enrolled/total_enrolled, 1), 
         perPersist = round(100 * persisted/enrolled, 1))
)


chart2year <- bind_rows(plotdf %>% group_by(first_college_name_2yr) %>% 
  summarize(enrolled = sum(enrl_1oct_grad_yr1_2yr, na.rm=TRUE), 
            persisted = sum(enrl_grad_persist_2yr, na.rm=TRUE)) %>% 
  ungroup %>% 
  mutate(total_enrolled = sum(enrolled)) %>% 
  mutate(perEnroll = round(100 * enrolled/total_enrolled, 1), 
         perPersist = round(100 * persisted/enrolled, 1)),
  plotdf %>% 
  summarize(enrolled = sum(enrl_1oct_grad_yr1_2yr, na.rm=TRUE), 
            persisted = sum(enrl_grad_persist_2yr, na.rm=TRUE), 
            first_college_name_2yr = "All 2-Year Colleges") %>% 
  ungroup %>% 
  mutate(total_enrolled = sum(enrolled)) %>% 
  mutate(perEnroll = round(100 * enrolled/total_enrolled, 1), 
         perPersist = round(100 * persisted/enrolled, 1))
)
  
```

```{r E3createTables, results='markup'}
# // Step 4: Create tables
chart4year %>% arrange(-enrolled) %>% 
  select(first_college_name_4yr, enrolled, perEnroll, persisted, perPersist) %>%
  head(num_inst) %>%
    kable(., col.names = c("Name", "Number Enrolled", 
                         "% Enrolled", "Number Persisted", 
                         "% Persisted"))

chart2year %>% arrange(-enrolled) %>% 
  select(first_college_name_2yr, enrolled, perEnroll, persisted, perPersist) %>%
  head(num_inst) %>%
  kable(., col.names = c("Name", "Number Enrolled", 
                         "% Enrolled", "Number Persisted", 
                         "% Persisted"))

```

\vfill

Last updated January 2017.

© 2016 President and Fellows of Harvard College.