NCF Metrics

New College Metric Scores
1. enrolled/employed	0	0	10	1	10	0	0-7
2. median salary	3	10	4	4	10	10	6-8
3. net cost of degree	0	10	10	10	10	10	10
4. 4-year grad rate	10	4	10	10	10	10	6
5. retention rate	3	6	1	0	10	2	0-1
6. UG PSEs	5	10	10	9	10	10	7-8
7. Pell recipients	10	8	6	7	7	6	7
8a: Graduate degrees in PSEs
8b. Top 10% first-years	8	7	4	6	0	5	0
9. % without excess hours	10	10	10	10	10
9a. 2-year transfer grad rate						0	0
9b. 6-year Pell grad rate						1	4
10. 3+ HIPs	10	10	10	10	10	10	10
Final Score	59	75	75	67	87	64	50-61
New College PBF Metric Scores
1. enrolled/employed	0	0	0	0	0	0	1	10	10	1	0	1	6	10	10	0	0	0	0-1	0-7	0-7
2. median salary	3	0	3	4	10	10	4	1	4	4	0	4	5	10	10	8	10	10	6-8	0-8	6-8
3. net cost of degree	0	0	0	10	10	10	10	0	10	10	10	10	10	10	10	10	10	10	10	?	10
4. 4-year grad rate	10	2	10	4	0	4	10	2	10	10	4	10	10	4	10	10	0	10	6	2	6
5. retention rate	3	2	3	5	6	6	1	0	1	0	0	0	6	10	10	2	0	2	0-1	0	0-1
6. UG PSEs	5	0	5	8	10	10	10	10	10	9	0	9	10	9	10	10	10	10	7-8	0	7-8
7. Pell recipients	10	2	10	8	0	8	6	2	6	7	7	7	7	0	7	6	0	6	7	4	7
8a. Graduate PSEs
8b. Top 10% first-years	8	8	8	7	0	7	4	0	4	5	6	6	0	0	0	0	5	5	0	0	0
9. % without excess hours	10	0	10	10	0	10	10	1	10	10	0	10	10	7	10
9a. 2-year transfer grad rate																0	0	0	0	0	0
9b. 6-year Pell grad rate																1	0	1	4	2	4
10. 3+ HIPs	10	0	10	10	0	10	10	0	10	10	0	10	9	10	10	10	10	10	10	10	10
sum	—	—	59	—	—	75	—	—	75	—	—	67	—	—	87	—	—	64	—	—	—
graduates	2016	2017	2018	2022
excellence	1	1	6	0-1
improvement	10	0	10	0-7
score	10	1	10	0-7
graduates	2016	2017	2018	2019	proj
excellence	4	4	5	8	6-8
improvement	1	0	10	10	0-8
score	4	4	10	10	6-8
graduates	2017	2018	2019	2020	proj
excellence	10	10	10	10	10
improvement	0	10	10	10	0
score	10	10	10	10	10
graduates	2017	2018	2019	2020	proj
excellence	10	10	10	10	6
improvement	2	4	4	0	2
score	10	10	10	10	6
1st year	2016	2018	2019	proj
excellence	1	6	2	0-1
improvement	0	10	0	0
score	1	10	2	0-1
Spring	2017	2018	2019	2020	proj
excellence	10	9	10	10	7-8
improvement	10	0	9	10	0
score	10	9	10	10	7-8
graduates	2016	2017	2018	2019	proj
excellence	6	7	7	6	7
improvement	2	7	0	0	4
score	6	7	7	6	7
graduates	2017	2018	2020
excellence	4	5	0
improvement	0	6	5
score	4	6	5
graduates	2020	proj
excellence	0	0
improvement	0	0
score	0	0
graduates	2020	proj
excellence	1	0
improvement	0	0
score	1	0
Year	2015	2016	2017	2018	2019	2020	2021	2022
FTIC graduates	155	138	135	152	178	152	131
Capstone/Thesis	155	138	135	152	178	152	131
Internships	44	71	59	74	73	54	49
Study Abroad	30	26	22	17	32	22	15
Writing-intensive courses	55	47	68	109	124	117	115
Living-learning Communities	4	17	41	59	77	91	71
Externally-funded faculty research	3	6	11	12	15	14	10
First-year experience	0	0	0	0	0	0	0
Learning communities	0	0	0	0	0	0	0
Service learning	0	0	0	0	0	0	1
Collaborative projects	0	0	0	0	48	92	87
:———————————–	—:	—:	—:	—:	—:	—:	—:	—:
# completing exactly 1 HIP	54	34	19	12	14	5	1
# completing exactly 2 HIPs	68	51	53	52	47	16	8
# completing 3+ HIPs	33	53	63	88	117	131	122
PBF Metrics
1	Percent of Bachelor's Graduates Enrolled or Employed ($30,000+) in the U.S. One Year After Graduation
2	Median Wages of Bachelor’s Graduates Employed Full-time One Year After Graduation
3	Average Cost to the Student [Net Tuition & Fees per 120 Credit Hours for Resident Undergraduates]
4	Four Year FTIC Graduation Rate
5	Academic Progress Rate (2nd year retention with GPA above 2.0)
6	Bachelor’s Degrees within Programs of Strategic Emphasis
7	University Access Rate (Percent of Undergraduates with a Pell Grant)
8b	Freshmen in Top 10% of Graduating High School Class
9a	2-year graduation rate for full-time FCS AA Transfers
9b	6-year graduation rate for students who receive Pell grants in their first year
10	Percent of FTIC graduates completing 3 or more High-Impact Practices
Why are there 11 metrics? Metrics 9a and 9b are new 5-point metrics for 2021-22. Is there a metric 8a? Yes, but it does not apply to New College... yet.
---
title: "NCF Metrics"
output: 
  flexdashboard::flex_dashboard:
    theme: spacelab
    vertical_layout: fill
    navbar:
      - { title: "BOG PBF Info", href: "https://www.flbog.edu/finance/performance-based-funding/", align: right }
    source_code: embed
    self_contained: TRUE
---


```{r packages, include=FALSE, message=FALSE, warning=FALSE}
# Load packages
library(flexdashboard)
library(googlesheets4)
library(tidyverse)
library(ggiraph)
library(scales)
library(kableExtra)
library(gt)
library(htmltools)
library(highcharter)
# library(plotly)
```

```{r parameters, include=FALSE}
## Select year of most recent (and oldest) data
yearold <- 2012
yearnew <- 2021
yearend <- 2028
```

```{r themes, include=FALSE}
# ggplot theme
custom_plot <- list(
    theme(
    plot.title = element_text(color="#000000", size=15),
    axis.title.x = element_text(color="grey50", size=14),
    axis.title.y = element_text(color="grey50", size=14),
    axis.text.x = element_text(color="grey50", size=14),
    axis.text.y = element_text(color = "grey50", size=14),
    legend.position = "none",
    panel.grid.major = element_line(colour = "white"),
    panel.grid.minor = element_blank(),
    panel.background = element_rect(fill = "grey95"))
)

# Create the benchmark ribbons (RYG)
benchmark_ribbons <- list(geom_ribbon(data = . %>% filter(unitid==262129),
                                      aes(x = datayear, ymin = 0, ymax=b1), fill = "#D6641E", alpha=0.2), 
                          geom_ribbon(data = . %>% filter(unitid==262129),
                                      aes(x = datayear, ymin = b7, ymax=b10), fill = "#F0E54B", alpha=0.2), 
                          geom_ribbon(data = . %>% filter(unitid==262129),
                                      aes(x = datayear, ymin = b10, ymax=100000), fill = "#2B9F78", alpha=0.2))
```

```{r googlesheets4, include=FALSE, warning=FALSE, message=FALSE}
# Set ID for datafile (allow anyone with link)
GSid <- "1LaShcPHxKVdnNB00EZ5WNo6UW2eRCF83Zx__5ojbYdM"
# Download GSheet
gs4_deauth() 
gs4_get(GSid)
```

```{r data, include=FALSE, error=FALSE, warning=FALSE}
# Load names, years, and benchmarks
m_info <- read_sheet(GSid, sheet = "info", skip = 0, n_max = 200,
                     col_names=TRUE, col_types = "cccccnnccnnnnnnnnnnn")

# Separate into data frames
metric_names <- m_info %>%
  select(metric1:name_long) %>%
  rename(metric = metric1) %>%
  filter(!is.na(metric))

years <- m_info %>%
  select(metric2:fundingyear) %>%
  rename(metric = metric2) %>%
  filter(!is.na(metric))

benchmarks <- m_info %>%
  select(metric3:b10) %>%
  rename(metric = metric3, 
         datayear = datayear2) %>%
  filter(!is.na(datayear))

# Load enrollment, rank, and satisfaction
m_res <- read_sheet(GSid, sheet = "rank_enroll_satisfaction", skip = 0, n_max = 200,
                     col_names=TRUE, col_types = "nnncnnnccncnnn")

# Separate into data frames
enroll <- m_res %>%
  select(year1:Goal) %>%
  rename(year = year1) %>%
  pivot_longer(-year, names_to = "type", values_to = "students") %>%
  filter(!is.na(year))

rank <- m_res %>%
  select(year2:WM) %>%
  rename(year = year2) %>%
  pivot_longer(-year, names_to = "source", values_to = "ranking") %>%
  filter(!is.na(year))

satisfaction <- m_res %>%
  select(year3:interpolated) %>%
  rename(year = year3) %>%
  filter(!is.na(year))

# Total scores
total <- read_sheet(GSid, sheet = "score", skip = 0, col_names=TRUE, col_types="cncnnnnnn") %>%
  arrange(year)

total_wide <- total %>%
  pivot_wider(id_cols = c(metric, school),
              names_from = year,
              values_from = c(excellence, improvement, score))

# Calculate total excellence and improvement scores
total_score <- total %>%
  mutate(school = factor(school)) %>%
  group_by(school, year) %>%
  summarize(excellence = sum(excellence, na.rm=T),
            improvement = sum(improvement, na.rm=T),
            score = sum(score, na.rm=T),
            excPLUSimp = excellence+improvement) %>%
  arrange(desc(score))

# Pivot longer
total_score_long <- total_score %>%
  pivot_longer(-c("school", "year"), names_to="type", values_to="score") %>%
  # Change type for the most recent year (to color it in plot)
  mutate(type = case_when(
    year == 2021 & type == "excellence" ~ "zexcellence",
    year == 2021 & type == "improvement" ~ "zimprovement",
    year == 2021 & type == "score" ~ "zscore",
    year < 2021 & type == "excellence" ~ "excellence",
    year < 2021 & type == "improvement" ~ "improvement",
    year < 2021 & type == "score" ~ "score",
    type == "excPLUSimp" ~ "excPLUSimp"
  ))

total_score_long_2 <- total_score %>%
  pivot_longer(-c("school", "year"), names_to="type", values_to="score")


# Load metrics performance
metrics_unprocessed <- read_sheet(GSid, sheet = "unprocessed", skip = 0,
                      col_names=TRUE, col_types = "cnccnnnnnnnnnnnnnn") %>%
  filter(!is.na(metric)) %>%
  pivot_longer(
    cols = starts_with("20"),
    names_to = "datayear",
    values_to = "outcome") %>%
  mutate(datayear = as.numeric(datayear)) %>%
  arrange(metric, school, datayear)

extrastuff <- read_sheet(GSid, sheet = "extrastuff", skip = 0,  
                          col_names=TRUE, col_types = "cnnnnncnnnnn")

# Join into complete dataset
PBF <- metrics_unprocessed %>% 
  full_join(benchmarks, by = c("metric", "datayear")) %>% 
  full_join(metric_names) %>% 
  full_join(years) %>%
  # Add group minimums and maximums
  group_by(metric, group, datayear) %>%
  mutate(min_outcome = min(outcome, na.rm=T),
         max_outcome=max(outcome, na.rm=T),
         median_outcome=median(outcome, na.rm=T),
         min_outcome = na_if(min_outcome, "Inf"),   # Replace infinity with
         min_outcome = na_if(min_outcome, "-Inf"),  # missing values.
         max_outcome = na_if(max_outcome, "Inf"),   # When all data were missing
         max_outcome = na_if(max_outcome, "-Inf"),
         median_outcome = na_if(median_outcome, "Inf"))  # the min/max are infinity.

# Full retention data
retain <- read_sheet(GSid, sheet = "retain", skip = 0,
                     col_names=TRUE, col_types = "nccnnnnnnnnnnnnnnnnnnnnnnnnnnn") %>%
    pivot_longer(cols = c(-unitid, -school, -group, -peer), 
                 names_to = "datayear", values_to = "outcome") %>%
  mutate(datayear = as.numeric(datayear)) %>%
  arrange(school, datayear) %>%
  add_column(metric = as.character(5)) %>% 
  full_join(benchmarks, by = c("metric", "datayear")) %>% 
  full_join(metric_names) %>% 
  full_join(years) %>%
  # Add group minimums and maximums
  group_by(group, datayear) %>%
  mutate(min_outcome = min(outcome, na.rm=T),
         max_outcome=max(outcome, na.rm=T),
         median_outcome=median(outcome, na.rm=T),
         min_outcome = na_if(min_outcome, "Inf"),   # Replace infinity with
         min_outcome = na_if(min_outcome, "-Inf"),  # missing values.
         max_outcome = na_if(max_outcome, "Inf"),   # When all data were missing
         max_outcome = na_if(max_outcome, "-Inf"),
         median_outcome = na_if(median_outcome, "Inf"))  # the min/max are infinity.

# Full grad rate data
grad <- read_sheet(GSid, sheet = "grad", skip = 0,
                     col_names=TRUE, col_types = "cnccnnnnnnnnnnnnnnnnnnnnnnnnnnnn") %>%
    pivot_longer(cols = c(-metric, -unitid, -school, -group, -peer), 
                 names_to = "datayear", values_to = "outcome") %>%
  mutate(datayear = as.numeric(datayear)) %>%
  arrange(school, datayear) %>%
  full_join(benchmarks, by = c("metric", "datayear")) %>% 
  full_join(metric_names) %>% 
  full_join(years) %>%
  # Add group minimums and maximums
  group_by(group, datayear) %>%
  mutate(min_outcome = min(outcome, na.rm=T),
         max_outcome=max(outcome, na.rm=T),
         median_outcome=median(outcome, na.rm=T),
         min_outcome = na_if(min_outcome, "Inf"),   # Replace infinity with
         min_outcome = na_if(min_outcome, "-Inf"),  # missing values.
         max_outcome = na_if(max_outcome, "Inf"),   # When all data were missing
         max_outcome = na_if(max_outcome, "-Inf"),
         median_outcome = na_if(median_outcome, "Inf"))  # the min/max are infinity.

# Full Pell rate data
pell <- read_sheet(GSid, sheet = "pell", skip = 0,
                     col_names=TRUE, col_types = "cnccnnnnnnnnnnnnnnnnnnnnnn") %>%
    pivot_longer(cols = c(-metric, -unitid, -school, -group, -peer), 
                 names_to = "datayear", values_to = "outcome") %>%
  mutate(datayear = as.numeric(datayear)) %>%
  arrange(school, datayear) %>%
  full_join(benchmarks, by = c("metric", "datayear")) %>% 
  full_join(metric_names) %>% 
  full_join(years) %>%
  # Add group minimums and maximums
  group_by(group, datayear) %>%
  mutate(min_outcome = min(outcome, na.rm=T),
         max_outcome=max(outcome, na.rm=T),
         median_outcome=median(outcome, na.rm=T),
         min_outcome = na_if(min_outcome, "Inf"),   # Replace infinity with
         min_outcome = na_if(min_outcome, "-Inf"),  # missing values.
         max_outcome = na_if(max_outcome, "Inf"),   # When all data were missing
         max_outcome = na_if(max_outcome, "-Inf"),
         median_outcome = na_if(median_outcome, "Inf"))  # the min/max are infinity.

# Create data frame of all metric scores
metric_scores <- total %>%
  select(-(excellence2020:score2020)) %>%
  mutate(metric =  factor(metric, levels = c("1", "2", "3", "4", "5", "6", "7", "8a", "8b", "9", "9a", "9b", "10"))) %>%
  arrange(school, metric) %>%
  pivot_wider(id_cols = c(school, metric), names_from = c(year), values_from = c(excellence, improvement, score))

# Create data frame of all total scores
tsw <- total_score %>%
  filter(year == 2021) %>%
  pivot_wider(id_cols = c(school), names_from = c(year), values_from = c(excellence, improvement, score, excPLUSimp)) %>%
  rename("exc" = "excellence_2021",
         "imp" = "improvement_2021",
         "sum" = "excPLUSimp_2021",
         "score" = "score_2021") %>%
  select(school, exc, imp, sum, score) %>%
  arrange(score)

# Create data frame of NCF total scores
sus_scores <- total_score %>%
  pivot_longer(cols = c(excellence, improvement, excPLUSimp, score), names_to= "type", values_to="score") %>%
  mutate(type = case_when(
    type == "excellence" ~ "Excellence Points",
    type == "improvement" ~ "Improvement Points",
    type == "excPLUSimp" ~ "Excellence + Improvement",
    type == "score" ~ "Final Score"
  )) %>%
  pivot_wider(id_cols = c(school, type), names_from = c(year), values_from = c(score)) %>%
  relocate("school", "type", "2016", "2017", "2018", "2019", "2020", "2021")

sus_2021 <- sus_scores %>%
  select(school, type, "2021") %>%
  pivot_wider(id_cols = c("type"), names_from = c(school), values_from = c("2021")) %>%
  # Reorder to match plot
  relocate("type", "FIU", "USF", "FSU", "UCF", "UF", "FAU", "FPU", 
           "UWF", "FGCU", "FAMU", "UNF", "NCF") %>%
  rename("PBF Score" = "type")

rm(m_info, m_res, metrics_unprocessed)

# Load enrollment, rank, and satisfaction
m_res <- read_sheet(GSid, sheet = "rank_enroll_satisfaction", skip = 0, n_max = 200,
                     col_names=TRUE, col_types = "nnncnnnccncnnn")

# Separate into data frames
enroll <- m_res %>%
  select(year1:Goal) %>%
  rename(year = year1) %>%
  pivot_longer(-year, names_to = "type", values_to = "students") %>%
  filter(!is.na(year))

rank <- m_res %>%
  select(year2:WM) %>%
  rename(year = year2) %>%
  pivot_longer(-year, names_to = "source", values_to = "ranking") %>%
  filter(!is.na(year))

satisfaction <- m_res %>%
  select(item:interpolated) %>%
  rename(year = year3) %>%
  filter(!is.na(year))



```



SP {data-orientation=rows data-icon="fa-question-circle" style="position:relative;"}
=======================================================================

Row {data-height=1}
-----------------------------------------------------------------------
### **Why?**New College of Florida prepares intellectually curious students for lives of great achievement.

Row {data-height=285}
-----------------------------------------------------------------------
### **Where?**Top 20 liberal arts college in the nation.{data-padding=8}


```{r ranking, fig.width=17, fig.height=5}
poly <- tibble(
  year = c(2006, 2040, 2040, 2006, 2006),
  ranking = c(20, 20, 1, 1, 20))

highchart() %>%
  hc_chart(plotBackgroundColor="rgba(235,235,235,0.9") %>%
  hc_legend(enabled = FALSE) %>%
  hc_xAxis(min = 2004.8, max = 2040, tickInterval = 2, endOnTick = FALSE, description = "Year",
           gridLineColor="white", minorGridLineColor="white", minorTicks=TRUE, minorTickInterval=2,
           labels = list(enabled=TRUE, style = list(fontSize = "12px", color = "grey")),
           title = list(style = list(fontSize = "16px", fontWeight = "bold", 
                                     color = "rgba(100,100,100,1"))) %>%
  hc_yAxis(min = 1, max = 150, tickInterval = 20, endOnTick = FALSE, description = "national ranking",
           gridLineColor="white", minorGridLineColor="white", startOnTick=FALSE, floor=1,
           minorTicks = TRUE, minorTickInterval = 20, reversed=TRUE, rotate=90,
           title = list(text = "National Ranking", style = list(fontSize = "14px",
                                                                color = "rgba(100,100,100,1)")),
           labels = list(enabled=TRUE, x=-5, style = list(fontSize = "13px", color = "grey"))) %>%
  hc_add_series(poly, type = 'polygon', hcaes(x=year, y=ranking), 
                color = list(linearGradient = list(x1=0, y1=0, x2=1, y2=0),
                             stops = list(
                               list(0, "transparent"),
                               list(0.1, "rgba(249,217,73,0.1)"),
                               list(0.5, "rgba(249,217,73,0.5)"),
                               list(1, "rgba(249,217,73,0.9)")
                             )), enableMouseTracking = FALSE) %>%
  hc_add_series(filter(rank, source=="USnews"), "line", marker = list(symbol="circle"), 
                hcaes(x = year, y = ranking), lineWidth=4, color="#0066CC", name = "US News Ranking") %>%
  hc_add_series(filter(rank, source=="USnews" & year==2021), "scatter", hcaes(x = year, y = ranking),
                color="#0066CC", marker = list(radius=3, symbol="circle"), 
                name = "US News Ranking", enableMouseTracking = FALSE,
                dataLabels = list(enabled = TRUE, backgroundColor = "#0066CC", color="white",
                                  verticalAlign="middle", padding=2, crop=FALSE, overflow="allow",
                                  style = list(fontSize = "13px", textOutline=0))) %>%
  hc_add_series(filter(rank, source=="WM"), "line", marker = list(symbol="circle"), 
                hcaes(x = year, y = ranking), lineWidth=4, color="rgb(125,125,125)", 
                name = "Washington Monthly") %>%
  hc_add_series(filter(rank, source=="WM" & year==2021), "scatter", hcaes(x = year, y = ranking),
                color="rgb(125,125,125)", marker = list(radius=3, symbol="circle"),
                name = "Washington Monthly", enableMouseTracking = FALSE,
                dataLabels = list(enabled = TRUE, backgroundColor = "rgb(125,125,125)", color="white",
                                  verticalAlign="middle", padding=2, crop=FALSE, overflow="allow",
                                  style = list(fontSize = "13px", textOutline=0))) %>%
  hc_add_annotation(labels = list(list(align="left", backgroundColor="rgba(0,0,0,0)", borderWidth=0,
                                       borderColor="#0066CC", padding=3, shadow=FALSE, 
                                       verticalAlign="bottom", allowOverlap=TRUE, y=10, x=10,
                                       point = list(xAxis = 0, yAxis = 0, x = 2021.5, y = 82),
                                       text = "US News", 
                                       style=list(color="#0066CC", fontSize="14px")))) %>%
  hc_add_annotation(labels = list(list(align="left", backgroundColor="rgba(0,0,0,0)",
                                       borderWidth=0, borderColor="rgba(125,125,125,.8)", 
                                       padding=3, shadow=FALSE, verticalAlign="bottom", 
                                       allowOverlap=TRUE, y=10, x=10, 
                                       point = list(xAxis = 0, yAxis = 0, x = 2021.5, y = 54),
                                       text = "Washington Monthly", 
                                       style=list(color="rgb(125,125,125)", fontSize="14px")))) %>%
  hc_add_annotation(labels = list(list(align="left", backgroundColor="rgba(0,0,0,0)", borderWidth=0,
                                       padding=3, shadow=FALSE, verticalAlign="top", horizontalAlign="right",
                                       allowOverlap=TRUE, y=0, x=10,
                                       point = list(xAxis = 0, yAxis = 0, x = 2039, y = 5),
                                       text = "long-term goal: top 20", style=list(color="#000000",
                                                                           fontSize="14px"))))

```


Row {data-height=335 style="height:10pc"}
-----------------------------------------------------------------------
### **What?**1200 students by 2025? {data-width=50 data-padding=3}



```{r enrollmentgoals, fig.width=9, fig.height=5}

poly <- tibble(
  year = c(2004, 2020, 2020, 2004, 2004),
  students = c(690, 855, 1016, 755, 690))

project <- tibble(
  year = c(2017:2025),
  students_growth = c(875, 900, 950, 1025, 1100, 1200, NA, NA, NA),
  students_sp = c(NA, NA, 860, 900, 975, 1075, 1200, NA, NA),
  students_new = c(NA, NA, NA, NA, 620, 630, 665, 700, 750)
)

highchart() %>%
  hc_chart(plotBackgroundColor="rgba(235,235,235,1") %>%
  hc_legend(enabled = FALSE) %>%
  hc_xAxis(min = 2003.8, max = 2026.5, tickInterval = 2, endOnTick = FALSE, description = "year",
           gridLineColor="white", minorGridLineColor="white", minorTicks=TRUE, minorTickInterval=2,
           labels = list(enabled=TRUE, style = list(fontSize = "12px", color = "grey")),
           title = list(style = list(fontSize = "16px", fontWeight = "bold", 
                                     color = "rgba(100,100,100,1"))) %>%
  hc_yAxis(min = 600, max = 1250, tickInterval = 100, endOnTick = FALSE, description = "enrollment",
           gridLineColor="white", minorGridLineColor="white", minorTicks=TRUE, minorTickInterval=1,
           title = list(text = "enrollment", style = list(fontSize = "14px", 
                                                          color = "rgba(100,100,100,1)")),
           labels = list(enabled=TRUE, x=-5, style = list(fontSize = "13px", color = "grey"))) %>%
  hc_add_series(poly, type = 'polygon', hcaes(x=year, y=students), 
                color = hex_to_rgba("#0066CC", 0.2), enableMouseTracking = FALSE) %>%
  hc_add_series(project, "line", marker = list(symbol="circle"), 
                hcaes(x = year, y = students_growth), lineWidth=4, 
                color="#BBBBBB", name = "growth plan", dashStyle = "ShortDash") %>%
  hc_add_series(project, "line", marker = list(symbol="circle"), 
                hcaes(x = year, y = students_sp), lineWidth=4, 
                color="#AAAAAA", name = "strategic plan", dashStyle = "ShortDash") %>%
  hc_add_series(project, "line", marker = list(symbol="circle"), 
                hcaes(x = year, y = students_new), lineWidth=4, 
                color="#AAAAAA", name = "2021 Accountability Plan", dashStyle = "ShortDash") %>%
  hc_add_series(filter(enroll, type=="NCF"), "line", marker = list(symbol="circle"), 
                hcaes(x = year, y = students), lineWidth=4, color="#0066CC", name = "students") %>%
  hc_add_series(filter(enroll, type=="NCF" & year==2021), "scatter", hcaes(x = year, y = students),
              color="#0066CC", marker = list(radius=3, symbol="circle"), name = "students",
              enableMouseTracking = FALSE, 
              dataLabels = list(enabled = TRUE, backgroundColor = "#0066CC", color="white",
                                verticalAlign="middle", padding=2, crop=FALSE, overflow="allow",
                                style = list(fontSize = "13px", textOutline=0))) %>%
  # hc_add_series(filter(enroll, type=="Goal" & year <= 2020), "line", hcaes(x = year, y = students), name="goal",
  #               marker = list(enabled=FALSE), lineWidth=4, color="rgba(150,150,150,1)") %>%
  # hc_add_series(filter(enroll, type=="Goal" & year >2020 & year <= 2024), "line", hcaes(x = year, y = students), 
  #               marker = list(enabled=FALSE), lineWidth=4, color="rgba(150,150,150,1)", name = "goal",
  #               dataLabels = list(enabled = TRUE, backgroundColor = "rgba(150,150,150,1)", color="rgba(255,255,255,1)",
  #                                 verticalAlign="middle", padding=2, crop=FALSE, overflow="allow",
  #                                 allowOverlap=TRUE, style = list(fontSize = "13px", textOutline=0))) %>%
  hc_add_series(project, "line", hcaes(x = year, y = students_new),
                lineWidth=4, color="rgba(249,217,73,1)", name = "goal",
                dataLabels = list(enabled = TRUE, backgroundColor = "rgba(249,217,73,1)",
                                  color="rgba(50,50,50,1)", verticalAlign="middle", padding=2, crop=FALSE,
                                  overflow="allow", borderWidth=1, borderColor="rgb(50,50,50)",
                                  style = list(fontSize = "13px", textOutline=0))) %>%
  # hc_add_annotation(labels = list(list(align="left", backgroundColor="rgba(0,0,0,0)", borderWidth=0,
  #                                      padding=3, shadow=FALSE, verticalAlign="top", horizontalAlign="right",
  #                                      allowOverlap=TRUE, y=0, x=10,
  #                                      point = list(xAxis = 0, yAxis = 0, x = 2025, y = 800),
  #                                      text = "Goals", style=list(color="rgba(50,50,50,1)",
  #                                                                          fontSize="14px")))) %>%
  hc_add_annotation(labels = list(list(align="left", backgroundColor="rgba(0,0,0,0)", borderWidth=0,
                                       padding=3, shadow=FALSE, verticalAlign="top", horizontalAlign="right",
                                       allowOverlap=TRUE, y=0, x=10,
                                       point = list(xAxis = 0, yAxis = 0, x = 2022.5, y = 1100),
                                       text = "SP", style=list(color="#AAAAAA",
                                                                           fontSize="14px")))) %>%
  hc_add_annotation(labels = list(list(align="right", backgroundColor="rgba(0,0,0,0)", borderWidth=0,
                                       padding=3, shadow=FALSE, verticalAlign="top", horizontalAlign="right",
                                       allowOverlap=TRUE, y=0, x=10,
                                       point = list(xAxis = 0, yAxis = 0, x = 2020.5, y = 1170),
                                       text = "Growth", style=list(color="#BBBBBB",
                                                                           fontSize="14px"))))

```


### **What?**80% 4-year grad rate {data-width=50 data-padding=3}



```{r gradrategoals, fig.width=6, fig.height=4}

polygrad <- tibble(
  year = c(2005, 2021, 2021, 2005, 2005),
  rate = c(43, 54, 73, 55, 43))

highchart() %>%
    hc_chart(plotBackgroundColor="rgba(235,235,235,1") %>%
    hc_legend(enabled = FALSE) %>%
    hc_xAxis(min = 2003.8, max = 2029, tickInterval = 2, endOnTick = FALSE, description = "year",
           gridLineColor="white", minorGridLineColor="white", minorTicks=TRUE, minorTickInterval=2,
           labels = list(enabled=TRUE, style = list(fontSize = "12px", color = "grey")),
           title = list(style = list(fontSize = "16px", fontWeight = "bold", 
                                     color = "rgba(100,100,100,1"))) %>%
    hc_yAxis(min = 20, max = 101, tickInterval = 20, endOnTick = FALSE, 
             description = "4-year graduation rate", gridLineColor="white", minorGridLineColor="white",
             startOnTick=FALSE, floor=1, minorTicks = TRUE, minorTickInterval = 20, reversed=FALSE,
             title = list(text = "4-year graduation rate", 
                          style = list(fontSize = "14px", color = "rgba(100,100,100,1)")),
             labels = list(enabled=TRUE, x=-5, style = list(fontSize = "13px", color = "grey"))) %>%
    hc_add_series(polygrad, type = 'polygon', hcaes(x=year, y=rate), 
                  color = hex_to_rgba("#0066CC", 0.2), enableMouseTracking = FALSE) %>%
    hc_add_series(filter(grad, unitid==262129), "line", marker = list(symbol="circle"), 
                  hcaes(x = datayear, y = outcome), lineWidth=4, color="#0066CC", name = "NCF") %>%
    hc_add_series(filter(grad, group=="Top25" & datayear>2003), "line", marker = list(enabled=FALSE), 
                  hcaes(x = datayear, y = outcome, group=unitid), lineWidth=1, color="rgba(25,25,25,.15)", 
                  name = "Top 25 Liberal Arts", enableMouseTracking = FALSE) %>%
    hc_add_series(filter(grad, unitid==999999 & datayear > 2021), "line", marker = list(enabled=FALSE), 
                  hcaes(x = datayear, y = outcome), lineWidth=3, color="rgba(150,150,150,1)", name = "Goal") %>%
    hc_add_series(filter(grad, unitid==999999 & datayear%%2==0 & datayear<2028 & datayear>2020), "scatter", 
                  hcaes(x = datayear, y = outcome), color="rgba(150,150,150,1)", marker = list(enabled=FALSE), 
                  name = "Goal", enableMouseTracking = FALSE,
                  dataLabels = list(enabled = TRUE, backgroundColor = "rgba(150,150,150,1)", color="rgba(255,255,255,1)",
                                    verticalAlign="middle", padding=3, crop=FALSE, overflow="allow",
                                    style = list(fontSize = "13px", textOutline=0))) %>%
    hc_add_series(filter(grad, unitid==999999 & datayear==2028), "scatter", hcaes(x = datayear, y = outcome),
                  color="rgb(180,180,180)", marker = list(enabled=FALSE), name = "Goal", 
                  enableMouseTracking = FALSE,
                  dataLabels = list(enabled = TRUE, backgroundColor = "rgba(249,217,73,1)",
                                    color="rgb(50,50,50)", borderWidth=1, borderColor="rgb(50,50,50)",
                                    verticalAlign="middle", padding=3, crop=FALSE, overflow="allow",
                                    style = list(fontSize = "13px", textOutline=0))) %>%
    hc_add_series(filter(grad, unitid==262129 & datayear==2021), "scatter", hcaes(x = datayear, y = outcome),
                  color="#0066CC", marker = list(enabled=FALSE), name = "Goal", 
                  enableMouseTracking = FALSE,
                  dataLabels = list(enabled = TRUE, backgroundColor = "#0066CC", color="white",
                                    verticalAlign="middle", padding=3, crop=FALSE, overflow="allow",
                                    style = list(fontSize = "13px", textOutline=0), 
                                    format="{point.y:.1f}")) %>%
    hc_add_annotation(labels = list(list(align="left", backgroundColor="rgba(0,0,0,0)", 
                                         borderWidth=0, borderColor="#0066CC", padding=3, 
                                         shadow=FALSE, verticalAlign="bottom", allowOverlap=TRUE, 
                                         y=10, x=0,
                                         point = list(xAxis = 0, yAxis = 0, x = 2017, y = 85.5),
                                         text = "Top 25 Liberal Arts Schools",
                                         style=list(color="rgb(50,50,50)", fontSize="14px"))))

```







PBF  {.storyboard data-icon="fa-tachometer-alt"}
=======================================================================

### Overall Score Trend

#### Total PBF Scores

```{r total_scores_plot, warning=FALSE, message=FALSE}

# Calculate SUS minimum and maximum
ts3 <- total_score_long_2 %>%
  filter(type == "score",
         school != "NCF") %>%
  group_by(year) %>%
  mutate(min_outcome = min(score, na.rm=T),
         max_outcome=max(score, na.rm=T),
         median_outcome=median(score, na.rm=T),
         min_outcome = na_if(min_outcome, "Inf"),   # Replace infinity with
         min_outcome = na_if(min_outcome, "-Inf"),  # missing values.
         max_outcome = na_if(max_outcome, "Inf"),   # When all data were missing
         max_outcome = na_if(max_outcome, "-Inf"),
         median_outcome = na_if(median_outcome, "Inf")) %>%
  select(year, min_outcome, max_outcome, median_outcome) %>%
  distinct() %>%
  mutate(school = "who_cares?")

# Plot total scores

tsplot <- total_score_long_2 %>%
  filter(type == "score") %>%
  mutate(NCF = case_when(school == "NCF" ~ 1,
                         TRUE ~ 0)) %>%
  ggplot(aes(x = year, y = score, group = school)) +
  # benchmark ribbons +
  # geom_line(data = ts3,
  #             aes(x = year, y = min_outcome), color="black", alpha=0.8, size=0.25) +
  # geom_line(data = ts3,
  #             aes(x = year, y = max_outcome), color="black", alpha=0.8, size=0.25) +
  geom_ribbon(data = ts3,
              aes(x = year, y = min_outcome, ymin=min_outcome, ymax=max_outcome), fill="black", alpha=0.05) +
  # annotate("text", x = 2018.5, y = 78, 
  #          label="other Florida SUS schools", color="#000000", size=4.5) +
  geom_line(data = . %>% filter(school == "FAMU"), aes(x = year, y = score), color="#ee7624", alpha=0.3, size=0.5) +
  geom_line(data = . %>% filter(school == "FAU" ), aes(x = year, y = score), color="#003366", alpha=0.3, size=0.5) +
  geom_line(data = . %>% filter(school == "UWF" ), aes(x = year, y = score), color="#004C97", alpha=0.3, size=0.5) +
  geom_line(data = . %>% filter(school == "UCF" ), aes(x = year, y = score), color="#FFc904", alpha=0.3, size=0.5) +
  geom_line(data = . %>% filter(school == "FIU" ), aes(x = year, y = score), color="#081E3F", alpha=0.3, size=0.5) +
  geom_line(data = . %>% filter(school == "UNF" ), aes(x = year, y = score), color="#004C97", alpha=0.3, size=0.5) +
  geom_line(data = . %>% filter(school == "USF" ), aes(x = year, y = score), color="#006747", alpha=0.3, size=0.5) +
  geom_line(data = . %>% filter(school == "UF"  ), aes(x = year, y = score), color="#FA4616", alpha=0.3, size=0.5) +
  geom_line(data = . %>% filter(school == "FSU" ), aes(x = year, y = score), color="#782F40", alpha=0.3, size=0.5) +
  geom_line(data = . %>% filter(school == "FPU" ), aes(x = year, y = score), color="#532d8e", alpha=0.3, size=0.5) +
  geom_line(data = . %>% filter(school == "FGCU"), aes(x = year, y = score), color="#007749", alpha=0.3, size=0.5) +
  # Add temporary BOG points
  annotate("segment", x = 2021, xend = 2021, y = 64, yend = 71, color = "#003087", size=0.5, 
           linetype="dotted", linejoin = "round", arrow=arrow(length = unit(0.5, "cm"))) +
  geom_label(data = tibble(year = 2021, score = 73, school = "NCF"), aes(label = score),
           size=5.5, fill="#003087", color="#FFFFFF", alpha = 0.5,
           label.padding = unit(0.2, "lines"), label.size = 0.1) +
  geom_line(data = . %>% filter(NCF == 1), color="#003087", size=2) +
  geom_label(data = . %>% filter(NCF == 1),  
           aes(label = score),
           size=5.5, fill="#003087", color="white",
           label.padding = unit(0.2, "lines"), label.size = 0.1) +
  geom_label(data = . %>% filter(school == "NCF"),  
           aes(label = score),
           size=5.5, fill="#003087", color="#FFFFFF",
           label.padding = unit(0.2, "lines"), label.size = 0.1) +
  geom_label(data = . %>% filter(school == "FAMU" & year == 2021), aes(label = school),
             fill="#ee7624", color="#1b5633", alpha=0.7, size=2.5, label.padding = unit(0.15, "lines"), label.size = 0.1) +
  geom_label(data = . %>% filter(school == "FAU" & year == 2021), aes(label = school),
             fill="#CCCCCC", color="#003366", alpha=0.7, size=2.75, label.padding = unit(0.15, "lines"), label.size = 0.1) +
  geom_label(data = . %>% filter(school == "UWF" & year == 2021), aes(x = 2020.9, y = 83,label = school),
             fill="#004C97", color="#FFFFFF", alpha=0.7, size=2.75, label.padding = unit(0.15, "lines"), label.size = 0.1) +
  geom_label(data = . %>% filter(school == "UCF" & year == 2021), aes(x = 2021.1, y = 87, label = school),
             fill="#FFc904", color="#000000", alpha=0.7, size=2.75, label.padding = unit(0.15, "lines"), label.size = 0.1) +
  geom_label(data = . %>% filter(school == "FIU" & year == 2021), aes(label = school),
             fill="#081E3F", color="#B6862C", alpha=0.7, size=2.75, label.padding = unit(0.15, "lines"), label.size = 0.1) +
  geom_label(data = . %>% filter(school == "UNF" & year == 2021), aes(label = school),
             fill="#004C97", color="#FFFFFF", alpha=0.7, size=2.75, label.padding = unit(0.15, "lines"), label.size = 0.1) +
  geom_label(data = . %>% filter(school == "USF" & year == 2021), aes(label = school),
             fill="#006747", color="#CFC493", alpha=0.7, size=2.75, label.padding = unit(0.15, "lines"), label.size = 0.1) +
  geom_label(data = . %>% filter(school == "UF" & year == 2021), aes(x = 2020.9, y = 87, label = school),
             fill="#0021A5", color="#FA4616", alpha=0.7, size=2.75, label.padding = unit(0.15, "lines"), label.size = 0.1) +
  geom_label(data = . %>% filter(school == "FSU" & year == 2021), aes(label = school),
             fill="#782F40", color="#CEB888", alpha=0.7, size=2.75, label.padding = unit(0.15, "lines"), label.size = 0.1) +
  geom_label(data = . %>% filter(school == "FPU" & year == 2021), aes(x = 2021.1, y = 83,label = school),
             fill="#532d8e", color="#ffffff", alpha=0.7, size=2.75, label.padding = unit(0.15, "lines"), label.size = 0.1) +
  geom_label(data = . %>% filter(school == "FGCU" & year == 2021), aes(label = school),
             fill="#007749", color="#FFFFFF", alpha=0.7, size=2.75, label.padding = unit(0.15, "lines"), label.size = 0.1) +
  annotate("rect", xmin = 2021.5, xmax = 2023, ymin = 0, ymax=60, fill=rgb(.6156, .1333, .2039), alpha=0.35) +
  annotate("segment", x = 2021.5, xend = 2023, y = 60, yend = 60, color = "white", size=2) +
  annotate("rect", xmin = 2021.5, xmax = 2023, ymin = 60, ymax=70, fill=rgb(.9607, .8, .3686), alpha=0.5) +
  annotate("segment", x = 2021.5, xend = 2023, y = 70, yend = 70, color = "white", size=2) +
  annotate("rect", xmin = 2021.5, xmax = 2023, ymin = 70, ymax=100, fill=rgb(.5, .556, .2315), alpha=0.4) +
  annotate("text", x = 2021, y = 61, label="NCF", color="#003087", fontface="bold", size=5) +
  annotate("text", x = 2022, y = 55, label="lose $4.1M\nfrom base budget", color=rgb(.6156, .1333, .2039), size=4) +
  annotate("text", x = 2022, y = 75, label="earn $3.6M\nstate investment", color=rgb(.3645, .4053, .16876), size=4) +
  annotate("text", x = 2022, y = 65, label="earn $1.8M with\nimprovement plan", color=rgb(.28881, .24, .11058), size=4) +
  geom_line_interactive(aes(tooltip = school, data_id=school, hover_css = "fill:none;"),
                        size=1.5, alpha=0.01) +
  geom_point_interactive(data = . %>% filter(school != "NCF"), 
                        aes(tooltip = paste0(score,"
",school), data_id=school, hover_css = "fill:none;"),
                        size=3, alpha=0.01) +
  scale_x_continuous(expand = c(0,0), breaks=seq(2016, 2022, 1), 
                     minor_breaks=NULL) +
  scale_y_continuous(expand = c(0,0), breaks=seq(50, 100, 10), minor_breaks=NULL) +
  coord_cartesian(ylim = c(50,100), xlim = c(2015.7, 2022.5), expand = TRUE) +
  labs(title = NULL,
       y=NULL,
       x=NULL) +
  custom_plot

# Make it interactive
ts <- girafe(code = {print(tsplot)}, height_svg=4, width_svg=10,
              options = list(opts_sizing(rescale = TRUE, width = .8),
                             opts_tooltip(offx=-10, offy=15, 
                              css="background-color:gray;color:white;font-style:bold;padding:15px;border-radius:5px;"),
                              opts_hover(css = "stroke:#FF0000;fill:#FF0000;stroke-width:3px;stroke-opacity:0.8;")))

ts




```



#### 

```{r simple_metric_score_table}

# Create data frame of NCF total scores
ncf_scores <- total_score %>%
  filter(school == "NCF") %>%
  pivot_longer(cols = c(excellence, improvement, excPLUSimp, score), names_to= "type", values_to="score") %>%
  mutate(type = case_when(
    type == "excellence" ~ "Excellence Points",
    type == "improvement" ~ "Improvement Points",
    type == "excPLUSimp" ~ "Excellence + Improvement",
    type == "score" ~ "Final Score"
  )) %>%
  pivot_wider(id_cols = c(type), names_from = c(year), values_from = c(score)) %>%
  relocate("type", "2016", "2017", "2018", "2019", "2020")

# Create data frame for NCF metric scores + append total scores
ncf_metric_scores <- metric_scores %>%
  filter(school == "NCF", metric !="8a") %>%
  select(metric, score_2016:score_2021) %>%
  rename("type" = "metric", "2016" = "score_2016", "2017" = "score_2017",
         "2018" = "score_2018", "2019" = "score_2019", "2020" = "score_2020", "2021" = "score_2021") %>%
  bind_rows(ncf_scores) %>%
  rename("metric" = "type") %>%
  mutate(metric = case_when(metric == "1" ~ "1. enrolled/employed",
                            metric == "2" ~ "2. median salary",
                            metric == "3" ~ "3. net cost of degree",
                            metric == "4" ~ "4. 4-year grad rate",
                            metric == "5" ~ "5. retention rate",
                            metric == "6" ~ "6. UG PSEs",
                            metric == "7" ~ "7. Pell recipients",
                            metric == "8b" ~ "8b. Top 10% first-years",
                            metric == "9" ~ "9. % without excess hours",
                            metric == "9a" ~ "9a. 2-year transfer grad rate",
                            metric == "9b" ~ "9b. 6-year Pell grad rate",
                            metric == "10" ~ "10. 3+ HIPs",
                            TRUE ~ metric)) %>%
  add_column('2022' = c("0-7", "6-8", 10, 6, "0-1","7-8","7","0",NA, "0","4",10,NA, NA, NA,"50-61")) %>%
  add_row(.before = 8, metric = "8a: Graduate degrees in PSEs",
  '2016' = NA, '2017' = NA, '2018' = NA, '2019' = NA, '2020' = NA, '2021' = NA, '2022' = NA) %>%
  mutate('2022' = case_when((metric %in% c("8a: Graduate degrees in PSEs", "9: % without excess hours")) ~ NA_character_,
                            TRUE ~ `2022`))

# Create table
ncf_metric_scores %>%
  filter(!(metric %in% c("Excellence Points", "Improvement Points", "Excellence + Improvement"))) %>%
  gt() %>%
  tab_header(title = "New College Metric Scores") %>%
  tab_style(style = list(cell_borders(sides = c("left", "right"), color = "white", weight=px(1))),
            locations = list(cells_body())) %>%
  tab_style(style = list(cell_borders(sides = c("all"), color = "white", weight=px(1))),
            locations = list(cells_body(columns = c(`2016`:`2021`)))) %>%
  tab_style(style = list(cell_text(weight="bold")),
            locations = list(cells_body(columns = "2021"))) %>%
  tab_style(style = list(cell_text(color="rgba(0,0,0,.75)", weight="lighter")),
            locations = list(cells_body(columns = "2022"))) %>%
  tab_style(style = list(cell_fill(color = "rgba(0,48,135,.9)"),
                         cell_text(color="white", weight="bold")), 
            locations = cells_body(columns = c(1:8), rows = c(14))) %>%
  tab_style(style = list(cell_fill(color = "grey80")), 
            locations = cells_body(columns = c(2:6), rows = c(11:12))) %>%
  tab_style(style = list(cell_fill(color = "grey80")), 
            locations = cells_body(columns = c(2:8), rows = c(8))) %>%
  tab_style(style = list(cell_fill(color = "grey80")), 
            locations = cells_body(columns = c(7:8), rows = c(10))) %>%
  tab_style(style = list(cell_fill(color = "rgba(123,175,212,.5)"),
                         cell_text(color = "rgba(0,48,135,1)")), 
            locations = cells_body(columns=c(`2021`), 
                                   rows = `2021` == 10)) %>% 
  tab_style(style = list(cell_fill(color = "rgba(252,191,63,.5)"),
                         cell_text(color = "rgba(100,100,100,1)")), 
            locations = cells_body(columns=c(`2021`), 
                                   rows = `2021` %in% c(7, 8, 9))) %>% 
  tab_style(style = list(cell_fill(color = "rgba(124,40,85,.3)"),
                         cell_text(color = "rgba(124,40,85,.9)")), 
            locations = cells_body(columns=c(`2021`), 
                                   rows = `2021` <=6)) %>% 
  tab_style(style = list(cell_fill(color = "rgba(123,175,212,.3)"),
                         cell_text(color = "rgba(0,48,135,1)")), 
            locations = cells_body(columns=c(`2020`), 
                                   rows = `2020` == 10)) %>% 
  tab_style(style = list(cell_fill(color = "rgba(252,191,63,.3)"),
                         cell_text(color = "rgba(100,100,100,1)")), 
            locations = cells_body(columns=c(`2020`), 
                                   rows = `2020` %in% c(7, 8, 9))) %>% 
  tab_style(style = list(cell_fill(color = "rgba(124,40,85,.15)"),
                         cell_text(color = "rgba(124,40,85,.9)")), 
            locations = cells_body(columns=c(`2020`), 
                                   rows = `2020` <=6)) %>% 
  tab_style(style = list(cell_fill(color = "rgba(123,175,212,.3)"),
                         cell_text(color = "rgba(0,48,135,1)")), 
            locations = cells_body(columns=c(`2019`), 
                                   rows = `2019` == 10)) %>% 
  tab_style(style = list(cell_fill(color = "rgba(252,191,63,.3)"),
                         cell_text(color = "rgba(100,100,100,1)")), 
            locations = cells_body(columns=c(`2019`), 
                                   rows = `2019` %in% c(7, 8, 9))) %>% 
  tab_style(style = list(cell_fill(color = "rgba(124,40,85,.15)"),
                         cell_text(color = "rgba(124,40,85,.9)")), 
            locations = cells_body(columns=c(`2019`), 
                                   rows = `2019` <=6)) %>% 
  tab_style(style = list(cell_fill(color = "rgba(123,175,212,.3)"),
                         cell_text(color = "rgba(0,48,135,1)")), 
            locations = cells_body(columns=c(`2018`), 
                                   rows = `2018` == 10)) %>% 
  tab_style(style = list(cell_fill(color = "rgba(252,191,63,.3)"),
                         cell_text(color = "rgba(100,100,100,1)")), 
            locations = cells_body(columns=c(`2018`), 
                                   rows = `2018` %in% c(7, 8, 9))) %>% 
  tab_style(style = list(cell_fill(color = "rgba(124,40,85,.15)"),
                         cell_text(color = "rgba(124,40,85,.9)")), 
            locations = cells_body(columns=c(`2018`), 
                                   rows = `2018` <=6)) %>% 
  tab_style(style = list(cell_fill(color = "rgba(123,175,212,.3)"),
                         cell_text(color = "rgba(0,48,135,1)")), 
            locations = cells_body(columns=c(`2017`), 
                                   rows = `2017` == 10)) %>% 
  tab_style(style = list(cell_fill(color = "rgba(124,40,85,.15)"),
                         cell_text(color = "rgba(124,40,85,.9)")), 
            locations = cells_body(columns=c(`2017`), 
                                   rows = `2017` <=6)) %>% 
  tab_style(style = list(cell_fill(color = "rgba(252,191,63,.3)"),
                         cell_text(color = "rgba(100,100,100,1)")), 
            locations = cells_body(columns=c(`2017`), 
                                   rows = `2017` %in% c(7, 8, 9))) %>% 
  tab_style(style = list(cell_fill(color = "rgba(124,40,85,.15)"),
                         cell_text(color = "rgba(124,40,85,.9)")), 
            locations = cells_body(columns=c(`2017`), 
                                   rows = `2017` <=6)) %>% 
  tab_style(style = list(cell_fill(color = "rgba(123,175,212,.3)"),
                         cell_text(color = "rgba(0,48,135,1)")), 
            locations = cells_body(columns=c(`2016`), 
                                   rows = `2016` == 10)) %>% 
  tab_style(style = list(cell_fill(color = "rgba(252,191,63,.3)"),
                         cell_text(color = "rgba(100,100,100,1)")), 
            locations = cells_body(columns=c(`2016`), 
                                   rows = `2016` %in% c(7, 8, 9))) %>% 
  tab_style(style = list(cell_fill(color = "rgba(124,40,85,.15)"),
                         cell_text(color = "rgba(124,40,85,.9)")), 
            locations = cells_body(columns=c(`2016`), 
                                   rows = `2016` <=6)) %>% 
    fmt_missing(
    columns = 1:8,
    missing_text = "") %>%
  tab_options(
    table.font.size = px(14L),
    column_labels.background.color = "rgba(0,48,135,0.9)",
    column_labels.font.weight = "bold",
    data_row.padding = px(4)
  ) %>%
  cols_width(
    vars("metric") ~ px(250),
    everything() ~ px(75)
    ) %>%
  cols_align(align="right") %>%
  cols_align(align="left", columns = c(metric))

```



### Excellence & Improvement

#### Excellence, Improvement, and Total PBF Score Trends


```{r PBFscores123124, warning=FALSE, message=FALSE, fig.width=17, fig.height=3, fig.align = 'center'}

# Labels
# Set year for facet header
yeary <- 2021
facetnames <- c(`FAU` = paste0("FAU = ", total_score_long$score[total_score_long$year==yeary & 
                                                                         total_score_long$school=="FAU" & 
                                                                         total_score_long$type=="zscore"]),
                `FAMU` = paste0("FAMU = ", total_score_long$score[total_score_long$year==yeary & 
                                                                         total_score_long$school=="FAMU" & 
                                                                         total_score_long$type=="zscore"]),
                `FGCU` = paste0("FGCU = ", total_score_long$score[total_score_long$year==yeary & 
                                                                         total_score_long$school=="FGCU" & 
                                                                         total_score_long$type=="zscore"]),
                `FIU` = paste0("FIU = ", total_score_long$score[total_score_long$year==yeary & 
                                                                         total_score_long$school=="FIU" & 
                                                                         total_score_long$type=="zscore"]),
                `FSU` = paste0("FSU = ", total_score_long$score[total_score_long$year==yeary & 
                                                                         total_score_long$school=="FSU" & 
                                                                         total_score_long$type=="zscore"]),
                `NCF` = paste0("NCF = ", total_score_long$score[total_score_long$year==yeary & 
                                                                         total_score_long$school=="NCF" & 
                                                                         total_score_long$type=="zscore"]),
                `FPU` = paste0("FPU = ", total_score_long$score[total_score_long$year==yeary & 
                                                                         total_score_long$school=="FPU" & 
                                                                         total_score_long$type=="zscore"]),
                `UNF` = paste0("UNF = ", total_score_long$score[total_score_long$year==yeary & 
                                                                         total_score_long$school=="UNF" & 
                                                                         total_score_long$type=="zscore"]),
                `USF` = paste0("USF = ", total_score_long$score[total_score_long$year==yeary & 
                                                                         total_score_long$school=="USF" & 
                                                                         total_score_long$type=="zscore"]),
                `UCF` = paste0("UCF = ", total_score_long$score[total_score_long$year==yeary & 
                                                                         total_score_long$school=="UCF" & 
                                                                         total_score_long$type=="zscore"]),
                `UWF` = paste0("UWF = ", total_score_long$score[total_score_long$year==yeary & 
                                                                         total_score_long$school=="UWF" & 
                                                                         total_score_long$type=="zscore"]),
                `UF` = paste0("UF = ", total_score_long$score[total_score_long$year==yeary & 
                                                                         total_score_long$school=="UF" & 
                                                                         total_score_long$type=="zscore"])
                )


# Plot total scores
totalscoreplot <- total_score_long %>%
  mutate(filly = as.factor(case_when(school == "NCF" ~ 1,
                          TRUE ~ 0))) %>%
  arrange(desc(type), desc(year), desc(score), school) %>%
  ggplot(aes(x = year, y = score)) +
  geom_rect(aes(color = filly), xmin = -Inf,xmax = Inf,
            ymin = -Inf, ymax = Inf, alpha = 0.3, fill=NA, size=1.25) +
  scale_discrete_manual("color", values = c("#ffffff", "red")) +
  facet_grid(cols = vars(fct_inorder(school)), labeller = as_labeller(facetnames)) +
  geom_col(data = . %>% filter(type %in% c("excellence", "improvement", "zexcellence", "zimprovement")),
                       aes(fill = type), position=position_stack(reverse=TRUE), alpha=0.45) +
  scale_fill_manual(values= c("#333333", "#999999", "#0066CC", "darkorange3")) +
  geom_line(data = . %>% filter(type %in% c("score", "zscore")),
            aes(x = year, y = score)) +
  geom_label(data = . %>% filter(type %in% c("score", "zscore")),
             aes(x = year, y = score, label = sprintf("%0.0f", score)),
             size=3.5, fontface="bold", fill="black", alpha=1.0, color="white",
             label.padding = unit(0.1, "lines"), label.size = 0.1) +
  # geom_label(data = . %>% filter(type =="zscore" & year==2021),
  #           aes(x = 2018.5, y = 150, label = sprintf("%0.0f", score)),
  #           size=4, fontface="bold", fill="#0066CC", alpha=1.0, color="white",
  #           label.padding = unit(0.25, "lines"), label.size = 0.25) +
  scale_y_continuous(expand = c(0,0), breaks=seq(20, 160, 20), minor_breaks=NULL) +
  scale_x_continuous(expand = c(0,0), breaks=seq(2017, 2021, 2), minor_breaks=NULL,
                     labels=c("17", "19", "21-22")) +
  coord_cartesian(ylim = c(0,165), xlim = c(2015.5, 2021.5), expand = TRUE) +
  labs(title = NULL, x = "funding year", y = NULL) +
  annotate("segment", x = 2015.5, xend = 2021.5, y = 143, yend=143, lineend="round", color = "grey40", alpha=0.8) +
  theme(
    plot.title = element_text(color="#000000", size=15),
    axis.title.x = element_text(color="grey40", size=10),
    axis.title.y = element_text(color="grey40", size=10),
    axis.text.x = element_text(color="grey40", size=8),
    axis.text.y = element_text(color = "grey40", size=8),
    legend.position = "none",
    panel.grid.major = element_line(colour = "white"),
    panel.grid.minor = element_blank(),
    panel.background = element_rect(fill = "grey95"),
    panel.grid.major.x = element_blank(),
    panel.grid.major.y = element_line( size=.1, color="white"),
    strip.text.x = element_text(size = 12, color = "#003087", face = "bold"),
)

totalscoreplot

```




```{r metric_excellence_improvement_table}

# Create data frame of NCF total scores
ncf_scores <- total_score %>%
  filter(school == "NCF") %>%
  pivot_longer(cols = c(excellence, improvement, excPLUSimp, score), names_to= "type", values_to="score") %>%
  mutate(type = case_when(
    type == "excellence" ~ "Excellence Points",
    type == "improvement" ~ "Improvement Points",
    type == "excPLUSimp" ~ "Excellence + Improvement",
    type == "score" ~ "Final Score"
  )) %>%
  pivot_wider(id_cols = c(type), names_from = c(year), values_from = c(score)) %>%
  relocate("type", "2016", "2017", "2018", "2019", "2020")

# Create data frame for NCF metric scores + append total scores
ncf_metric_scores <- metric_scores %>%
  filter(school == "NCF") %>%
  select(metric, excellence_2016:excellence_2021, improvement_2016:improvement_2021, score_2016:score_2021) %>%
  mutate(metric = as.character(metric)) %>%
  mutate(metric = case_when(metric == "1" ~ "1. enrolled/employed",
                            metric == "2" ~ "2. median salary",
                            metric == "3" ~ "3. net cost of degree",
                            metric == "4" ~ "4. 4-year grad rate",
                            metric == "5" ~ "5. retention rate",
                            metric == "6" ~ "6. UG PSEs",
                            metric == "7" ~ "7. Pell recipients",
                            metric == "8a" ~ "8a. Graduate PSEs",
                            metric == "8b" ~ "8b. Top 10% first-years",
                            metric == "9" ~ "9. % without excess hours",
                            metric == "9a" ~ "9a. 2-year transfer grad rate",
                            metric == "9b" ~ "9b. 6-year Pell grad rate",
                            metric == "10" ~ "10. 3+ HIPs",
                            TRUE ~ metric)) %>%
  add_column('excellence_2022' =  c("0-1", "6-8", 10,  6, "0-1","7-8","7", NA, "0", NA, "0","4", 10)) %>%
  add_column('improvement_2022' = c("0-7", "0-8", "?", 2, "0",  "0",  "4", NA, "0", NA, "0","2", 10)) %>%
  add_column('score_2022' =       c("0-7", "6-8", 10,  6, "0-1","7-8","7", NA, "0", NA, "0","4", 10)) %>%
  # add_row(.before = 8, metric = "8a: Graduate degrees in PSEs",
  # '2016' = NA, '2017' = NA, '2018' = NA, '2019' = NA, '2020' = NA, '2021' = NA, '2022' = NA) %>%
  mutate('score_2022' = case_when((metric %in% c("9: % without excess hours")) ~ NA_character_,
                            TRUE ~ `score_2022`))


# Create Table
ncf_metric_scores %>%
  gt(rowname_col = "metric") %>%
  # Title
  tab_header(title = md("**New College PBF Metric Scores**")) %>%
  # Left column
  tab_stubhead(label = "metric") %>%
  # Column spanners
  tab_spanner(label = "2016-17", columns = c(excellence_2016, improvement_2016, score_2016)) %>%
  tab_spanner(label = "2017-18", columns = c(excellence_2017, improvement_2017, score_2017)) %>%
  tab_spanner(label = "2018-19", columns = c(excellence_2018, improvement_2018, score_2018)) %>%
  tab_spanner(label = "2019-20", columns = c(excellence_2019, improvement_2019, score_2019)) %>%
  tab_spanner(label = "2020-21", columns = c(excellence_2020, improvement_2020, score_2020)) %>%
  tab_spanner(label = "2021-22", columns = c(excellence_2021, improvement_2021, score_2021)) %>%
  tab_spanner(label = "2022-23", columns = c(excellence_2022, improvement_2022, score_2022)) %>%
  # Get the columns in order
  cols_move_to_start(columns = c(metric, excellence_2016, improvement_2016, score_2016)) %>%
  # Name column headers
  cols_label(
    excellence_2016 = md("*exc*"), excellence_2017 = md("*exc*"), excellence_2018 = md("*exc*"), 
    excellence_2019 = md("*exc*"), excellence_2020 = md("*exc*"), 
    excellence_2021 = md("*exc*"), excellence_2022 = md("*exc*"),
    improvement_2016 = md("*imp*"), improvement_2017 = md("*imp*"), improvement_2018 = md("*imp*"), 
    improvement_2019 = md("*imp*"), improvement_2020 = md("*imp*"), 
    improvement_2021 = md("*imp*"), improvement_2022 = md("*imp*"),
    score_2016 = md("*2016*"), score_2017 = md("*2017*"), score_2018 = md("*2018*"), score_2019 = md("*2019*"), 
    score_2020 = md("*2020*"), score_2021 = md("*2021*"), `score_2022` = md("*proj.*")
  ) %>%
  # Cell borders
  tab_style(style = list(cell_borders(sides = c("top", "bottom"), color = "rgba(0,0,0,.1)", weight=px(1))),
            locations = list(cells_body(
              columns = c(`excellence_2016`:`improvement_2021`, `excellence_2022`:`improvement_2022`)))) %>%
  tab_style(style = list(cell_borders(sides = c("top", "bottom"), color = "rgba(255,255,255,.1)", weight=px(1))),
            locations = list(cells_body(columns = c(`score_2016`:`score_2021`)))) %>%
  tab_style(style = list(cell_borders(sides = c("top", "bottom"), color = "rgba(0,0,0,.1)", weight=px(1))),
            locations = list(cells_body(columns = c(`score_2022`)))) %>%
  # Bold scores
  tab_style(style = list(cell_text(weight="bold")),
            locations = list(cells_body(columns = c("score_2016":"score_2021", "score_2022")))) %>%
  # Lighten the excellence and improvement scores
  tab_style(style = list(cell_text(color="rgba(0,0,0,.5)", weight="lighter")),
            locations = list(cells_body(
              columns = c("excellence_2016":"improvement_2021", "excellence_2022":"improvement_2022")))) %>%
  # Calculate summary sum row
  grand_summary_rows(
    columns = c(score_2016:score_2021),
    fns = list(sum = ~sum(., na.rm=TRUE)),
    decimals = 0) %>%
  # Borders for score columns
  tab_style(style = list(cell_fill(color = "black", alpha = 0.2),
                         cell_borders(side = c("left", "right"), color = "black", weight = px(2))),
        locations = cells_body(columns = c(score_2016, score_2017, score_2018, score_2019, score_2020, score_2021))) %>%
  # Grey-out missing metrics
  tab_style(style = list(cell_fill(color = "grey80")), 
            locations = cells_body(columns = c(2:6, 8:12, 14:18), rows = c(11:12))) %>%
  tab_style(style = list(cell_fill(color = "grey80")), 
            locations = cells_body(columns = c(2:22), rows = c(8))) %>%
  tab_style(style = list(cell_fill(color = "grey80")), 
            locations = cells_body(columns = c(7, 13, 19:22), rows = c(10))) %>%
  # Blue, red, yellow highlights
  tab_style(style = list(cell_fill(color = "rgba(123,175,212,.5)"),
                         cell_text(color = "rgba(0,48,135,1)")), 
            locations = cells_body(columns=c(`score_2021`), 
                                   rows = `score_2021` == 10)) %>% 
  tab_style(style = list(cell_fill(color = "rgba(123,175,212,.5)"),
                         cell_text(color = "rgba(0,48,135,1)")), 
            locations = cells_body(columns=c(`score_2020`), 
                                   rows = `score_2020` == 10)) %>% 
  tab_style(style = list(cell_fill(color = "rgba(123,175,212,.5)"),
                         cell_text(color = "rgba(0,48,135,1)")), 
            locations = cells_body(columns=c(`score_2019`), 
                                   rows = `score_2019` == 10)) %>% 
  tab_style(style = list(cell_fill(color = "rgba(123,175,212,.5)"),
                         cell_text(color = "rgba(0,48,135,1)")), 
            locations = cells_body(columns=c(`score_2018`), 
                                   rows = `score_2018` == 10)) %>% 
  tab_style(style = list(cell_fill(color = "rgba(123,175,212,.5)"),
                         cell_text(color = "rgba(0,48,135,1)")), 
            locations = cells_body(columns=c(`score_2017`), 
                                   rows = `score_2017` == 10)) %>% 
  tab_style(style = list(cell_fill(color = "rgba(123,175,212,.5)"),
                         cell_text(color = "rgba(0,48,135,1)")), 
            locations = cells_body(columns=c(`score_2016`), 
                                   rows = `score_2016` == 10)) %>% 
  tab_style(style = list(cell_fill(color = "rgba(124,40,85,.3)"),
                         cell_text(color = "rgba(124,40,85,.9)")), 
            locations = cells_body(columns=c(`score_2021`), 
                                   rows = `score_2021` <= 6)) %>% 
  tab_style(style = list(cell_fill(color = "rgba(124,40,85,.3)"),
                         cell_text(color = "rgba(124,40,85,.9)")), 
            locations = cells_body(columns=c(`score_2020`), 
                                   rows = `score_2020` <= 6)) %>% 
  tab_style(style = list(cell_fill(color = "rgba(124,40,85,.3)"),
                         cell_text(color = "rgba(124,40,85,.9)")), 
            locations = cells_body(columns=c(`score_2019`), 
                                   rows = `score_2019` <= 6)) %>% 
  tab_style(style = list(cell_fill(color = "rgba(124,40,85,.3)"),
                         cell_text(color = "rgba(124,40,85,.9)")), 
            locations = cells_body(columns=c(`score_2018`), 
                                   rows = `score_2018` <= 6)) %>% 
  tab_style(style = list(cell_fill(color = "rgba(124,40,85,.3)"),
                         cell_text(color = "rgba(124,40,85,.9)")), 
            locations = cells_body(columns=c(`score_2017`), 
                                   rows = `score_2017` <= 6)) %>% 
  tab_style(style = list(cell_fill(color = "rgba(124,40,85,.3)"),
                         cell_text(color = "rgba(124,40,85,.9)")), 
            locations = cells_body(columns=c(`score_2016`), 
                                   rows = `score_2016` <= 6)) %>% 
  tab_style(style = list(cell_fill(color = "rgba(252,191,63,.4)"),
                         cell_text(color = "rgba(100,100,100,.9)")), 
            locations = cells_body(columns=c(`score_2021`), 
                                   rows = `score_2021` %in% c(7, 8, 9))) %>% 
  tab_style(style = list(cell_fill(color = "rgba(252,191,63,.4)"),
                         cell_text(color = "rgba(100,100,100,.9)")), 
            locations = cells_body(columns=c(`score_2020`), 
                                   rows = `score_2020` %in% c(7, 8, 9))) %>% 
  tab_style(style = list(cell_fill(color = "rgba(252,191,63,.4)"),
                         cell_text(color = "rgba(100,100,100,.9)")), 
            locations = cells_body(columns=c(`score_2019`), 
                                   rows = `score_2019` %in% c(7, 8, 9))) %>% 
  tab_style(style = list(cell_fill(color = "rgba(252,191,63,.4)"),
                         cell_text(color = "rgba(100,100,100,.9)")), 
            locations = cells_body(columns=c(`score_2018`), 
                                   rows = `score_2018` %in% c(7, 8, 9))) %>% 
  tab_style(style = list(cell_fill(color = "rgba(252,191,63,.4)"),
                         cell_text(color = "rgba(100,100,100,.9)")), 
            locations = cells_body(columns=c(`score_2017`), 
                                   rows = `score_2017` %in% c(7, 8, 9))) %>% 
  tab_style(style = list(cell_fill(color = "rgba(252,191,63,.4)"),
                         cell_text(color = "rgba(100,100,100,.9)")), 
            locations = cells_body(columns=c(`score_2016`), 
                                   rows = `score_2016` %in% c(7, 8, 9))) %>% 
  fmt_missing(columns = 1:22, missing_text = "") %>%
  tab_options(
    table.font.size = px(14L),
    column_labels.background.color = "rgba(0,48,135,0.9)",
    column_labels.font.weight = "bold",
    data_row.padding = px(4),
    heading.subtitle.font.size = 12,
    heading.align = "left",
    table.border.top.color = "black",
    column_labels.border.bottom.color = "white",
    column_labels.border.bottom.width= px(2),
    grand_summary_row.background.color = "rgba(0,48,135,0.9)",
    grand_summary_row.border.color = "white",
    grand_summary_row.border.width = px(2)
  ) %>%
  cols_width(
    vars("metric") ~ px(225),
    vars("improvement_2016", "excellence_2016", "improvement_2017", "excellence_2017",
         "improvement_2018", "excellence_2018", "improvement_2019", "excellence_2019",
         "improvement_2020", "excellence_2020", "improvement_2021", "excellence_2021",
         "improvement_2022", "excellence_2022") ~ px(38),
    #vars(`2022`) ~ px(90),
    everything() ~ px(50)
    ) %>%
  cols_align(align="right") %>%
  cols_align(align="left", columns = c(metric))

```



Metrics are scored for:

* **Excellence** (0-10 pts): performance compared to BOG [benchmarks](https://www.flbog.edu/wp-content/uploads/2020-Benchmarks.pdf)
* **Improvement** (0-10 pts): +1 point for each 0.5% improvement from previous year.

The higher of the two scores for each metric are then summed to calculate the Total PBF Score (0-100 pts).





### Metric 1: `r PBF$name_long[PBF$metric=="1"][1]` {data-commentary-width=390}

```{r metric1, warning=FALSE, message=FALSE}
# Metric 1b is the $25k threshold
# Set metric number
mn <- "1"

# Calculate secondary axis marks
xone <- benchmarks$b1[benchmarks$metric==mn & benchmarks$datayear==yearnew]
m <- 1/(benchmarks$b2[benchmarks$metric==mn & benchmarks$datayear==yearnew]-xone)
yint <- (-xone+(1/m))/(1/m)

pm1 <- PBF %>%
  filter(metric == mn) %>%
  ggplot(aes(x = datayear, y = outcome, group = school)) +
  benchmark_ribbons +
  geom_ribbon(data = . %>% filter(unitid==133650), 
              aes(x = datayear, ymin=min_outcome, ymax=max_outcome), alpha=0.15) +
  annotate("text", x = ((yearnew+2016)/2), y = 67, 
           label="other SUS\nschools", color="#000000", size=4.5) +
  annotate("text", x = yearnew, y = 58, label="goals", color="grey50", size=4.5) +
  annotate("text", x = yearend-5.6, y = 67, label="excellence\nbenchmarks", color="grey50", size=4.5, hjust=1) +
  geom_line(data = . %>% filter(group=="SUS"), 
              aes(x = datayear, y=outcome), alpha=0.2, size=0.5) +
  geom_ribbon(data = subset(extrastuff, metric==mn), aes(x = datayear, ymin=0, ymax=overseas), fill="#0066CC", alpha=0.6) +
  geom_ribbon(data = subset(extrastuff, metric==mn), aes(x = datayear, ymin=overseas, ymax=overseas+enrolled), 
              fill="#0066CC", alpha=0.4) +
  geom_ribbon(data = subset(extrastuff, metric==mn), aes(x = datayear, ymin=overseas+enrolled, ymax=overseas+enrolled+employed25k), 
              fill="#0066CC", alpha=0.2) +
  annotate("text", x = 2013.25, y = 3, size = 5,  color="white", 
           label="% overseas", hjust=0) +
  annotate("text", x = 2013.25, y = 18, size = 5, color="white", 
           label="% enrolled", hjust=0) +
  annotate("text", x = 2013.25, y = 38, size = 5, color="white", 
           label="employed $25k+", hjust=0) +
  geom_line(data = . %>% filter(group=="goal", datayear>yearnew-2), color="grey50", 
            alpha=0.7, size=1, linetype="21") +
  geom_label(data = . %>% filter(group=="goal", datayear>yearnew-2), 
             aes(label = sprintf("%0.0f", round(outcome,0))),
             size=5, fill="gold", color="grey50",
             label.padding = unit(0.15, "lines"), label.size = 0.1) +
  geom_line(data = . %>% filter(group=="proj"), color="#0066CC", alpha=0.4, 
            linetype="dotted", size=1) +
  geom_line(data = . %>% filter(group=="NCF"), color="#0066CC", size=3) +
  geom_label(data = . %>% filter(group=="NCF"), 
             aes(label = sprintf("%0.1f", round(outcome,1))),
             size=6, fontface="bold", fill="#0066CC", color="#FFFFFF",
             label.padding = unit(0.25, "lines"), label.size = 0.15) +
  # TRYING THIS
  geom_label(data = . %>% filter(group=="proj", datayear == yearnew-1), 
             aes(label = "projected"),
             size=3, fontface="bold", fill="#0066CC", alpha=0.4, color="#FFFFFF",
             label.padding = unit(0.25, "lines"), label.size = 0.15) +
  geom_point_interactive(data = extrastuff, 
                        aes(x = datayear, y=overseas, tooltip = paste0(overseas,"% overseas"), 
                            data_id=overseas, hover_css = "stroke:red;"),
                        size=4, alpha=0.01) +
  geom_point_interactive(data = extrastuff, 
                        aes(x = datayear, y=overseas+enrolled, tooltip = paste0(enrolled,"% enrolled"), 
                            data_id=enrolled, hover_css = "stroke:red;"),
                        size=4, alpha=0.01) +
  geom_point_interactive(data = extrastuff, 
                        aes(x = datayear, y=overseas+enrolled+employed25k, tooltip = paste0(employed25k,"% employed @ $25k+"), 
                            data_id=employed25k, hover_css = "stroke:red;"),
                        size=4, alpha=0.01) +
  geom_line_interactive(aes(tooltip = school, data_id=school, hover_css = "fill:none;"),
                        size=2.5, alpha=0.01) +
  geom_point_interactive(data = . %>% filter(group=="SUS"), 
                        aes(tooltip = paste0(outcome,"
",school), data_id=school, hover_css = "fill:none;"),
                        size=3, alpha=0.01) +
  labs(title = paste("Metric 1: ", PBF$name_short[PBF$metric==mn]), y=NULL, 
       x = "Graduating Class") +
  scale_x_continuous(expand = c(0,0), breaks=seq(yearold, yearend, 1), 
                     minor_breaks=seq(yearold, yearend, 1)) +
  scale_y_continuous(expand = c(0,0), breaks=seq(20, 85, 10), minor_breaks=NULL) +
  scale_y_continuous(expand = c(0,0), 
                     sec.axis = sec_axis(trans = ~.*m+yint,
                     breaks=seq(1, 10, 1),
                     label=c(paste("1 (", benchmarks$b1[benchmarks$metric==mn & benchmarks$datayear==yearnew], "%)", sep = ""),
                             paste("2 (", benchmarks$b2[benchmarks$metric==mn & benchmarks$datayear==yearnew], "%)", sep = ""),
                             paste("3 (", benchmarks$b3[benchmarks$metric==mn & benchmarks$datayear==yearnew], "%)", sep = ""),
                             paste("4 (", benchmarks$b4[benchmarks$metric==mn & benchmarks$datayear==yearnew], "%)", sep = ""),
                             paste("5 (", benchmarks$b5[benchmarks$metric==mn & benchmarks$datayear==yearnew], "%)", sep = ""),
                             paste("6 (", benchmarks$b6[benchmarks$metric==mn & benchmarks$datayear==yearnew], "%)", sep = ""),
                             paste("7 (", benchmarks$b7[benchmarks$metric==mn & benchmarks$datayear==yearnew], "%)", sep = ""),
                             paste("8 (", benchmarks$b8[benchmarks$metric==mn & benchmarks$datayear==yearnew], "%)", sep = ""),
                             paste("9 (", benchmarks$b9[benchmarks$metric==mn & benchmarks$datayear==yearnew], "%)", sep = ""),
                             paste("10 (", benchmarks$b10[benchmarks$metric==mn & benchmarks$datayear==yearnew], "%)", sep = "")))) +
  coord_cartesian(ylim = c(0,85), xlim = c(yearold+.5, yearend-5.5), expand = TRUE) +
  custom_plot

# Make it interactive
pm1 <- girafe(code = print(pm1), height_svg=8.3, width_svg=15,
              options = list(opts_tooltip(offx=-10, offy=15, 
                              css="background-color:gray;color:white;font-style:bold;padding:5px;border-radius:5px;"),
                              opts_hover(css = "stroke:#FF0000;fill:#FF0000;stroke-width:3px;stroke-opacity:0.8;")))

pm1

```


***

[BOG Definition](https://www.flbog.edu/wp-content/uploads/PBF-Post_Graduation_Methodology_Revised_2020-08-03.pdf):



% of graduates who:

* enroll in a course,
  + June 1 of graduation year through July 31 of the year following graduation
  + graduate-level course within the SUS or *any course outside the SUS* reported to the [NSC](http://www.studentclearinghouse.org)
* earn ≥ $30,000 annualized,
  + *$7,500 from April-June of the year after graduation*
  + *not self-, temp-, or church-employed*
* enter the military,
* or receive overseas scholarship by July 31 of the year following graduation







**scores** and projections

```{r m1_table}
m1t <- total %>%
  filter(metric == mn,
         school == "NCF",
         year > 2017) %>%
  select(year, excellence, improvement, score) %>%
  pivot_longer(!year, names_to = "scoretype", values_to = "scorey") %>%
  # Manually fix year to match data year
  mutate(year = year-2) %>%
  pivot_wider(id_cols = "scoretype", names_from = "year", values_from = "scorey") %>%
  # Manually fix name of year
  rename("graduates" = scoretype) %>%
  # Add projections column
  add_column('2022' = c("0-1", "0-7", "0-7"))

m1t %>%
  kbl(align="rrrrrrr") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), font_size = 13) %>%
  column_spec(6, color = "#0066CC", background = "rgba(0,102,204,.1)") %>%
  row_spec(3, bold = T)

```



**Details**:



* 212 graduates in 2019:
  + 58% (123) employed (in 21 states)
  + 21% (45) enrolled (7% in SUS)
  + 4% (9) overseas
  + 7% (14) other + 10% (21) not found
  
* % enrolled or employed...
  + 52% (110) full-time
  + 47% (100) at $25k+
  + 44% (93) at $30k+ 







### Metric 2: `r PBF$name_long[PBF$metric=="2"][1]` {data-commentary-width=390}

```{r metric2, warning=FALSE, message=FALSE}

# Set metric number
mn <- "2"

# Calculate secondary axis
xone <- benchmarks$b1[benchmarks$metric==mn & benchmarks$datayear==yearnew]
m <- 1/(benchmarks$b2[benchmarks$metric==mn & benchmarks$datayear==yearnew]-xone)
yint <- (-xone+(1/m))/(1/m)


pm2 <- PBF %>%
  filter(metric==mn) %>%
  ggplot(aes(x = datayear, y=outcome, group=school)) +
  benchmark_ribbons +
  geom_ribbon(data = . %>% filter(unitid==133650), 
              aes(x = datayear, ymin=min_outcome, ymax=max_outcome), alpha=0.15) +
  annotate("text", x = ((yearnew+yearold)/2), y = 36000, label="other Florida SUS schools", color="#000000", size=4.5) +
  annotate("text", x = (yearnew), y = 35000, label="goals", color="grey50", size=4.5) +
  annotate("text", x = yearend-5.6, y = 26000, label="excellence\nbenchmarks", color="grey50", size=4.5, hjust=1) +
  geom_line(data = . %>% filter(group=="SUS"), 
              aes(x = datayear, y=outcome), alpha=0.2, size=0.5) +
  geom_line(data = . %>% filter(group=="goal", datayear>yearnew-1), color="grey50", 
            alpha=0.7, size=1, linetype="21") +
  geom_label(data = . %>% filter(group=="goal", datayear>yearnew-1), 
             aes(label = dollar(outcome)),
             size=5, fill="gold", color="grey50",
             label.padding = unit(0.15, "lines"), label.size = 0.1) +
  geom_line(data = . %>% filter(group=="proj"), color="#0066CC", alpha=0.4, linetype="dotted", size=1) +
  geom_line(data = . %>% filter(group=="NCF"), color="#0066CC", size=3) +
  geom_label(data = . %>% filter(group=="NCF"), 
             aes(label = dollar(outcome)),
             size=5, fontface="bold", fill="#0066CC", color="#FFFFFF",
             label.padding = unit(0.25, "lines"), label.size = 0.15) +
  # TRYING THIS
  geom_label(data = . %>% filter(group=="proj", datayear == yearnew-1), 
             aes(label = "projected"),
             size=3, fontface="bold", fill="#0066CC", alpha=0.4, color="#FFFFFF",
             label.padding = unit(0.25, "lines"), label.size = 0.15) +
  geom_line_interactive(aes(tooltip = school, data_id=school, hover_css = "fill:none;"),
                        size=1.5, alpha=0.01) +
  geom_point_interactive(data = . %>% filter(group=="SUS"), 
                        aes(tooltip = paste0(dollar(outcome),"
",school), data_id=school, hover_css = "fill:none;"),
                        size=3, alpha=0.01) +
  labs(title = paste("Metric 2: ", PBF$name_short[PBF$metric==mn]), y=NULL, 
       x = "Graduating Class") +
  scale_x_continuous(expand = c(0,0), breaks=seq(yearold, yearend, 1), 
                     minor_breaks=seq(yearold, yearend, 1)) +
  scale_y_continuous(expand = c(0,0), breaks=seq(10000, 59000, 10000), minor_breaks=NULL, 
                     label =c("$10k", "$20k", "$30k", "$40k", "$50k"),
                     sec.axis = sec_axis(trans = ~.*m+yint,
                     breaks=seq(1, 10, 1), 
                     label=c(paste("1 ($", benchmarks$b1[benchmarks$metric==mn & benchmarks$datayear==yearnew]/1000, "k)", sep = ""),
                             paste("2 ($", benchmarks$b2[benchmarks$metric==mn & benchmarks$datayear==yearnew]/1000, "k)", sep = ""),
                             paste("3 ($", benchmarks$b3[benchmarks$metric==mn & benchmarks$datayear==yearnew]/1000, "k)", sep = ""),
                             paste("4 ($", benchmarks$b4[benchmarks$metric==mn & benchmarks$datayear==yearnew]/1000, "k)", sep = ""),
                             paste("5 ($", benchmarks$b5[benchmarks$metric==mn & benchmarks$datayear==yearnew]/1000, "k)", sep = ""),
                             paste("6 ($", benchmarks$b6[benchmarks$metric==mn & benchmarks$datayear==yearnew]/1000, "k)", sep = ""),
                             paste("7 ($", benchmarks$b7[benchmarks$metric==mn & benchmarks$datayear==yearnew]/1000, "k)", sep = ""),
                             paste("8 ($", benchmarks$b8[benchmarks$metric==mn & benchmarks$datayear==yearnew]/1000, "k)", sep = ""),
                             paste("9 ($", benchmarks$b9[benchmarks$metric==mn & benchmarks$datayear==yearnew]/1000, "k)", sep = ""),
                             paste("10 ($", benchmarks$b10[benchmarks$metric==mn & benchmarks$datayear==yearnew]/1000, "k)", sep = "")))) +
  coord_cartesian(ylim = c(10000,59000), xlim = c(yearold-.5, yearend-5.5), expand = TRUE) +
  custom_plot


pm2 <- girafe(code = print(pm2), height_svg=8.3, width_svg=15,
              options = list(opts_tooltip(offx=-10, offy=15, 
                        css="background-color:gray;color:white;font-style:bold;padding:5px;border-radius:5px;"),
                              opts_hover(css = "stroke:#FF0000;fill:#FF0000;stroke-width:3px;stroke-opacity:0.8;")))

pm2


```

***

[BOG Definition](https://www.flbog.edu/wp-content/uploads/PBF-Post_Graduation_Methodology_Revised_2020-08-03.pdf):



Median annualized Unemployment Insurance wage for the 4th or 5th quarter following graduation:

* $7500 earned between:
  + May grads: April 1 - June 30
  + Jan. grads: Jan 1 - Mar 31
  + Aug. grads: Jul 1 - Sept 30
* Not including:
  + self-employed, military, non-valid-SSN
  + those making < full-time minimum wage







**scores** and projections

```{r m2_table}
m2t <- total %>%
  filter(metric == mn,
         school == "NCF",
         year > 2017) %>%
  select(year, excellence, improvement, score) %>%
  pivot_longer(!year, names_to = "scoretype", values_to = "scorey") %>%
  # Manually fix year to match data year
  mutate(year = year-2) %>%
  pivot_wider(id_cols = "scoretype", names_from = "year", values_from = "scorey") %>%
  # Manually fix name of year
  rename("graduates" = scoretype) %>%
  # Add projections column
  add_column('proj' = c("6-8", "0-8", "6-8"))

m2t %>%
  kbl(align = "rrrrrr") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), font_size = 13) %>%
  column_spec(6, color = "#0066CC", background = "rgba(0,102,204,.1)") %>%
  row_spec(3, bold = T)

```



**Details**:

* For the one-third of our 2011-2018 graduates employed full-time:
  + 5th %ile wages range: $\$16.0k$ to $\$18.7k$
  + 25th %ile wages range: $\$17.4k$ to $\$22.2k$
  + 75th %ile wages range: $\$28.3k$ to $\$33.8k$
  + 95th %ile wages range: $\$36.1k$ to $\$54.0k$



**Links to additional data**:

* [nothing here](http://www.bradthiessen.com)




### Metric 3: `r PBF$name_long[PBF$metric=="3"][1]` {data-commentary-width=390}

```{r metric3, warning=FALSE, message=FALSE}

# Set metric number
mn <- "3"

# Calculate secondary axis
xone <- benchmarks$b1[benchmarks$metric==mn & benchmarks$datayear==yearnew]
m <- 1/(benchmarks$b2[benchmarks$metric==mn & benchmarks$datayear==yearnew]-xone)
yint <- (-xone+(1/m))/(1/m)


pm3 <- PBF %>%
  filter(metric==mn) %>%
  ggplot(aes(x = datayear, y=outcome, group=school)) +
  annotate("text", x = ((yearnew+yearold)/2), y = 14000, label="other Florida SUS schools", color="#000000", size=4.5) +
  annotate("text", x = yearnew+1, y = 2000, label="goals", color="grey50", size=4.5) +
  geom_curve(aes(x = 2014, y = 32500, xend = 2014, yend = 8800), ncp=100, curvature=0.3, 
             size=0.3, alpha=0.6, color="firebrick", arrow = arrow()) +
  annotate("text", x = 2013.3, y = 22500, label="impact of\nfinancial aid", color="firebrick", alpha = 0.8, size=3.5, hjust=1) +
  annotate("text", x = yearend-5.6, y = 13000, label="excellence\nbenchmarks", color="grey50", size=4.5, hjust=1) +
  geom_ribbon(data = . %>% filter(unitid==133650), aes(x = datayear, ymin =-10000, ymax= b1), fill = "#2B9F78", alpha=0.2) +
  geom_ribbon(data = . %>% filter(unitid==133650), aes(x = datayear, ymin =b7, ymax=b10), fill = "#F0E54B", alpha=0.2) +
  geom_ribbon(data = . %>% filter(unitid==133650), aes(x = datayear, ymin =b10, ymax=100000), fill = "#D6641E", alpha=0.2) +
  geom_ribbon(data = . %>% filter(unitid==133650), 
              aes(x = datayear, ymin=min_outcome, ymax=max_outcome), alpha=0.15) +
  geom_line(data = . %>% filter(group=="SUS"), 
              aes(x = datayear, y=outcome), alpha=0.2, size=0.5) +
  geom_line(data = subset(extrastuff, metric==mn), aes(x = datayear, y=sticker_cost), color="#0066CC", size=0.5) +
  annotate("text", x = 2014.5, y = 31000, label="Sticker Price", color="#0066CC", size=4) +
  annotate("segment", x = 2010, xend=2028, y=0, yend=0, color="#000000", size=1) +
  geom_line(data = . %>% filter(group=="goal", datayear>yearnew-1), color="grey50", 
            alpha=0.7, size=1, linetype="21") +
  geom_label(data = . %>% filter(group=="goal", datayear>yearnew), 
             aes(label = dollar(outcome)),
             size=5, fill="gold", color="grey50",
             label.padding = unit(0.15, "lines"), label.size = 0.1) +
  geom_line(data = . %>% filter(group=="proj"), color="#0066CC", alpha=0.4, linetype="dotted", size=1) +
  geom_line(data = . %>% filter(group=="NCF"), color="#0066CC", size=3) +
  # TRYING THIS
  geom_label(data = . %>% filter(group=="proj", datayear == yearnew), 
             aes(label = "projected"),
             size=3, fontface="bold", fill="#0066CC", alpha=0.4, color="#FFFFFF",
             label.padding = unit(0.25, "lines"), label.size = 0.15) +
  geom_label(data = . %>% filter(group=="NCF"), 
             aes(label = dollar(outcome)),
             size=6, fontface="bold", fill="#0066CC", color="#FFFFFF",
             label.padding = unit(0.25, "lines"), label.size = 0.15) +
  geom_point_interactive(data = extrastuff, 
                        aes(x = datayear, y=sticker_cost, tooltip = scales::dollar(sticker_cost), 
                            data_id=sticker_cost, hover_css = "stroke:red;"),
                        size=4, alpha=0.01) +
  geom_line_interactive(aes(tooltip = school, data_id=school, hover_css = "fill:none;"),
                        size=2.5, alpha=0.01) +
  geom_point_interactive(data = . %>% filter(group=="SUS"), 
                        aes(tooltip = paste0(outcome,"
",school), data_id=school, hover_css = "fill:none;"),
                        size=3, alpha=0.01) +
  labs(title = paste("Metric 3: ", PBF$name_short[PBF$metric==mn]), y=NULL, 
       x = "Graduating Class") +
  scale_x_continuous(expand = c(0,0), breaks=seq(yearold, yearend, 1), 
                     minor_breaks=seq(yearold, yearend, 1)) +
  scale_y_continuous(expand = c(0,0), breaks=seq(-5000, 35000, 5000), minor_breaks=NULL, 
                     label = c("-$5k", "$0", "$5k", "$10k", "$15k", "$20k", "$25k", "$30k", "$35k"),
                     sec.axis = sec_axis(trans = ~.*m+yint,
                     breaks=seq(1, 10, 1),
                     label=c(paste("10 ($", benchmarks$b1[benchmarks$metric==mn & benchmarks$datayear==yearnew]/1000, "k)", sep = ""),
                             paste("9 ($", benchmarks$b2[benchmarks$metric==mn & benchmarks$datayear==yearnew]/1000, "k)", sep = ""),
                             paste("8 ($", benchmarks$b3[benchmarks$metric==mn & benchmarks$datayear==yearnew]/1000, "k)", sep = ""),
                             paste("7 ($", benchmarks$b4[benchmarks$metric==mn & benchmarks$datayear==yearnew]/1000, "k)", sep = ""),
                             paste("6 ($", benchmarks$b5[benchmarks$metric==mn & benchmarks$datayear==yearnew]/1000, "k)", sep = ""),
                             paste("5 ($", benchmarks$b6[benchmarks$metric==mn & benchmarks$datayear==yearnew]/1000, "k)", sep = ""),
                             paste("4 ($", benchmarks$b7[benchmarks$metric==mn & benchmarks$datayear==yearnew]/1000, "k)", sep = ""),
                             paste("3 ($", benchmarks$b8[benchmarks$metric==mn & benchmarks$datayear==yearnew]/1000, "k)", sep = ""),
                             paste("2 ($", benchmarks$b9[benchmarks$metric==mn & benchmarks$datayear==yearnew]/1000, "k)", sep = ""),
                             paste("1 ($", benchmarks$b10[benchmarks$metric==mn & benchmarks$datayear==yearnew]/1000, "k)", sep ="")))) +
  coord_cartesian(ylim = c(-6000,34000), xlim = c(yearold+.5, yearend-5.5), expand = TRUE) +
  custom_plot

pm3 <- girafe(code = print(pm3), height_svg=8.3, width_svg=15,
              options = list(opts_tooltip(offx=-10, offy=15, 
                              css="background-color:gray;color:white;font-style:bold;padding:5px;border-radius:5px;"),
                              opts_hover(css = "stroke:#FF0000;fill:#FF0000;stroke-width:3px;stroke-opacity:0.8;")))

pm3

```

***

[BOG Definition](https://www.flbog.edu/wp-content/uploads/PBF__COST_TO_STUDENT-Methodology_2019-08-25.pdf):



Average net cost of a 124 credit hour degree for Florida residents

* Net cost = Sticker Price - Financial Aid
* Sticker Price = (tuition + fees + books per credit hour) x (total credit hours attempted by FTIC graduates)
  + Books = 4 x (annual national average cost reported by The College Board / 120)
  + Credit hours include transfer credit, drop/withdrawal/fail/repeat/remedial
  + Credit hours exclude dual-enrollment, credit-by-exam, graduate 3+2 credit, life experience credit)
* Financial Aid = (scholarships + grants + waivers per credit hour) x (124 credit hours)
  + Financial Aid includes grants/scholarships from NCF, state, federal govt, private org's
  + Financial Aid excludes federal education tax credits







**scores** and projections

```{r m3_table}
m3t <- total %>%
  filter(metric == mn,
         school == "NCF",
         year > 2017) %>%
  select(year, excellence, improvement, score) %>%
  pivot_longer(!year, names_to = "scoretype", values_to = "scorey") %>%
  # Manually fix year to match data year
  mutate(year = year-1) %>%
  pivot_wider(id_cols = "scoretype", names_from = "year", values_from = "scorey") %>%
  # Manually fix name of year
  rename("graduates" = scoretype) %>%
  # Add projections column
  add_column('proj' = c(10, 0, 10))

m3t %>%
  kbl(align = "rrrrrr") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), font_size=13) %>%
  column_spec(6, color = "#0066CC", background = "rgba(0,102,204,.1)") %>%
  row_spec(3, bold = T)

```




**Details**:

* Sticker price declined from $\$32,942$ in 2014-15 to$\$31,632$ in 2019-20 because:
  + Tuition and fees have held constant at $\$192.10$ per credit hour 
  + Books and supplies increased from $\$40.83$ to$\$41.33$ per credit hour
  + Avg. credit hours to graduate decreased from $141.4$ to $135.5$
* Gift aid per 124 credits increased from $\$24,756$ in 2014-15 to $\$33,627$ in 2018-19



**Links to additional data**:

* [Gift Aid data - not here yet](http://www.bradthiessen.com)






### Metric 4: `r PBF$name_long[PBF$metric=="4"][1]` {data-commentary-width=390}

```{r metric4, warning=FALSE, message=FALSE}

# Set metric number
mn <- "4"

# Calculate secondary axis
xone <- benchmarks$b1[benchmarks$metric==mn & benchmarks$datayear==yearnew]
m <- 1/(benchmarks$b2[benchmarks$metric==mn & benchmarks$datayear==yearnew]-xone)
yint <- (-xone+(1/m))/(1/m)

pm4 <- grad %>%
  filter(metric==mn, datayear>2004) %>%
  ggplot(aes(x = datayear, y=outcome, group=school)) +
  benchmark_ribbons +
  geom_ribbon(data = . %>% filter(unitid==133650), 
              aes(x = datayear, ymin=min_outcome, ymax=max_outcome), alpha=0.15) +
  geom_ribbon(data = . %>% filter(unitid==164465), 
              aes(x = datayear, ymin=min_outcome, ymax=max_outcome), fill="forestgreen", alpha=0.15) +
  geom_line(data = . %>% filter(group=="SUS"), 
              aes(x = datayear, y=outcome), alpha=0.2, size=0.5) +
  geom_line(data = . %>% filter(group=="Top25"), 
              aes(x = datayear, y=outcome), alpha=0.2, size=0.5, color="forestgreen") +
  annotate("text", x = 2011.5, y = 40, label="other Florida SUS schools", color="#000000", size=4.5) +
  annotate("text", x = 2010.5, y = 84, label="Top 25 Liberal Arts", size=4, color="forestgreen") +
  annotate("text", x = yearnew+1, y = 60, label="goals", color="grey50", size=4.5) +
  annotate("text", x = yearend-5.6, y = 45, label="excellence\nbenchmarks", color="grey50", size=4.5, hjust=1) +
  geom_line(data = . %>% filter(group=="goal", datayear>yearnew-1), color="grey50", 
            alpha=0.7, size=1, linetype="21") +
  geom_label(data = . %>% filter(group=="goal", datayear>yearnew-1), 
             aes(label = sprintf("%0.0f", round(outcome,0))),
             size=5, fill="gold", color="grey50",
             label.padding = unit(0.15, "lines"), label.size = 0.1) +
  geom_line(data = . %>% filter(group=="proj"), color="#0066CC", alpha=0.4, linetype="dotted", size=1) +
  geom_line(data = . %>% filter(group=="NCF"), color="#0066CC", size=3) +
  # TRYING THIS
  # geom_label(data = . %>% filter(group=="proj", datayear == yearnew), 
  #            aes(label = "projected"),
  #            size=3, fontface="bold", fill="#0066CC", alpha=0.4, color="#FFFFFF",
  #            label.padding = unit(0.25, "lines"), label.size = 0.15) +
  geom_label(data = . %>% filter(group=="NCF"), 
             aes(label = sprintf("%0.0f", round(outcome,1))),
             size=6, fontface="bold", fill="#0066CC", color="#FFFFFF",
             label.padding = unit(0.25, "lines"), label.size = 0.15) +
  geom_line_interactive(data = . %>% filter(group %in% c("NCF", "Top25", "SUS", "goal", "proj")), 
                        aes(tooltip = school, data_id=school, hover_css = "fill:none;"),
                       size=2.5, alpha=0.01) +
  geom_point_interactive(data = . %>% filter(group %in% c("NCF", "Top25", "SUS")), 
                        aes(tooltip = paste0(outcome,"
",school), data_id=school, hover_css = "fill:none;"),
                        size=3, alpha=0.01) +
  labs(title = paste("Metric 4: ", grad$name_short[grad$metric==mn]), y=NULL, 
       x = "Graduating Class") +
  scale_x_continuous(expand = c(0,0), breaks=seq(yearold-10, yearend, 1), 
                     minor_breaks=seq(yearold, yearend, 1)) +
  scale_y_continuous(expand = c(0,0), breaks=seq(10, 100, 10), minor_breaks=NULL, 
                     sec.axis = sec_axis(trans = ~.*m+yint,
                     breaks=seq(1, 10, 1),
                     label=c(paste("1 (", benchmarks$b1[benchmarks$metric==mn & benchmarks$datayear==yearnew], "%)", sep = ""),
                             paste("2 (", benchmarks$b2[benchmarks$metric==mn & benchmarks$datayear==yearnew], "%)", sep = ""),
                             paste("3 (", benchmarks$b3[benchmarks$metric==mn & benchmarks$datayear==yearnew], "%)", sep = ""),
                             paste("4 (", benchmarks$b4[benchmarks$metric==mn & benchmarks$datayear==yearnew], "%)", sep = ""),
                             paste("5 (", benchmarks$b5[benchmarks$metric==mn & benchmarks$datayear==yearnew], "%)", sep = ""),
                             paste("6 (", benchmarks$b6[benchmarks$metric==mn & benchmarks$datayear==yearnew], "%)", sep = ""),
                             paste("7 (", benchmarks$b7[benchmarks$metric==mn & benchmarks$datayear==yearnew], "%)", sep = ""),
                             paste("8 (", benchmarks$b8[benchmarks$metric==mn & benchmarks$datayear==yearnew], "%)", sep = ""),
                             paste("9 (", benchmarks$b9[benchmarks$metric==mn & benchmarks$datayear==yearnew], "%)", sep = ""),
                             paste("10 (", benchmarks$b10[benchmarks$metric==mn & benchmarks$datayear==yearnew], "%)", sep = "")))) +
  coord_cartesian(ylim = c(10,93), xlim = c(yearold-7.5, yearend-5.5), expand = TRUE) +
  custom_plot

pm4 <- girafe(code = print(pm4), height_svg=8.3, width_svg=15,
              options = list(opts_tooltip(offx=-10, offy=15, 
                              css="background-color:gray;color:white;font-style:bold;padding:5px;border-radius:5px;"),
                              opts_hover(css = "stroke:#FF0000;fill:#FF0000;stroke-width:3px;stroke-opacity:0.8;")))

pm4
```

***

[BOG Definition](https://www.flbog.edu/wp-content/uploads/PBF__GRADUATION__RETENTION-Methodology_2020-09-01.pdf):



$$\frac{\text{# graduating by the 4th summer}}{\text{FTIC students enrolled FT (Fall or Summer)}}$$

* FTIC = students admitted for the first time with < 12 credit hours after high school graduation & early admits seeking degree prior to HS graduation
* Full-time = attempting at least 12 credit hours in the Fall semester
* Students are removed from the cohort due to:
  + death, permanent disability, Armed Services, Foreign Aid Service of the federal government (Peace Corps), Church Mission, registered but never attended, natural disaster.
  + acceptance into an Advanced Graduate Program and will not earn a bachelor's degree







**scores** and projections

```{r m4_table}
m4t <- total %>%
  filter(metric == mn,
         school == "NCF",
         year > 2017) %>%
  select(year, excellence, improvement, score) %>%
  pivot_longer(!year, names_to = "scoretype", values_to = "scorey") %>%
  # Manually fix year to match data year
  mutate(year = year-1) %>%
  pivot_wider(id_cols = "scoretype", names_from = "year", values_from = "scorey") %>%
  # Manually fix name of year
  rename("graduates" = scoretype) %>%
  # Add projections column
  add_column('proj' = c(6, 2, 6))

m4t %>%
  kbl(align = "rrrrrr") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), font_size = 13) %>%
  column_spec(6, color = "#0066CC", background = "rgba(0,102,204,.1)") %>%
  row_spec(3, bold = T)

```



**Details**:

* 199 FTICs entered Fall 2016:
  + 76% (151) retained into Fall 2017
  + 66% (132) persisted into year 3
  + 60% (129) persisted into year 4
  + **55% graduated in 4 years**
  + ?% are still enrolled




### Metric 5: `r PBF$name_long[PBF$metric=="5"][1]` {data-commentary-width=390}

```{r metric5, warning=FALSE, message=FALSE}

# Set metric number
mn <- "5"

# Calculate secondary axis
xone <- benchmarks$b1[benchmarks$metric==mn & benchmarks$datayear==yearnew]
m <- 1/(benchmarks$b2[benchmarks$metric==mn & benchmarks$datayear==yearnew]-xone)
yint <- (-xone+(1/m))/(1/m)


pm5 <- retain %>%
  ggplot(aes(x = datayear, y=outcome, group=school)) +
  benchmark_ribbons +
  geom_ribbon(data = . %>% filter(unitid==164465), 
              aes(x = datayear, ymin=min_outcome, ymax=max_outcome), fill="forestgreen", alpha=0.15) +
  geom_ribbon(data = . %>% filter(unitid==133650), 
              aes(x = datayear, ymin=min_outcome, ymax=max_outcome), alpha=0.15) +
  geom_line(data = . %>% filter(group=="SUS"), 
              aes(x = datayear, y=outcome), alpha=0.2, size=0.5) +
  annotate("text", x = 2013, y = 74, label="other Florida SUS schools", color="#000000", size=4.5) +
  annotate("text", x = 2007, y = 95, label="Top 25 Liberal Arts", size=4, color="forestgreen") +
  annotate("text", x = yearnew, y = 84, label="goals", color="grey50", size=4.5) +
  annotate("text", x = yearend-4.6, y = 81, label="excellence\nbenchmarks", color="grey50", size=4.5, hjust=1) +
  geom_line(data = . %>% filter(group=="goal", datayear>yearnew-1), color="grey50", 
            alpha=0.7, size=1, linetype="21") +
  geom_label(data = . %>% filter(group=="goal", datayear>yearnew-1), 
             aes(label = sprintf("%0.0f", round(outcome,0))),
             size=5, fill="gold", color="grey50",
             label.padding = unit(0.15, "lines"), label.size = 0.1) +
  geom_line(data = . %>% filter(group=="proj"), color="#0066CC", alpha=0.4, linetype="dotted", size=1) +
  geom_line(data = . %>% filter(group=="NCF"), color="#0066CC", size=3) +
  # TRYING THIS
  geom_label(data = . %>% filter(group=="proj", datayear == 2020), 
             aes(label = "projected"),
             size=3, fontface="bold", fill="#0066CC", alpha=0.4, color="#FFFFFF",
             label.padding = unit(0.25, "lines"), label.size = 0.15) +
  geom_label(data = . %>% filter(group=="NCF"), 
             aes(label = sprintf("%0.0f", round(outcome,1))),
             size=6, fontface="bold", fill="#0066CC", color="#FFFFFF",
             label.padding = unit(0.25, "lines"), label.size = 0.15) +
  geom_line_interactive(data = . %>% filter(group %in% c("SUS", "NCF", "goal", "proj")), 
                        aes(tooltip = school, data_id=school, hover_css = "fill:none;"),
                        size=2.5, alpha=0.01) +
  geom_point_interactive(data = . %>% filter(group %in% c("SUS", "NCF")), 
                        aes(tooltip = paste0(outcome,"
",school), data_id=school, hover_css = "fill:none;"),
                        size=3, alpha=0.01) +
  labs(title = paste("Metric 5: ", retain$name_short[retain$metric==mn]), y=NULL, 
       x = "Incoming Cohort") +
  scale_x_continuous(expand = c(0,0), breaks=seq(yearold-9, yearend, 1)) +
  scale_y_continuous(expand = c(0,0), breaks=seq(60, 100, 10), minor_breaks=NULL, 
                     sec.axis = sec_axis(trans = ~.*m+yint,
                     breaks=seq(1, 10, 1),
                     label=c(paste("1 (", benchmarks$b1[benchmarks$metric==mn & benchmarks$datayear==yearnew], "%)", sep = ""),
                             paste("2 (", benchmarks$b2[benchmarks$metric==mn & benchmarks$datayear==yearnew], "%)", sep = ""),
                             paste("3 (", benchmarks$b3[benchmarks$metric==mn & benchmarks$datayear==yearnew], "%)", sep = ""),
                             paste("4 (", benchmarks$b4[benchmarks$metric==mn & benchmarks$datayear==yearnew], "%)", sep = ""),
                             paste("5 (", benchmarks$b5[benchmarks$metric==mn & benchmarks$datayear==yearnew], "%)", sep = ""),
                             paste("6 (", benchmarks$b6[benchmarks$metric==mn & benchmarks$datayear==yearnew], "%)", sep = ""),
                             paste("7 (", benchmarks$b7[benchmarks$metric==mn & benchmarks$datayear==yearnew], "%)", sep = ""),
                             paste("8 (", benchmarks$b8[benchmarks$metric==mn & benchmarks$datayear==yearnew], "%)", sep = ""),
                             paste("9 (", benchmarks$b9[benchmarks$metric==mn & benchmarks$datayear==yearnew], "%)", sep = ""),
                             paste("10 (", benchmarks$b10[benchmarks$metric==mn & benchmarks$datayear==yearnew], "%)", sep = "")))) +
  coord_cartesian(ylim = c(50,100), xlim = c(yearold-9.5, yearend-4.5), expand = TRUE) +
  custom_plot


pm5 <- girafe(code = print(pm5), height_svg=8.3, width_svg=15,
              options = list(opts_tooltip(offx=-10, offy=15, 
                              css="background-color:gray;color:white;font-style:bold;padding:5px;border-radius:5px;"),
                              opts_hover(css = "stroke:#FF0000;fill:#FF0000;stroke-width:3px;stroke-opacity:0.8;")))

pm5
```

***

[BOG Definition](https://www.flbog.edu/wp-content/uploads/PBF__GRADUATION__RETENTION-Methodology_2020-09-01.pdf):



* Academic Progress Rate = % of students who return the next year
  + only includes **first time in college (FTIC)** students who enrolled **full-time** in the Fall or Summer of the first year
    - *FTIC = students admitted for the first time with < 12 credit hours after high school graduation & early admits seeking degree prior to HS graduation*
    - *full-time = attempted at least 12 credit hours in the Fall semester*
    - *Students are removed from the cohort due to: death, permanent disability, Armed Services, Foreign Aid Service of the federal government (Peace Corps), Church Mission, registered but never attended, natural disaster*
  + only counts students who return in Fall of the 2nd year with a GPA above 2.0







**scores** and projections

```{r m5_table}
m5t <- total %>%
  filter(metric == mn,
         school == "NCF", 
         year > 2017) %>%
  select(year, excellence, improvement, score) %>%
  pivot_longer(!year, names_to = "scoretype", values_to = "scorey") %>%
  # Manually fix year to match data year
  mutate(year = year-2) %>%
  pivot_wider(id_cols = "scoretype", names_from = "year", values_from = "scorey") %>%
  # Manually fix name of year
  rename("1st year" = scoretype) %>%
  # Add projections column
  add_column('proj' = c("0-1", 0, "0-1"))

m5t %>%
  kbl(align = "rrrrrr") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed")) %>%
  column_spec(6, color = "#0066CC", background = "rgba(0,102,204,.1)") %>%
  row_spec(3, bold = T)

```



**Details**:

* 156 FTICs enrolled Fall 2020:
  + 78.2% (122) returned Fall 2021
  + +0.6% (123) for each student returning for ISP


### Metric 6: `r PBF$name_long[PBF$metric=="6"][1]` {data-commentary-width=390}

```{r metric6, warning=FALSE, message=FALSE}
# Set metric number
mn <- "6"

# Calculate secondary axis marks
xone <- benchmarks$b1[benchmarks$metric==mn & benchmarks$datayear==yearnew]
m <- 1/(benchmarks$b2[benchmarks$metric==mn & benchmarks$datayear==yearnew]-xone)
yint <- (-xone+(1/m))/(1/m)

pm6 <- PBF %>%
  filter(metric == mn) %>%
  ggplot(aes(x = datayear, y = outcome, group = school)) +
  benchmark_ribbons +
  geom_ribbon(data = . %>% filter(unitid==133650), 
              aes(x = datayear, ymin=min_outcome, ymax=max_outcome), alpha=0.15) +
  annotate("text", x = 2015, y = 52, label="other Florida SUS schools", color="#000000", size=4.5) +
  annotate("text", x = yearnew+1, y = 55, label="goals", color="grey50", size=4.5) +
  annotate("text", x = yearend-5.1, y = 37, label="excellence\nbenchmarks", color="grey50", size=4.5, hjust=1) +
  geom_line(data = . %>% filter(group=="SUS"), 
              aes(x = datayear, y=outcome), alpha=0.2, size=0.5) +
  geom_line(data = . %>% filter(group=="goal", datayear>yearnew), color="grey50", 
            alpha=0.7, size=1, linetype="21") +
  geom_label(data = . %>% filter(group=="goal", datayear>yearnew), 
             aes(label = sprintf("%0.0f", round(outcome,0))),
             size=5, fill="gold", color="grey50",
             label.padding = unit(0.15, "lines"), label.size = 0.1) +
  geom_line(data = . %>% filter(group=="proj"), color="#0066CC", alpha=0.4, linetype="dotted", size=1) +
  geom_line(data = . %>% filter(group=="NCF"), color="#0066CC", size=3) +
  # TRYING THIS
  geom_label(data = . %>% filter(group=="proj", datayear == yearnew), 
             aes(label = "projected"),
             size=3, fontface="bold", fill="#0066CC", alpha=0.4, color="#FFFFFF",
             label.padding = unit(0.25, "lines"), label.size = 0.15) +
  geom_label(data = . %>% filter(group=="NCF"), 
             aes(label = sprintf("%0.1f", round(outcome,1))),
             size=6, fontface="bold", fill="#0066CC", color="#FFFFFF",
             label.padding = unit(0.25, "lines"), label.size = 0.15) +
  geom_line_interactive(data = . %>% filter(group %in% c("NCF", "SUS", "goal", "proj")), 
                        aes(tooltip = school, data_id=school, hover_css = "fill:none;"),
                       size=2.5, alpha=0.01) +
  geom_point_interactive(data = . %>% filter(group %in% c("NCF", "SUS")), 
                        aes(tooltip = paste0(outcome,"
",school), data_id=school, hover_css = "fill:none;"),
                        size=3, alpha=0.01) +
  labs(title = paste("Metric 6: ", PBF$name_short[PBF$metric==mn]), y=NULL, 
       x = "Spring") +
  scale_x_continuous(expand = c(0,0), breaks=seq(yearold, yearend, 1), 
                     minor_breaks=seq(yearold, yearend, 1)) +
  scale_y_continuous(expand = c(0,0), breaks=seq(0, 109, 10), minor_breaks=NULL) +
  scale_y_continuous(expand = c(0,0), 
                     sec.axis = sec_axis(trans = ~.*m+yint,
                     breaks=seq(1, 10, 1),
                     label=c(paste("1 (", benchmarks$b1[benchmarks$metric==mn & benchmarks$datayear==yearnew], "%)", sep = ""),
                             paste("2 (", benchmarks$b2[benchmarks$metric==mn & benchmarks$datayear==yearnew], "%)", sep = ""),
                             paste("3 (", benchmarks$b3[benchmarks$metric==mn & benchmarks$datayear==yearnew], "%)", sep = ""),
                             paste("4 (", benchmarks$b4[benchmarks$metric==mn & benchmarks$datayear==yearnew], "%)", sep = ""),
                             paste("5 (", benchmarks$b5[benchmarks$metric==mn & benchmarks$datayear==yearnew], "%)", sep = ""),
                             paste("6 (", benchmarks$b6[benchmarks$metric==mn & benchmarks$datayear==yearnew], "%)", sep = ""),
                             paste("7 (", benchmarks$b7[benchmarks$metric==mn & benchmarks$datayear==yearnew], "%)", sep = ""),
                             paste("8 (", benchmarks$b8[benchmarks$metric==mn & benchmarks$datayear==yearnew], "%)", sep = ""),
                             paste("9 (", benchmarks$b9[benchmarks$metric==mn & benchmarks$datayear==yearnew], "%)", sep = ""),
                             paste("10 (", benchmarks$b10[benchmarks$metric==mn & benchmarks$datayear==yearnew], "%)", sep = "")))) +
  coord_cartesian(ylim = c(0,100), xlim = c(yearold+.5, yearend-5), expand = TRUE) +
  custom_plot
  

# Make it interactive
pm6 <- girafe(code = print(pm6), height_svg=8.3, width_svg=15,
              options = list(opts_tooltip(offx=-10, offy=15, 
                              css="background-color:gray;color:white;font-style:bold;padding:5px;border-radius:5px;"),
                              opts_hover(css = "stroke:#FF0000;fill:#FF0000;stroke-width:3px;stroke-opacity:0.8;")))

pm6

```

***

[BOG Definition](https://www.flbog.edu/wp-content/uploads/PBF-Strategic_Emphasis_Degrees_Methodology_2016-04-28.pdf):



% of baccalaureate degrees awarded in [CIP codes identified by the BOG](https://www.flbog.edu/resources/academic/programs-of-strategic-emphasis/) as programs of strategic emphasis to Florida.

* NCF assigns a single CIP to each graduate:
	+ *24.0199 Liberal Arts & Sciences (NOT a PSE)*
	+ 30.0101	Biological and Physical Science
	+ 16.0101	Foreign Languages & Literatures
	+ 03.0103	Environmental Studies
	+ 30.2001	International / Global Studies

Students with multiple CIPs at other schools are counted multiple times in the numerator and denominator.







**scores** and projections

```{r m6_table}
m6t <- total %>%
  filter(metric == mn,
         school == "NCF",
         year > 2017) %>%
  select(year, excellence, improvement, score) %>%
  pivot_longer(!year, names_to = "scoretype", values_to = "scorey") %>%
  # Manually fix year to match data year
  mutate(year = year-1) %>%
  pivot_wider(id_cols = "scoretype", names_from = "year", values_from = "scorey") %>%
  # Manually fix name of year
  rename("Spring" = scoretype) %>%
  # Add projections column
  add_column('proj' = c("7-8", 0, "7-8"))

m6t %>%
  kbl(align = "rrrrrr") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), font_size=13) %>%
  column_spec(6, color = "#0066CC", background = "rgba(0,102,204,.1)") %>%
  row_spec(3, bold = T)

```



**Details**:

* 158 graduates in Spring 2021:
  + 69 (43.7%) in PSEs
  + 72 (45.6%) if Greek were 2ndary field





### Metric 7: `r PBF$name_long[PBF$metric=="7"][1]` {data-commentary-width=390}

```{r metric7, warning=FALSE, message=FALSE}

# Set metric number
mn <- "7"

# Calculate secondary axis
xone <- benchmarks$b1[benchmarks$metric==mn & benchmarks$datayear==yearnew]
m <- 1/(benchmarks$b2[benchmarks$metric==mn & benchmarks$datayear==yearnew]-xone)
yint <- (-xone+(1/m))/(1/m)

pm7 <- pell %>%
  filter(metric==mn) %>%
  ggplot(aes(x = datayear, y=outcome, group=school)) +
  benchmark_ribbons +
  geom_ribbon(data = . %>% filter(unitid==133650), 
              aes(x = datayear, ymin=min_outcome, ymax=max_outcome), alpha=0.15) +
  geom_ribbon(data = . %>% filter(unitid==164465), 
              aes(x = datayear, ymin=min_outcome, ymax=max_outcome), fill="forestgreen", alpha=0.15) +
  geom_line(data = . %>% filter(group=="SUS"), 
              aes(x = datayear, y=outcome), alpha=0.2, size=0.5) +
  geom_line(data = . %>% filter(group=="Top25"), 
              aes(x = datayear, y=outcome), alpha=0.2, size=0.5, color="forestgreen") +
  annotate("text", x = 2013.5, y = 46, label="other Florida SUS schools", color="#000000", size=4.5) +
  annotate("text", x = 2013.5, y = 17, label="Top 25 Liberal Arts", size=4, color="forestgreen") +
  annotate("text", x = 2021, y = 37, label="goals", color="grey50", size=4.5) +
  annotate("text", x = yearend-5.6, y = 24, label="excellence\nbenchmarks", color="grey50", size=4.5, hjust=1) +
  geom_line(data = . %>% filter(group=="goal", datayear>yearnew-1), color="grey50", 
            alpha=0.7, size=1, linetype="21") +
  geom_label(data = . %>% filter(group=="goal", datayear>yearnew-1), 
             aes(label = sprintf("%0.0f", round(outcome,0))),
             size=5, fill="gold", color="grey50",
             label.padding = unit(0.15, "lines"), label.size = 0.1) +
  geom_line(data = . %>% filter(group=="proj"), color="#0066CC", alpha=0.4, linetype="dotted", size=1) +
  geom_line(data = . %>% filter(group=="NCF"), color="#0066CC", size=3) +
  # TRYING THIS
  geom_label(data = . %>% filter(group=="proj", datayear == yearnew-1), 
             aes(label = "projected"),
             size=3, fontface="bold", fill="#0066CC", alpha=0.4, color="#FFFFFF",
             label.padding = unit(0.25, "lines"), label.size = 0.15) +
  geom_label(data = . %>% filter(group=="NCF"), 
             aes(label = sprintf("%0.0f", round(outcome,1))),
             size=6, fontface="bold", fill="#0066CC", color="#FFFFFF",
             label.padding = unit(0.25, "lines"), label.size = 0.15) +
  geom_line_interactive(data = . %>% filter(group %in% c("NCF", "Top25", "SUS", "goal", "proj")), 
                        aes(tooltip = school, data_id=school, hover_css = "fill:none;"),
                       size=2.5, alpha=0.01) +
  geom_point_interactive(data = . %>% filter(group %in% c("NCF", "Top25", "SUS")), 
                        aes(tooltip = paste0(outcome,"
",school), data_id=school, hover_css = "fill:none;"),
                        size=3, alpha=0.01) +
  labs(title = paste("Metric 7: ", grad$name_short[grad$metric==mn]), y=NULL, 
       x = "Fall") +
  scale_x_continuous(expand = c(0,0), breaks=seq(yearold-10, yearend, 1), 
                     minor_breaks=seq(yearold, yearend, 1)) +
  scale_y_continuous(expand = c(0,0), breaks=seq(0, 100, 10), minor_breaks=NULL, 
                     sec.axis = sec_axis(trans = ~.*m+yint,
                     breaks=seq(1, 10, 1),
                     label=c(paste("1 (", benchmarks$b1[benchmarks$metric==mn & benchmarks$datayear==yearnew], "%)", sep = ""),
                             paste("2 (", benchmarks$b2[benchmarks$metric==mn & benchmarks$datayear==yearnew], "%)", sep = ""),
                             paste("3 (", benchmarks$b3[benchmarks$metric==mn & benchmarks$datayear==yearnew], "%)", sep = ""),
                             paste("4 (", benchmarks$b4[benchmarks$metric==mn & benchmarks$datayear==yearnew], "%)", sep = ""),
                             paste("5 (", benchmarks$b5[benchmarks$metric==mn & benchmarks$datayear==yearnew], "%)", sep = ""),
                             paste("6 (", benchmarks$b6[benchmarks$metric==mn & benchmarks$datayear==yearnew], "%)", sep = ""),
                             paste("7 (", benchmarks$b7[benchmarks$metric==mn & benchmarks$datayear==yearnew], "%)", sep = ""),
                             paste("8 (", benchmarks$b8[benchmarks$metric==mn & benchmarks$datayear==yearnew], "%)", sep = ""),
                             paste("9 (", benchmarks$b9[benchmarks$metric==mn & benchmarks$datayear==yearnew], "%)", sep = ""),
                             paste("10 (", benchmarks$b10[benchmarks$metric==mn & benchmarks$datayear==yearnew], "%)", sep = "")))) +
  coord_cartesian(ylim = c(0,75), xlim = c(yearold-4.5, yearend-5.5), expand = TRUE) +
  custom_plot

pm7 <- girafe(code = print(pm7), height_svg=8.3, width_svg=15,
              options = list(opts_tooltip(offx=-10, offy=15, 
                              css="background-color:gray;color:white;font-style:bold;padding:5px;border-radius:5px;"),
                              opts_hover(css = "stroke:#FF0000;fill:#FF0000;stroke-width:3px;stroke-opacity:0.8;")))

pm7
```

***

[BOG Definition](https://www.flbog.edu/wp-content/uploads/PBF-University_Access_Rate_Methodology_2016-06-08.pdf):



$$\frac{\text{# receiving Pell Grant in Fall}}{\text{degree-seeking UGs enrolled at least half-time in Fall}}$$

* Pell eligibility:
  + Demonstrated financial need (cost of attendance vs. expected family contribution)
  + Completed FAFSA
  + U.S. citizen, National, Permanent Resident; other (e.g., refugee, asylum granted)
  + Valid SSN; Registered with Selective Service
  + Accepted in eligible degree program; Enrolled at least half-time
  + Maintain satisfactory academic progress







**scores** and projections

```{r m7_table}
m7t <- total %>%
  filter(metric == mn,
         school == "NCF",
         year > 2017) %>%
  select(year, excellence, improvement, score) %>%
  pivot_longer(!year, names_to = "scoretype", values_to = "scorey") %>%
  # Manually fix year to match data year
  mutate(year = year-2) %>%
  pivot_wider(id_cols = "scoretype", names_from = "year", values_from = "scorey") %>%
  # Manually fix name of year
  rename("graduates" = scoretype) %>%
  # Add projections column
  add_column('proj' = c(7, 4, 7))

m7t %>%
  kbl(align="rrrrrr") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), font_size = 13) %>%
  column_spec(6, color = "#0066CC", background = "rgba(0,102,204,.1)") %>%
  row_spec(3, bold = T)

```



**Details**:

* 625 degree-seeking UGs enrolled Fall 2020
  + 191 (30.6%) received Pell Grants
      - Only 23% of our incoming class received Pell Grants



### Metric 8a: `r PBF$name_long[PBF$metric=="8a"][1]` {data-commentary-width=390}

```{r metric8a, warning=FALSE, message=FALSE}
# Set metric number
mn <- "8a"

# Calculate secondary axis marks
xone <- benchmarks$b1[benchmarks$metric==mn & benchmarks$datayear==yearnew]
m <- 1/(benchmarks$b2[benchmarks$metric==mn & benchmarks$datayear==yearnew]-xone)
yint <- (-xone+(1/m))/(1/m)

pm8a <- PBF %>%
  filter(metric == mn) %>%
  ggplot(aes(x = datayear, y = outcome, group = school)) +
  benchmark_ribbons +
  geom_ribbon(data = . %>% filter(unitid==133650), 
              aes(x = datayear, ymin=min_outcome, ymax=max_outcome), alpha=0.15) +
  annotate("text", x = 2016.5, y = 62, label="other Florida SUS schools", color="#000000", size=4.5) +
  annotate("text", x = 2022, y = 97, label="goals", color="grey50", size=4.5) +
  annotate("text", x = yearend-5.1, y = 46, label="excellence\nbenchmarks", color="grey50", size=4.5, hjust=1) +
  geom_line(data = . %>% filter(group=="SUS"), 
              aes(x = datayear, y=outcome), alpha=0.2, size=0.5) +
  geom_line(data = . %>% filter(group=="goal", datayear>yearnew), color="grey50", 
            alpha=0.7, size=1, linetype="21") +
  geom_label(data = . %>% filter(group=="goal", datayear>yearnew), 
             aes(label = sprintf("%0.0f", round(outcome,0))),
             size=5, fill="gold", color="grey50",
             label.padding = unit(0.15, "lines"), label.size = 0.1) +
  geom_line(data = . %>% filter(group=="proj"), color="#0066CC", alpha=0.4, linetype="dotted", size=1) +
  geom_line(data = . %>% filter(group=="NCF"), color="#0066CC", size=3) +
  # TRYING THIS
  geom_label(data = . %>% filter(group=="proj", datayear == yearnew), 
             aes(label = "projected"),
             size=3, fontface="bold", fill="#0066CC", alpha=0.4, color="#FFFFFF",
             label.padding = unit(0.25, "lines"), label.size = 0.15) +
  geom_label(data = . %>% filter(group=="NCF"), 
             aes(label = sprintf("%0.1f", round(outcome,1))),
             size=6, fontface="bold", fill="#0066CC", color="#FFFFFF",
             label.padding = unit(0.25, "lines"), label.size = 0.15) +
  geom_line_interactive(data = . %>% filter(group %in% c("NCF", "SUS", "goal", "proj")), 
                        aes(tooltip = school, data_id=school, hover_css = "fill:none;"),
                       size=2.5, alpha=0.01) +
  geom_point_interactive(data = . %>% filter(group %in% c("NCF", "SUS")), 
                        aes(tooltip = paste0(outcome,"
",school), data_id=school, hover_css = "fill:none;"),
                        size=3, alpha=0.01) +
  labs(title = paste("Metric 8a: ", PBF$name_short[PBF$metric==mn]), y=NULL, 
       x = "Graduating Class") +
  scale_x_continuous(expand = c(0,0), breaks=seq(yearold, yearend, 1), 
                     minor_breaks=seq(yearold, yearend, 1)) +
  scale_y_continuous(expand = c(0,0), breaks=seq(0, 109, 10), minor_breaks=NULL) +
  scale_y_continuous(expand = c(0,0), 
                     sec.axis = sec_axis(trans = ~.*m+yint,
                     breaks=seq(1, 10, 1),
                     label=c(paste("1 (", benchmarks$b1[benchmarks$metric==mn & benchmarks$datayear==yearnew], "%)", sep = ""),
                             paste("2 (", benchmarks$b2[benchmarks$metric==mn & benchmarks$datayear==yearnew], "%)", sep = ""),
                             paste("3 (", benchmarks$b3[benchmarks$metric==mn & benchmarks$datayear==yearnew], "%)", sep = ""),
                             paste("4 (", benchmarks$b4[benchmarks$metric==mn & benchmarks$datayear==yearnew], "%)", sep = ""),
                             paste("5 (", benchmarks$b5[benchmarks$metric==mn & benchmarks$datayear==yearnew], "%)", sep = ""),
                             paste("6 (", benchmarks$b6[benchmarks$metric==mn & benchmarks$datayear==yearnew], "%)", sep = ""),
                             paste("7 (", benchmarks$b7[benchmarks$metric==mn & benchmarks$datayear==yearnew], "%)", sep = ""),
                             paste("8 (", benchmarks$b8[benchmarks$metric==mn & benchmarks$datayear==yearnew], "%)", sep = ""),
                             paste("9 (", benchmarks$b9[benchmarks$metric==mn & benchmarks$datayear==yearnew], "%)", sep = ""),
                             paste("10 (", benchmarks$b10[benchmarks$metric==mn & benchmarks$datayear==yearnew], "%)", sep = "")))) +
  coord_cartesian(ylim = c(20,101), xlim = c(yearold+1.5, yearend-5), expand = TRUE) +
  custom_plot
  

# Make it interactive
pm8a <- girafe(code = print(pm8a), height_svg=8.3, width_svg=15,
              options = list(opts_tooltip(offx=-10, offy=15, 
                              css="background-color:gray;color:white;font-style:bold;padding:5px;border-radius:5px;"),
                              opts_hover(css = "stroke:#FF0000;fill:#FF0000;stroke-width:3px;stroke-opacity:0.8;")))

pm8a

```

***

[BOG Definition](https://www.flbog.edu/wp-content/uploads/PBF-Strategic_Emphasis_Degrees_Methodology_2016-04-28.pdf):



% of graduate degrees awarded in [CIP codes identified by the BOG](https://www.flbog.edu/resources/academic/programs-of-strategic-emphasis/) as programs of strategic emphasis to Florida.








**scores** and projections

This metric will not apply to New College until we award 25 graduate degrees per year.



**Details**:

* # of masters degrees awarded:
  + 7 = 2017
  + 7 = 2018
  + 16 = 2019
  + 9 = 2020
  + 14 = 2021 (I need to verify)
  + 9-10 = projected 2022


### Metric 8b: `r PBF$name_long[PBF$metric=="8b"][1]` {data-commentary-width=390}

```{r metric8b, warning=FALSE, message=FALSE}
# Set metric number
mn <- "8b"

# Calculate secondary axis marks
xone <- benchmarks$b1[benchmarks$metric==mn & benchmarks$datayear==yearnew]
m <- 1/(benchmarks$b2[benchmarks$metric==mn & benchmarks$datayear==yearnew]-xone)
yint <- (-xone+(1/m))/(1/m)

pm8b <- PBF %>%
  filter(metric == mn) %>%
  ggplot(aes(x = datayear, y = outcome, group = school)) +
  benchmark_ribbons +
  geom_ribbon(data = . %>% filter(unitid==133650), 
              aes(x = datayear, ymin=min_outcome, ymax=max_outcome), alpha=0.15) +
  annotate("text", x = 2016, y = 23, label="other Florida SUS schools", color="#000000", size=4.5) +
  annotate("text", x = 2021, y = 33, label="goals", color="grey50", size=4.5) +
  annotate("text", x = yearend-5.6, y = 46, label="excellence\nbenchmarks", color="grey50", size=4.5, hjust=1) +
  geom_line(data = . %>% filter(group=="SUS"), 
              aes(x = datayear, y=outcome), alpha=0.2, size=0.5) +
  geom_line(data = . %>% filter(group=="goal", datayear>yearnew-1), color="grey50", 
            alpha=0.7, size=1, linetype="21") +
  geom_label(data = . %>% filter(group=="goal", datayear>yearnew-1), 
             aes(label = sprintf("%0.0f", round(outcome,0))),
             size=5, fill="gold", color="grey50",
             label.padding = unit(0.15, "lines"), label.size = 0.1) +
  geom_line(data = . %>% filter(group=="proj"), color="#0066CC", alpha=0.4, linetype="dotted", size=1) +
  geom_line(data = . %>% filter(group=="NCF"), color="#0066CC", size=3) +
  # TRYING THIS
  geom_label(data = . %>% filter(group=="proj", datayear == yearnew), 
             aes(label = "projected"),
             size=3, fontface="bold", fill="#0066CC", alpha=0.4, color="#FFFFFF",
             label.padding = unit(0.25, "lines"), label.size = 0.15) +
  geom_label(data = . %>% filter(group=="NCF"), 
             aes(label = sprintf("%0.1f", round(outcome,1))),
             size=6, fontface="bold", fill="#0066CC", color="#FFFFFF",
             label.padding = unit(0.25, "lines"), label.size = 0.15) +
  geom_line_interactive(data = . %>% filter(group %in% c("NCF", "SUS", "goal", "proj")), 
                        aes(tooltip = school, data_id=school, hover_css = "fill:none;"),
                       size=2.5, alpha=0.01) +
  geom_point_interactive(data = . %>% filter(group %in% c("NCF", "SUS")), 
                        aes(tooltip = paste0(outcome,"
",school), data_id=school, hover_css = "fill:none;"),
                        size=3, alpha=0.01) +
  labs(title = paste("Metric 8b: ", PBF$name_short[PBF$metric==mn]), y=NULL, 
       x = "Incoming cohort") +
  scale_x_continuous(expand = c(0,0), breaks=seq(yearold, yearend, 1), 
                     minor_breaks=seq(yearold, yearend, 1)) +
  scale_y_continuous(expand = c(0,0), breaks=seq(0, 109, 10), minor_breaks=NULL) +
  scale_y_continuous(expand = c(0,0), 
                     sec.axis = sec_axis(trans = ~.*m+yint,
                     breaks=seq(1, 10, 1),
                     label=c(paste("1 (", benchmarks$b1[benchmarks$metric==mn & benchmarks$datayear==yearnew], "%)", sep = ""),
                             paste("2 (", benchmarks$b2[benchmarks$metric==mn & benchmarks$datayear==yearnew], "%)", sep = ""),
                             paste("3 (", benchmarks$b3[benchmarks$metric==mn & benchmarks$datayear==yearnew], "%)", sep = ""),
                             paste("4 (", benchmarks$b4[benchmarks$metric==mn & benchmarks$datayear==yearnew], "%)", sep = ""),
                             paste("5 (", benchmarks$b5[benchmarks$metric==mn & benchmarks$datayear==yearnew], "%)", sep = ""),
                             paste("6 (", benchmarks$b6[benchmarks$metric==mn & benchmarks$datayear==yearnew], "%)", sep = ""),
                             paste("7 (", benchmarks$b7[benchmarks$metric==mn & benchmarks$datayear==yearnew], "%)", sep = ""),
                             paste("8 (", benchmarks$b8[benchmarks$metric==mn & benchmarks$datayear==yearnew], "%)", sep = ""),
                             paste("9 (", benchmarks$b9[benchmarks$metric==mn & benchmarks$datayear==yearnew], "%)", sep = ""),
                             paste("10 (", benchmarks$b10[benchmarks$metric==mn & benchmarks$datayear==yearnew], "%)", sep = "")))) +
  coord_cartesian(ylim = c(0,83), xlim = c(yearold-.5, yearend-5.5), expand = TRUE) +
  custom_plot
  

# Make it interactive
pm8b <- girafe(code = print(pm8b), height_svg=8.3, width_svg=15,
              options = list(opts_tooltip(offx=-10, offy=15, 
                              css="background-color:gray;color:white;font-style:bold;padding:5px;border-radius:5px;"),
                              opts_hover(css = "stroke:#FF0000;fill:#FF0000;stroke-width:3px;stroke-opacity:0.8;")))

pm8b

```

***


[BOG Definition](https://www.flbog.edu/wp-content/uploads/2021/11/2021_PBF_METRIC_DEFINITIONS_1.pdf):



% of degree-seeking, FTIC, first-year students with high school class ranks within the top 10% of their graduating class.

* Class rank = The relative numerical position of a student in his or her graduating class, calculated by the high school on the basis of grade-point average, whether weighted or unweighted.








**scores** and projections

```{r m8b_table}
m8bt <- total %>%
  filter(metric == mn,
         school == "NCF", 
         year > 2017) %>%
  select(year, excellence, improvement, score) %>%
  pivot_longer(!year, names_to = "scoretype", values_to = "scorey") %>%
  # Manually fix year to match data year
  mutate(year = year-1) %>%
  pivot_wider(id_cols = "scoretype", names_from = "year", values_from = "scorey") %>%
  # Manually fix name of year
  rename("graduates" = scoretype) %>%
  # Add projections column
  add_column('proj' = c(0, 0, 0))

m8bt %>%
  kbl(align="rrrrrr") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), font_size = 13) %>%
  column_spec(6, color = "#0066CC", background = "rgba(0,102,204,.1)") %>%
  row_spec(3, bold = T)

```



**Details**:

* 160 new FTICs
  + 103 (64%) with high school ranks
    - **Top 10% = 21.4 (22/103)**
    - Top 25% = 50%
    - Top 50% = 88%
    - Bottom 50% = 12%
  
UF's percentages somehow increased 4% from what they reported in their 2020 Accountability Plan.  I'm trying to learn what happened.



### Metric 9a: `r PBF$name_long[PBF$metric=="9a"][1]` {data-commentary-width=390}

```{r metric9a, warning=FALSE, message=FALSE}
# Set metric number
mn <- "9a"

# Calculate secondary axis marks
xone <- benchmarks$b1[benchmarks$metric==mn & benchmarks$datayear==yearnew]
m <- 1/(benchmarks$b2[benchmarks$metric==mn & benchmarks$datayear==yearnew]-xone)
yint <- (-xone+(1/m))/(1/m)

pm9a <- PBF %>%
  filter(metric == mn) %>%
  ggplot(aes(x = datayear, y = outcome, group = school)) +
  geom_ribbon(data = . %>% filter(unitid==262129),
              aes(x = datayear, ymin = 0, ymax=b1), fill = "#D6641E", alpha=0.2) +
  geom_ribbon(data = . %>% filter(unitid==262129),
                                      aes(x = datayear, ymin = b5, ymax=100), fill = "#2B9F78", alpha=0.2) +
  geom_ribbon(data = . %>% filter(unitid==133650), 
              aes(x = datayear, ymin=min_outcome, ymax=max_outcome), alpha=0.15) +
  annotate("text", x = 2016.5, y = 50, label="other Florida\nSUS schools", color="#000000", size=4.5) +
  annotate("text", x = 2018, y = 7, label="NCF annual data", color="#0066CC", size=3) +
  annotate("text", x = 2018, y = 32, label="NCF rolling\n3-yr avg.", color="#0066CC", size=4.5) +
  #annotate("text", x = 2020, y = 97, label="goals", color="grey50", size=4.5) +
  annotate("text", x = yearend-5.1, y = 40, label="excellence\nbenchmarks", color="grey50", size=4.5, hjust=1) +
  geom_line(data = . %>% filter(group=="SUS"), 
              aes(x = datayear, y=outcome), alpha=0.2, size=0.5) +
  geom_line(data = . %>% filter(group=="goal", datayear>2020), color="grey50", 
            alpha=0.7, size=1, linetype="21") +
  geom_label(data = . %>% filter(group=="goal", datayear>2020), 
             aes(label = sprintf("%0.0f", round(outcome,0))),
             size=5, fill="gold", color="grey50",
             label.padding = unit(0.15, "lines"), label.size = 0.1) +
  geom_line(data = . %>% filter(group=="proj"), color="#0066CC", alpha=0.4, linetype="dotted", size=1) +
  geom_line(data = . %>% filter(group=="NCF"), color="#0066CC", size=1, alpha=0.6) +
  geom_line(data = . %>% filter(group=="roll"), color="#0066CC", size=3) +
  # TRYING THIS
  geom_label(data = . %>% filter(group=="proj", datayear == 2019), 
             aes(label = "projected"),
             size=3, fontface="bold", fill="#0066CC", alpha=0.4, color="#FFFFFF",
             label.padding = unit(0.25, "lines"), label.size = 0.15) +
  geom_label(data = . %>% filter(group=="roll"), 
             aes(label = sprintf("%0.1f", round(outcome,1))),
             size=6, fontface="bold", fill="#0066CC", color="#FFFFFF",
             label.padding = unit(0.25, "lines"), label.size = 0.15) +
  geom_line_interactive(data = . %>% filter(group %in% c("NCF", "SUS", "goal", "proj")), 
                        aes(tooltip = school, data_id=school, hover_css = "fill:none;"),
                       size=2.5, alpha=0.01) +
  geom_point_interactive(data = . %>% filter(group %in% c("NCF", "SUS")), 
                        aes(tooltip = paste0(outcome,"
",school), data_id=school, hover_css = "fill:none;"),
                        size=3, alpha=0.01) +
  labs(title = paste("Metric 9a: ", PBF$name_short[PBF$metric==mn]), y=NULL, 
       x = "Incoming cohort") +
  scale_x_continuous(expand = c(0,0), breaks=seq(yearold, yearend, 1), 
                     minor_breaks=seq(yearold, yearend, 1)) +
  scale_y_continuous(expand = c(0,0), breaks=seq(0, 109, 10), minor_breaks=NULL) +
  scale_y_continuous(expand = c(0,0), 
                     sec.axis = sec_axis(trans = ~.*m+yint,
                     breaks=seq(1, 5, 1),
                     label=c(paste("1 (", benchmarks$b1[benchmarks$metric==mn & benchmarks$datayear==yearnew], "%)", sep = ""),
                             paste("2 (", benchmarks$b2[benchmarks$metric==mn & benchmarks$datayear==yearnew], "%)", sep = ""),
                             paste("3 (", benchmarks$b3[benchmarks$metric==mn & benchmarks$datayear==yearnew], "%)", sep = ""),
                             paste("4 (", benchmarks$b4[benchmarks$metric==mn & benchmarks$datayear==yearnew], "%)", sep = ""),
                             paste("5 (", benchmarks$b5[benchmarks$metric==mn & benchmarks$datayear==yearnew], "%)", sep = "")))) +
  coord_cartesian(ylim = c(-1,70), xlim = c(yearold+0.5, yearend-5), expand = TRUE) +
  custom_plot
  

# Make it interactive
pm9a <- girafe(code = print(pm9a), height_svg=8.3, width_svg=15,
              options = list(opts_tooltip(offx=-10, offy=15, 
                              css="background-color:gray;color:white;font-style:bold;padding:5px;border-radius:5px;"),
                              opts_hover(css = "stroke:#FF0000;fill:#FF0000;stroke-width:3px;stroke-opacity:0.8;")))

pm9a

```

***

[BOG Definition](https://www.flbog.edu/pbf__graduation__retention-methodology_2020-09-01/):



Percent of Florida College System graduates with AA degrees who enter full-time in Summer or Fall and earn their degree by the second summer term after entry.








**scores** and projections

```{r m9a_table}
m9at <- total %>%
  filter(metric == mn,
         school == "NCF", 
         year > 2017) %>%
  select(year, excellence, improvement, score) %>%
  pivot_longer(!year, names_to = "scoretype", values_to = "scorey") %>%
  # Manually fix year to match data year
  mutate(year = year-1) %>%
  pivot_wider(id_cols = "scoretype", names_from = "year", values_from = "scorey") %>%
  # Manually fix name of year
  rename("graduates" = scoretype) %>%
  # Add projections column
  add_column('proj' = c(0, 0, 0))

m9at %>%
  kbl(align="rr") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), font_size = 13) %>%
  column_spec(3, color = "#0066CC", background = "rgba(0,102,204,.1)") %>%
  row_spec(3, bold = T)

```


**Details**:

* FCS AA cohorts - Fall of
  + 2014 = 5/17 graduate
  + 2015 = 3/12
  + 2016 = 4/17
  + 2017 = 5/12
    - +2 graduated in 3 years
  + 2018 = 1/11
  + 2019 = 1/8
  + 2020 = ?/14


### Metric 9b: `r PBF$name_long[PBF$metric=="9b"][1]` {data-commentary-width=390}

```{r metric9b, warning=FALSE, message=FALSE}
# Set metric number
mn <- "9b"

# Calculate secondary axis marks
xone <- benchmarks$b1[benchmarks$metric==mn & benchmarks$datayear==yearnew]
m <- 1/(benchmarks$b2[benchmarks$metric==mn & benchmarks$datayear==yearnew]-xone)
yint <- (-xone+(1/m))/(1/m)

pm9b <- PBF %>%
  filter(metric == mn) %>%
  ggplot(aes(x = datayear, y = outcome, group = school)) +
  geom_ribbon(data = . %>% filter(unitid==262129),
              aes(x = datayear, ymin = 0, ymax=b1), fill = "#D6641E", alpha=0.2) +
  geom_ribbon(data = . %>% filter(unitid==262129),
                                      aes(x = datayear, ymin = b5, ymax=100), fill = "#2B9F78", alpha=0.2) +
  geom_ribbon(data = . %>% filter(unitid==133650), 
              aes(x = datayear, ymin=min_outcome, ymax=max_outcome), alpha=0.15) +
  annotate("text", x = 2016.5, y = 50, label="other Florida\nSUS schools", color="#000000", size=4.5) +
  #annotate("text", x = 2020, y = 97, label="goals", color="grey50", size=4.5) +
  annotate("text", x = yearend-5.1, y = 70, label="excellence\nbenchmarks", color="grey50", size=4.5, hjust=1) +
  geom_line(data = . %>% filter(group=="SUS"), 
              aes(x = datayear, y=outcome), alpha=0.2, size=0.5) +
  geom_line(data = . %>% filter(group=="goal", datayear>2020), color="grey50", 
            alpha=0.7, size=1, linetype="21") +
  geom_label(data = . %>% filter(group=="goal", datayear>2020), 
             aes(label = sprintf("%0.0f", round(outcome,0))),
             size=5, fill="gold", color="grey50",
             label.padding = unit(0.15, "lines"), label.size = 0.1) +
  geom_line(data = . %>% filter(group=="proj"), color="#0066CC", alpha=0.4, linetype="dotted", size=1) +
  geom_line(data = . %>% filter(group=="NCF"), color="#0066CC", size=3) +
  # TRYING THIS
  geom_label(data = . %>% filter(group=="proj", datayear == yearnew), 
             aes(label = "projected"),
             size=3, fontface="bold", fill="#0066CC", alpha=0.4, color="#FFFFFF",
             label.padding = unit(0.25, "lines"), label.size = 0.15) +
  geom_label(data = . %>% filter(group=="NCF"), 
             aes(label = sprintf("%0.1f", round(outcome,1))),
             size=6, fontface="bold", fill="#0066CC", color="#FFFFFF",
             label.padding = unit(0.25, "lines"), label.size = 0.15) +
  geom_line_interactive(data = . %>% filter(group %in% c("NCF", "SUS", "goal", "proj")), 
                        aes(tooltip = school, data_id=school, hover_css = "fill:none;"),
                       size=2.5, alpha=0.01) +
  geom_point_interactive(data = . %>% filter(group %in% c("NCF", "SUS")), 
                        aes(tooltip = paste0(outcome,"
",school), data_id=school, hover_css = "fill:none;"),
                        size=3, alpha=0.01) +
  labs(title = paste("Metric 9b: ", PBF$name_short[PBF$metric==mn]), y=NULL, 
       x = "Incoming cohort") +
  scale_x_continuous(expand = c(0,0), breaks=seq(yearold, yearend, 1), 
                     minor_breaks=seq(yearold, yearend, 1)) +
  scale_y_continuous(expand = c(0,0), breaks=seq(0, 109, 10), minor_breaks=NULL) +
  scale_y_continuous(expand = c(0,0), 
                     sec.axis = sec_axis(trans = ~.*m+yint,
                     breaks=seq(1, 5, 1),
                     label=c(paste("1 (", benchmarks$b1[benchmarks$metric==mn & benchmarks$datayear==yearnew], "%)", sep = ""),
                             paste("2 (", benchmarks$b2[benchmarks$metric==mn & benchmarks$datayear==yearnew], "%)", sep = ""),
                             paste("3 (", benchmarks$b3[benchmarks$metric==mn & benchmarks$datayear==yearnew], "%)", sep = ""),
                             paste("4 (", benchmarks$b4[benchmarks$metric==mn & benchmarks$datayear==yearnew], "%)", sep = ""),
                             paste("5 (", benchmarks$b5[benchmarks$metric==mn & benchmarks$datayear==yearnew], "%)", sep = "")))) +
  coord_cartesian(ylim = c(20,100), xlim = c(yearold+1.5, yearend-5), expand = TRUE) +
  custom_plot
  

# Make it interactive
pm9b <- girafe(code = print(pm9b), height_svg=8.3, width_svg=15,
              options = list(opts_tooltip(offx=-10, offy=15, 
                              css="background-color:gray;color:white;font-style:bold;padding:5px;border-radius:5px;"),
                              opts_hover(css = "stroke:#FF0000;fill:#FF0000;stroke-width:3px;stroke-opacity:0.8;")))

pm9b

```

***

[BOG Definition](https://www.flbog.edu/pbf__graduation__retention-methodology_2020-09-01/):



Of the full- or part-time students who enter in Summer or Fall and receive a Pell Grant during their first year, the percent who graduate by the summer of their sixth year.











**scores** and projections

```{r m9b_table}
m9bt <- total %>%
  filter(metric == mn,
         school == "NCF", 
         year > 2017) %>%
  select(year, excellence, improvement, score) %>%
  pivot_longer(!year, names_to = "scoretype", values_to = "scorey") %>%
  # Manually fix year to match data year
  mutate(year = year-1) %>%
  pivot_wider(id_cols = "scoretype", names_from = "year", values_from = "scorey") %>%
  # Manually fix name of year
  rename("graduates" = scoretype) %>%
  # Add projections column
  add_column('proj' = c(0, 0, 0))

m9bt %>%
  kbl(align="rr") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), font_size = 13) %>%
  column_spec(3, color = "#0066CC", background = "rgba(0,102,204,.1)") %>%
  row_spec(3, bold = T)

```



**Details**:

* Pell cohorts - Fall of
  + 2010 = 25/47 graduate
  + 2011 = 45/70
  + 2012 = 33/55
  + 2013 = 36/58
  + 2014 = 43/71
  + 2015 = 45/69


### Metric 10: `r PBF$name_long[PBF$metric=="10"][1]` {data-commentary-width=390}

```{r metric10, warning=FALSE, message=FALSE}
# Set metric number
mn <- "10"

# Calculate secondary axis marks
xone <- benchmarks$b1[benchmarks$metric==mn & benchmarks$datayear==yearnew]
m <- 1/(benchmarks$b2[benchmarks$metric==mn & benchmarks$datayear==yearnew]-xone)
yint <- (-xone+(1/m))/(1/m)

pm10 <- PBF %>%
  filter(metric == mn) %>%
  ggplot(aes(x = datayear, y = outcome, group = school)) +
  benchmark_ribbons +
  geom_ribbon(data = . %>% filter(unitid==133650), 
              aes(x = datayear, ymin=min_outcome, ymax=max_outcome), alpha=0.15) +
  annotate("text", x = yearend-5.1, y = 45, label="excellence\nbenchmarks", color="grey50", size=4.5, hjust=1) +
  geom_line(data = . %>% filter(group=="SUS"), 
              aes(x = datayear, y=outcome), alpha=0.2, size=0.5) +
  geom_line(data = . %>% filter(group=="goal", datayear>yearnew), color="grey50", 
            alpha=0.7, size=1, linetype="21") +
  geom_label(data = . %>% filter(group=="goal", datayear>yearnew), 
             aes(label = sprintf("%0.0f", round(outcome,0))),
             size=5, fill="gold", color="grey50",
             label.padding = unit(0.15, "lines"), label.size = 0.1) +
  geom_line(data = . %>% filter(group=="proj"), color="#0066CC", alpha=0.4, linetype="dotted", size=1) +
  geom_line(data = . %>% filter(group=="NCF"), color="#0066CC", size=3) +
  # TRYING THIS
  geom_label(data = . %>% filter(group=="proj", datayear == yearnew), 
             aes(label = "projected"),
             size=3, fontface="bold", fill="#0066CC", alpha=0.4, color="#FFFFFF",
             label.padding = unit(0.25, "lines"), label.size = 0.15) +
  geom_label(data = . %>% filter(group=="NCF"), 
             aes(label = sprintf("%0.1f", round(outcome,1))),
             size=6, fontface="bold", fill="#0066CC", color="#FFFFFF",
             label.padding = unit(0.25, "lines"), label.size = 0.15) +
  geom_line_interactive(data = . %>% filter(group %in% c("NCF", "SUS", "goal", "proj")), 
                        aes(tooltip = school, data_id=school, hover_css = "fill:none;"),
                       size=2.5, alpha=0.01) +
  geom_point_interactive(data = . %>% filter(group %in% c("NCF", "SUS")), 
                        aes(tooltip = paste0(outcome,"
",school), data_id=school, hover_css = "fill:none;"),
                        size=3, alpha=0.01) +
  labs(title = paste("Metric 10: ", PBF$name_short[PBF$metric==mn]), y=NULL, 
       x = "Spring") +
  scale_x_continuous(expand = c(0,0), breaks=seq(yearold, yearend, 1), 
                     minor_breaks=seq(yearold, yearend, 1)) +
  scale_y_continuous(expand = c(0,0), breaks=seq(0, 109, 10), minor_breaks=NULL) +
  scale_y_continuous(expand = c(0,0), 
                     sec.axis = sec_axis(trans = ~.*m+yint,
                     breaks=seq(1, 10, 1),
                     label=c(paste("1 (", benchmarks$b1[benchmarks$metric==mn & benchmarks$datayear==yearnew], "%)", sep = ""),
                             paste("2 (", benchmarks$b2[benchmarks$metric==mn & benchmarks$datayear==yearnew], "%)", sep = ""),
                             paste("3 (", benchmarks$b3[benchmarks$metric==mn & benchmarks$datayear==yearnew], "%)", sep = ""),
                             paste("4 (", benchmarks$b4[benchmarks$metric==mn & benchmarks$datayear==yearnew], "%)", sep = ""),
                             paste("5 (", benchmarks$b5[benchmarks$metric==mn & benchmarks$datayear==yearnew], "%)", sep = ""),
                             paste("6 (", benchmarks$b6[benchmarks$metric==mn & benchmarks$datayear==yearnew], "%)", sep = ""),
                             paste("7 (", benchmarks$b7[benchmarks$metric==mn & benchmarks$datayear==yearnew], "%)", sep = ""),
                             paste("8 (", benchmarks$b8[benchmarks$metric==mn & benchmarks$datayear==yearnew], "%)", sep = ""),
                             paste("9 (", benchmarks$b9[benchmarks$metric==mn & benchmarks$datayear==yearnew], "%)", sep = ""),
                             paste("10 (", benchmarks$b10[benchmarks$metric==mn & benchmarks$datayear==yearnew], "%)", sep = "")))) +
  coord_cartesian(ylim = c(0,100), xlim = c(yearold+2.5, yearend-5), expand = TRUE) +
  custom_plot
  

# Make it interactive
pm10 <- girafe(code = print(pm10), height_svg=5, width_svg=10,
              options = list(opts_sizing(rescale = TRUE, width = .8),
                             opts_tooltip(offx=-10, offy=15,
                              css="background-color:gray;color:white;font-style:bold;padding:5px;border-radius:5px;"),
                              opts_hover(css = "stroke:#FF0000;fill:#FF0000;stroke-width:3px;stroke-opacity:0.8;")))

pm10

                                          
```

####


| Year                               |2015|2016|2017|2018|2019|2020|2021|2022|
|:-----------------------------------|---:|---:|---:|---:|---:|---:|---:|---:|
| FTIC graduates		                 |155	|138 |135	|152 |178	|152 |131 |    |
| Capstone/Thesis		                 |155	|138 |135	|152 |178	|152 |131 |    |
| Internships			                   |44	|71	 |59	|74	 |73	|54	 |49  |    |
| Study Abroad			                 |30	|26	 |22	|17	 |32	|22	 |15  |    |
| Writing-intensive courses			     |55	|47	 |68	|109 |124	|117 |115 |    |
| Living-learning Communities			   |4	  |17	 |41	|59	 |77	|91	 |71  |    |
| Externally-funded faculty research |3	  |6	 |11  |12	 |15	|14	 |10  |    |
| First-year experience			         |0	  |0	 |0	  |0	 |0   |0	 |0   |    |
| Learning communities			         |0	  |0	 |0	  |0	 |0   |0	 |0   |    |
| Service learning			             |0	  |0	 |0	  |0	 |0   |0	 |1   |    |
| Collaborative projects			       |0	  |0	 |0	  |0	 |48	|92	 |87  |    |
|:-----------------------------------|---:|---:|---:|---:|---:|---:|---:|---:|
| # completing exactly 1 HIP			   |54	|34	 |19	|12	 |14	|5	 |1   |    |
| # completing exactly 2 HIPs			   |68	|51	 |53	|52	 |47	|16	 |8   |    |
| # completing 3+ HIPs			         |33	|53	 |63	|88	 |117	|131 |122 |    |


System {.storyboard}
=======================================================================

### How does the Performance Based Funding (PBF) system work?

![PBF System](https://bradthiessen.com/pbfsystem.png){width=100% height=100%}



### What are the metrics? {data-commentary-width=390}

For 2021-22 funding, our performance will be measured on the following 10 metrics:




```{r PBF_metrics_list}

metric_names %>%
  select(-name_short) %>%
  filter(!(metric %in% c("8a", "9"))) %>%
  rename(name = name_long) %>%
  gt() %>%
  tab_header(title = "PBF Metrics") %>%
  tab_options(
    table.font.size = px(14L),
    column_labels.background.color = "#0066CC",
    column_labels.font.weight = "bold",
    data_row.padding = px(6)
  ) %>%
  cols_align(align="right", columns = vars(metric)) %>%
  tab_source_note(
    source_note = md("*Why are there 11 metrics? Metrics 9a and 9b are new 5-point metrics for 2021-22.*
*Is there a metric 8a?  Yes, but it does not apply to New College... yet.*"))


```

***

We receive two scores for each metric:

* 0-10 **excellence** points
  + our performance compared to [benchmarks](https://www.flbog.edu/wp-content/uploads/2020-Benchmarks.pdf) from the State University System of Florida strategic plan.
* 0-10 **improvement** points
  + +1 point for each 0.5% improvement from the previous year

Our final score for each metric (displayed in the table) is the **higher** of the excellence and improvement points.



Our total score, then, can range from 0-100 points.


### What total score do we need to earn to receive PBF funds?

Our goal is to score **at least 70 points each year** without having our score drop two years in a row.




The allocation process has become complex.  This is my understanding:

* To earn \$8.5$M ($\$4.5$M from our base budget + $\$4$M in additional state investment), we must:
  + score among the top 3 schools, or
  + **score > 70 points** without having two consecutive years of declining scores
  



* To earn \$6.5$M ($\$4.5$M from our base budget + **half** of the $\$4$M in additional state investment), we must:
  + **score between 60-70** points without having two consecutive years of declining scores, and
  + write an improvement plan that is approved by the Board of Governors




* To earn "less than 100%" of our $\$4.5$M in base funding plus **half** of the $\$4$M in additional state investment, we must:
  + **score < 60 points** without having two consecutive years of declining scores, and
  + write an improvement plan that is approved by the Board of Governors




* If our score drops for two consecutive years, we will need to write an improvement plan to earn any of the state investment.




Funds not allocated to low-performing schools are allocated to the highest performers, so **it's possible for New College to earn more than $8.5M each year.**





Satisfaction {data-orientation=rows data-icon="fa-smile"}
=======================================================================


Row
-----------------------------------------------------------------------
### Choose Again {.no-title}

```{r}
# Select final non-missing value
item <- "nsse"
last <- last(na.omit(satisfaction$result[satisfaction$item==item]))
describe <- "% would choose NCF again"

valueBox(last, caption = describe, icon = "fa-redo",
         color = ifelse(last >= 90, "rgba(43,159,120,.4)", 
                        ifelse(last >= 75, "rgba(240,229,75,.4)",
                               ifelse(last <= 75, "rgba(214,100,30,.4)",
                                      "#ffffff"))))

```

### Educational Experience {.no-title}

```{r}
item <- "nsse2"
last <- last(na.omit(satisfaction$result[satisfaction$item==item]))
describe <- "% rating overall experience as good"

valueBox(last, caption = describe, icon = "fa-user-graduate",
         color = ifelse(last >= 90, "rgba(43,159,120,.4)", 
                        ifelse(last >= 75, "rgba(240,229,75,.4)",
                               ifelse(last <= 75, "rgba(214,100,30,.4)",
                                      "#ffffff"))))


```

### Academic Experience {.no-title}

```{r}
item <- "bss1"
last <- last(na.omit(satisfaction$result[satisfaction$item==item]))
describe <- "% satisfied with academic experience"

valueBox(last, caption = describe, icon = "fa-user-graduate",
         color = ifelse(last >= 90, "rgba(43,159,120,.4)", 
                        ifelse(last >= 75, "rgba(240,229,75,.4)",
                               ifelse(last <= 75, "rgba(214,100,30,.4)",
                                      "#ffffff"))))


```

### Non-academic experience {.no-title}

```{r}
item <- "bss2"
last <- last(na.omit(satisfaction$result[satisfaction$item==item]))
describe <- "% satisfied with non-academic experience"

valueBox(last, caption = describe, icon = "fa-star",
         color = ifelse(last >= 90, "rgba(43,159,120,.4)", 
                        ifelse(last >= 75, "rgba(240,229,75,.4)",
                               ifelse(last <= 75, "rgba(214,100,30,.4)",
                                      "#ffffff"))))

```



Row {.tabset .tabset-fade}
-----------------------------------------------------------------------

### Overall 

```{r, fig.width=8, fig.height=4}

satisfaction %>%
  filter(item=="nsse") %>%
  ggplot(aes(x = year, y=result)) +
  geom_line(color="#0066CC", size=1.5) +
  geom_label(data = . %>% filter(interpolated==0), 
             aes(label = result),
             size=3, fontface="bold", fill="#0066CC", color="#FFFFFF",
             label.padding = unit(0.25, "lines"), label.size = 0.15) +
    labs(title = "% who would choose NCF again", y=NULL, 
       x = "Graduating Class") +
  geom_line(aes(x = year, y = goal), color="grey50", 
            alpha=0.7, size=1, linetype="21") +
  geom_label(aes(x = year, y = goal, label = sprintf("%0.0f", round(goal,0))),
             size=3, fill="gold", color="grey50",
             label.padding = unit(0.15, "lines"), label.size = 0.1) +
  scale_x_continuous(expand = c(0,0), breaks=seq(2002, 2024, 2), 
                     minor_breaks=seq(2002, 2024, 1)) +
  scale_y_continuous(expand = c(0,0), breaks=seq(0, 100, 20), minor_breaks=NULL) +
  coord_cartesian(ylim = c(0,100), xlim = c(2001.5, 2024.5), expand = TRUE) +
  theme(
    plot.title = element_text(color="#000000", size=12),
    axis.title.x = element_text(color="grey40", size=11),
    axis.title.y = element_text(color="grey40", size=11),
    axis.text.x = element_text(color="grey40", size=11),
    axis.text.y = element_text(color = "grey40", size=11),
    legend.position = "none",
    panel.grid.major = element_line(colour = "white"),
    panel.grid.minor = element_blank(),
    panel.background = element_rect(fill = "grey95"))


```


### Educational Experience

```{r, fig.width=8, fig.height=4}

satisfaction %>%
  filter(item=="nsse2") %>%
  ggplot(aes(x = year, y=result)) +
  geom_line(color="#0066CC", size=1.5) +
  geom_label(data = . %>% filter(interpolated==0), 
             aes(label = result),
             size=3, fontface="bold", fill="#0066CC", color="#FFFFFF",
             label.padding = unit(0.25, "lines"), label.size = 0.15) +
    labs(title = "% who think the entire educational experience was good", y=NULL, 
       x = "Graduating Class") +
  geom_line(aes(x = year, y = goal), color="grey50", 
            alpha=0.7, size=1, linetype="21") +
  geom_label(aes(x = year, y = goal, label = sprintf("%0.0f", round(goal,0))),
             size=3, fill="gold", color="grey50",
             label.padding = unit(0.15, "lines"), label.size = 0.1) +
  scale_x_continuous(expand = c(0,0), breaks=seq(2002, 2024, 2), 
                     minor_breaks=seq(2002, 2024, 1)) +
  scale_y_continuous(expand = c(0,0), breaks=seq(0, 100, 20), minor_breaks=NULL) +
  coord_cartesian(ylim = c(0,100), xlim = c(2001.5, 2024.5), expand = TRUE) +
  theme(
    plot.title = element_text(color="#000000", size=12),
    axis.title.x = element_text(color="grey40", size=11),
    axis.title.y = element_text(color="grey40", size=11),
    axis.text.x = element_text(color="grey40", size=11),
    axis.text.y = element_text(color = "grey40", size=11),
    legend.position = "none",
    panel.grid.major = element_line(colour = "white"),
    panel.grid.minor = element_blank(),
    panel.background = element_rect(fill = "grey95"))


```


### Academic 

```{r, fig.width=8, fig.height=4}

satisfaction %>%
  filter(item=="bss1") %>%
  ggplot(aes(x = year, y=result)) +
  geom_line(color="#0066CC", size=1.5) +
  geom_label(data = . %>% filter(interpolated==0), 
             aes(label = result),
             size=3, fontface="bold", fill="#0066CC", color="#FFFFFF",
             label.padding = unit(0.25, "lines"), label.size = 0.15) +
    labs(title = "% satisfied with academic experience", y=NULL, 
       x = "Graduating Class") +
  geom_line(aes(x = year, y = goal), color="grey50", 
            alpha=0.7, size=1, linetype="21") +
  geom_label(aes(x = year, y = goal, label = sprintf("%0.0f", round(goal,0))),
             size=3, fill="gold", color="grey50",
             label.padding = unit(0.15, "lines"), label.size = 0.1) +
  scale_x_continuous(expand = c(0,0), breaks=seq(2002, 2024, 2), 
                     minor_breaks=seq(2002, 2024, 1)) +
  scale_y_continuous(expand = c(0,0), breaks=seq(0, 100, 20), minor_breaks=NULL) +
  coord_cartesian(ylim = c(0,100), xlim = c(2001.5, 2024.5), expand = TRUE) +
  theme(
    plot.title = element_text(color="#000000", size=12),
    axis.title.x = element_text(color="grey40", size=11),
    axis.title.y = element_text(color="grey40", size=11),
    axis.text.x = element_text(color="grey40", size=11),
    axis.text.y = element_text(color = "grey40", size=11),
    legend.position = "none",
    panel.grid.major = element_line(colour = "white"),
    panel.grid.minor = element_blank(),
    panel.background = element_rect(fill = "grey95"))


```

### Non-academic satisfaction

```{r, fig.width=8, fig.height=4}

satisfaction %>%
  filter(item=="bss2") %>%
  ggplot(aes(x = year, y=result)) +
  geom_line(color="#0066CC", size=1.5) +
  geom_label(data = . %>% filter(interpolated==0), 
             aes(label = result),
             size=3, fontface="bold", fill="#0066CC", color="#FFFFFF",
             label.padding = unit(0.25, "lines"), label.size = 0.15) +
    labs(title = "% satisfied with the non-academic experience", y=NULL, 
       x = "Graduating Class") +
  geom_line(aes(x = year, y = goal), color="grey50", 
            alpha=0.7, size=1, linetype="21") +
  geom_label(aes(x = year, y = goal, label = sprintf("%0.0f", round(goal,0))),
             size=3, fill="gold", color="grey50",
             label.padding = unit(0.15, "lines"), label.size = 0.1) +
  scale_x_continuous(expand = c(0,0), breaks=seq(2002, 2024, 2), 
                     minor_breaks=seq(2002, 2024, 1)) +
  scale_y_continuous(expand = c(0,0), breaks=seq(0, 100, 20), minor_breaks=NULL) +
  coord_cartesian(ylim = c(0,100), xlim = c(2001.5, 2024.5), expand = TRUE) +
  theme(
    plot.title = element_text(color="#000000", size=12),
    axis.title.x = element_text(color="grey40", size=11),
    axis.title.y = element_text(color="grey40", size=11),
    axis.text.x = element_text(color="grey40", size=11),
    axis.text.y = element_text(color = "grey40", size=11),
    legend.position = "none",
    panel.grid.major = element_line(colour = "white"),
    panel.grid.minor = element_blank(),
    panel.background = element_rect(fill = "grey95"))


```





```{r eval=FALSE}
# Row {.tabset .tabset-fade}
# -----------------------------------------------------------------------
# 
# ### Test 
# 
# ### Two Plots
# 
# You should see two plots.
# 
# #### Plot1: wt, hp
# 
# ```{r}
# plotDf <- mtcars[,c("wt","hp")]
# plot(plotDf)
# ```
# 
# #### Plot2: mpg, disp
# 
# ```{r}
# plotDf <- mtcars[,c("mpg","disp")]
# plot(plotDf)
# 

```
New College Metric Scores
metric	2016	2017	2018	2019	2020	2021	2022
1. enrolled/employed	0	0	10	1	10	0	0-7
2. median salary	3	10	4	4	10	10	6-8
3. net cost of degree	0	10	10	10	10	10	10
4. 4-year grad rate	10	4	10	10	10	10	6
5. retention rate	3	6	1	0	10	2	0-1
6. UG PSEs	5	10	10	9	10	10	7-8
7. Pell recipients	10	8	6	7	7	6	7
8a: Graduate degrees in PSEs
8b. Top 10% first-years	8	7	4	6	0	5	0
9. % without excess hours	10	10	10	10	10
9a. 2-year transfer grad rate						0	0
9b. 6-year Pell grad rate						1	4
10. 3+ HIPs	10	10	10	10	10	10	10
Final Score	59	75	75	67	87	64	50-61
New College PBF Metric Scores
metric	2016-17			2017-18			2018-19			2019-20			2020-21			2021-22			2022-23
metric	exc	imp	2016	exc	imp	2017	exc	imp	2018	exc	imp	2019	exc	imp	2020	exc	imp	2021	exc	imp	proj.
1. enrolled/employed	0	0	0	0	0	0	1	10	10	1	0	1	6	10	10	0	0	0	0-1	0-7	0-7
2. median salary	3	0	3	4	10	10	4	1	4	4	0	4	5	10	10	8	10	10	6-8	0-8	6-8
3. net cost of degree	0	0	0	10	10	10	10	0	10	10	10	10	10	10	10	10	10	10	10	?	10
4. 4-year grad rate	10	2	10	4	0	4	10	2	10	10	4	10	10	4	10	10	0	10	6	2	6
5. retention rate	3	2	3	5	6	6	1	0	1	0	0	0	6	10	10	2	0	2	0-1	0	0-1
6. UG PSEs	5	0	5	8	10	10	10	10	10	9	0	9	10	9	10	10	10	10	7-8	0	7-8
7. Pell recipients	10	2	10	8	0	8	6	2	6	7	7	7	7	0	7	6	0	6	7	4	7
8a. Graduate PSEs
8b. Top 10% first-years	8	8	8	7	0	7	4	0	4	5	6	6	0	0	0	0	5	5	0	0	0
9. % without excess hours	10	0	10	10	0	10	10	1	10	10	0	10	10	7	10
9a. 2-year transfer grad rate																0	0	0	0	0	0
9b. 6-year Pell grad rate																1	0	1	4	2	4
10. 3+ HIPs	10	0	10	10	0	10	10	0	10	10	0	10	9	10	10	10	10	10	10	10	10
sum	—	—	59	—	—	75	—	—	75	—	—	67	—	—	87	—	—	64	—	—	—
PBF Metrics
metric	name
1	Percent of Bachelor's Graduates Enrolled or Employed ($30,000+) in the U.S. One Year After Graduation
2	Median Wages of Bachelor’s Graduates Employed Full-time One Year After Graduation
3	Average Cost to the Student [Net Tuition & Fees per 120 Credit Hours for Resident Undergraduates]
4	Four Year FTIC Graduation Rate
5	Academic Progress Rate (2nd year retention with GPA above 2.0)
6	Bachelor’s Degrees within Programs of Strategic Emphasis
7	University Access Rate (Percent of Undergraduates with a Pell Grant)
8b	Freshmen in Top 10% of Graduating High School Class
9a	2-year graduation rate for full-time FCS AA Transfers
9b	6-year graduation rate for students who receive Pell grants in their first year
10	Percent of FTIC graduates completing 3 or more High-Impact Practices
Why are there 11 metrics? Metrics 9a and 9b are new 5-point metrics for 2021-22. Is there a metric 8a? Yes, but it does not apply to New College... yet.
SP

Row

Why?New College of Florida prepares intellectually curious students for lives of great achievement.

Row

Where?Top 20 liberal arts college in the nation.

Row

What?1200 students by 2025?

What?80% 4-year grad rate

PBF

Overall Score Trend

Total PBF Scores

Excellence & Improvement

Excellence, Improvement, and Total PBF Score Trends

Metric 1: Percent of Bachelor’s Graduates Enrolled or Employed ($30,000+) in the U.S. One Year After Graduation

Metric 2: Median Wages of Bachelor’s Graduates Employed Full-time One Year After Graduation

Metric 3: Average Cost to the Student [Net Tuition & Fees per 120 Credit Hours for Resident Undergraduates]

Metric 4: Four Year FTIC Graduation Rate

Metric 5: Academic Progress Rate (2nd year retention with GPA above 2.0)

Metric 6: Bachelor’s Degrees within Programs of Strategic Emphasis

Metric 7: University Access Rate (Percent of Undergraduates with a Pell Grant)

Metric 8a: Graduate Degrees within Programs of Strategic Emphasis

of masters degrees awarded:

Metric 8b: Freshmen in Top 10% of Graduating High School Class

Metric 9a: 2-year graduation rate for full-time FCS AA Transfers

Metric 9b: 6-year graduation rate for students who receive Pell grants in their first year

Metric 10: Percent of FTIC graduates completing 3 or more High-Impact Practices

System

How does the Performance Based Funding (PBF) system work?

What are the metrics?

What total score do we need to earn to receive PBF funds?

Satisfaction

Row

Choose Again

Educational Experience

Academic Experience

Non-academic experience

Row

Overall

Educational Experience

Academic

Non-academic satisfaction
