---
title: "2019 STAR Math Placement Exam Dashboard"
author: "Jonathan Collins"
date: "10/28/2026"
output:
  flexdashboard::flex_dashboard:
    orientation: rows
    vertical_layout: scroll
    source_code: embed
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE, message = FALSE, warning = FALSE,
                      fig.width = 8, fig.height = 4)
options(DT.fillContainer = FALSE, DT.autoHideNavigation = FALSE)
library(flexdashboard)
library(tidyverse)
library(DT)
library(readxl)
library(readr)
STAR_data_for_MS_282 <- read_excel("~/Downloads/STAR data for MS 282.xlsx")
ACT_SAT_Concordance_All_Tables <- read_csv("~/Downloads/ACT_SAT_Concordance_All_Tables.csv")
```

```{css, echo=FALSE}
/* Let every box grow to fit ALL of its text, code, and output (no inner scrolling) */
.row, .section.level2, .section.level3,
.chart-wrapper, .chart-stage, .chart-shim, .chart-stage-flex {
  height: auto !important;
  min-height: 0 !important;
  max-height: none !important;
  overflow: visible !important;
}

/* Wrap long lines of code instead of scrolling sideways */
pre, pre code, div.sourceCode, pre.sourceCode {
  white-space: pre-wrap !important;
  word-break: break-word !important;
  overflow: visible !important;
  max-height: none !important;
}

.chart-stage > p { margin-bottom: 0.75em; }


```

Introduction
=====================================================================

Row {data-height=450}
---------------------------------------------------------------------

### Introduction

To give a little background, every summer before Freshman year at Aquinas College, students take the STAR math placement exam. This will produce a placement score, and this project will help clean the data and provide details about what these scores relate to.

This data came from a spreadsheet that contained a list of 2019 STAR students and their high school, GPA, ACT/SAT math scores, career goal, STAR date, and placement score. There is also a 2018 ACT/SAT concordance table which converts ACT Math scores to the SAT math scale so that these two tests can be compared.

To make reading the dashboard a little easier, each page answers one question:

- **Data Preparation:** the clean up steps, with evidence for what changed
- **Cleaned Data:** the final version of the table
- **Score Distribution:** what a placement score looks like
- **Placement Score:** how the test scores relate to the placement
- **Placement Score by STAR Date:** how scores differ across test dates
- **Rankings:** which high schools and career goals have the highest average scores

Data Preparation
=====================================================================

Row {data-height=850}
---------------------------------------------------------------------

### Step 1: Import and Rename the Data Set

To start, obviously I'm going to import the spreadsheet into R. The preview below shows the raw file as a very long GPA column name, abbreviated headers like `High Sch`, a `Career Goals or Intended Major` column, and five columns headed by exam dates (which R displays as Excel date numbers). Names like these are a little weird to type and read, so I'm going to start by renaming each column by its position to something shorter and easier to refer to. The date columns are named after the exam date they represent.

```{r rename}
star_clean <- STAR_data_for_MS_282 %>%
  rename(GPA = 1,
         ACT_SAT = 2,
         High_School = 3,
         Career_Goal = 4,
         `2019-06-10` = 5,
         `2019-06-17` = 6,
         `2019-06-24` = 7,
         `2019-08-05` = 8,
         `2019-08-15` = 9,
         AQ_Score = 10)
```

```{r raw_preview, echo=FALSE}
datatable(head(STAR_data_for_MS_282, 10),
          rownames = FALSE,
          options = list(pageLength = 5, scrollX = FALSE, dom = "tp"))
```

Row {data-height=500}
---------------------------------------------------------------------

### Step 2: Reshape into Nicer Form

A tidy data set ideally will have one row per observation and one variable per column. However, in this data set, the five date columns are not variables, but instead their names are really just values of a missing "STAR date" variable, and the "yes" entries show which date each student tested. By using `pivot_longer`, I can turn those column names into a single `STAR_Date` column so it takes up much less space. Second, the `ACT_SAT` column combines the two test scores into one entry (for example `26_600` means ACT 26 and SAT 600), so by using the `separate` function, I can split it into `ACT_Math` and `SAT_Math`, with `convert = TRUE` so they become numbers.

```{r reshape}
star_clean <- star_clean %>%
  pivot_longer(cols = c(`2019-06-10`, `2019-06-17`, `2019-06-24`,
                        `2019-08-05`, `2019-08-15`),
               names_to = "STAR_Date",
               values_to = "Attended",
               values_transform = list(Attended = as.character)) %>%
  filter(!is.na(Attended)) %>%    # keep the one date each student tested
  select(-Attended) %>%
  separate(ACT_SAT, into = c("ACT_Math", "SAT_Math"), sep = "_", convert = TRUE)
```

Row {data-height=850}
---------------------------------------------------------------------

### Step 3: Check Data Types

Next, I need to fix some of the data types of certain columns. Due to the fact that R guesses each column's data type when it imports a file, its guess is not always going to be accurate or what we want. The table below lists the type of every variable. Scores and GPA are numbers, which is what we want, and the school and career goal are text, which is also right. However, the one exception is `STAR_Date`, which was created from column names and is therefore plain text. Therefore, I am going to convert it to a true date so that it sorts and plots better.

```{r types}
star_clean <- star_clean %>%
  mutate(STAR_Date = as.Date(STAR_Date))

type_table <- tibble(
  Variable  = names(star_clean),
  Data_Type = map_chr(star_clean, ~ class(.x)[1]))
```

```{r types_table, echo=FALSE}
datatable(type_table,
          rownames = FALSE,
          colnames = c("Variable", "Data Type (after conversion)"),
          options = list(pageLength = 10, dom = "t", scrollX = FALSE))
```

Row {data-height=950}
---------------------------------------------------------------------

### Step 4: Fix Any Numeric Entry Errors

Next I'm going to look for any entry errors in the numeric variables by looking for values that are impossible to obtain. For example, a GPA above 5, an SAT Math score below 200 (the lowest possible score), or an AQ score that is not a whole number. The table below lists every unreasonable value, but unlike a clear mistake (like a 150 that should be a 15) I can't really tell what these entries were meant to be (a GPA of 33.8 could be 3.38 or 3.8), so rather than try to guess I'm going to set them to missing. Weighted GPAs above 4.0 are real, so I'm keeping those.

```{r numeric_errors}
flagged <- star_clean %>%
  mutate(Row_in_Data = row_number(), .before = 1) %>%
  filter(GPA > 5 | SAT_Math < 200 | AQ_Score != round(AQ_Score)) %>%
  mutate(Problem = case_when(GPA > 5 ~ "GPA above 5",
                             SAT_Math < 200 ~ "SAT Math below 200",
                             AQ_Score != round(AQ_Score) ~ "AQ score is not a whole number")) %>%
  select(Row_in_Data, Problem, GPA, ACT_Math, SAT_Math, AQ_Score)

# Replace each impossible value with NA
star_clean$GPA[which(star_clean$GPA > 5)] <- NA
star_clean$SAT_Math[which(star_clean$SAT_Math < 200)] <- NA
star_clean$AQ_Score[which(star_clean$AQ_Score != round(star_clean$AQ_Score))] <- NA
```

```{r flagged_table, echo=FALSE}
datatable(flagged,
          rownames = FALSE,
          colnames = c("Row in Data", "Problem", "GPA", "ACT Math",
                       "SAT Math", "AQ Score"),
          options = list(pageLength = 5, scrollX = FALSE))
```

Row {data-height=2050}
---------------------------------------------------------------------

### Step 5: Fix Any Inconsistent School and Career Names

Next, I'm going to try to search for any entry (categorical) errors in the variables. The same school or major seems to be typed several ways (i.e. "ROCKFORD", "Rockford", "ROCKFORD SENIOR HIGH SCHOOL") and in a ranking each spelling would be counted as a separate group. I can standardize capitalization, strip words like "HIGH SCHOOL", and fix any typos using the `str_replace` function. This will also turn spreadsheet error codes (i.e. `#MULTIVALUE`, `UNKNOWN`) into missing values. If there are any career goals that differ only by capitalization, I'm going to match them up with a lookup table and a join and then keep the most common spelling. The table below lists every name that changed.

```{r names}
original_school <- star_clean$High_School
original_career <- star_clean$Career_Goal

# --- High schools ---
star_clean <- star_clean %>%
  mutate(High_School = str_to_upper(High_School),
         High_School = na_if(High_School, "#MULTIVALUE"),
         High_School = na_if(High_School, "UNKNOWN"),
         High_School = str_replace_all(High_School, "[.,]", ""),
         High_School = str_replace(High_School, "\\bHIGH SCHOOL\\b", ""),
         High_School = str_replace(High_School, "\\bHS\\b", ""),
         High_School = str_replace(High_School, "\\bSAINT\\b", "ST"),
         High_School = str_replace(High_School, "\\bSENIOR\\b", ""),
         High_School = str_replace(High_School, "\\bSCHOOLS\\b", ""),
         High_School = str_replace(High_School, "W MICH AVIATION ACAD",
                                   "WEST MICHIGAN AVIATION ACADEMY"),
         High_School = str_squish(High_School),
         High_School = na_if(High_School, ""))

# --- Career goals: typos and abbreviations ---
star_clean <- star_clean %>%
  mutate(Career_Goal = str_replace(Career_Goal, "Jounalism", "Journalism"),
         Career_Goal = str_replace(Career_Goal, "Publctn", "Publication"),
         Career_Goal = str_replace(Career_Goal, "Comptr", "Computer"),
         Career_Goal = str_replace(Career_Goal, "^Secondary Ed$", "Secondary Education"),
         Career_Goal = str_replace(Career_Goal, "^Early Childhood Develop$",
                                   "Early Childhood Development"),
         Career_Goal = str_replace(Career_Goal, "^Translation/Interpret$",
                                   "Translation/Interpretation"),
         Career_Goal = str_replace(Career_Goal, "^Business Adm(in)?$",
                                   "Business Administration"),
         Career_Goal = str_replace(Career_Goal, "^Bus Adm/Sports Man$",
                                   "Bus Adm/Sports Management"))

# --- Career goals: one capitalization per name ("pre-med" -> "Pre-Med") ---
career_lookup <- star_clean %>%
  filter(!is.na(Career_Goal)) %>%
  mutate(Career_Key = str_to_lower(Career_Goal)) %>%
  group_by(Career_Key, Career_Goal) %>%
  summarize(count = n(), .groups = "drop") %>%
  arrange(Career_Key, desc(count)) %>%
  group_by(Career_Key) %>%
  slice(1) %>%
  ungroup() %>%
  select(Career_Key, Career_Goal_Standard = Career_Goal)

star_clean <- star_clean %>%
  mutate(Career_Key = str_to_lower(Career_Goal)) %>%
  left_join(career_lookup, by = "Career_Key") %>%
  mutate(Career_Goal = Career_Goal_Standard) %>%
  select(-Career_Key, -Career_Goal_Standard)

name_changes <- bind_rows(
  tibble(Type = "High School", Original = original_school,
         Standardized = star_clean$High_School),
  tibble(Type = "Career Goal", Original = original_career,
         Standardized = star_clean$Career_Goal)) %>%
  filter(!is.na(Original), is.na(Standardized) | Original != Standardized) %>%
  distinct() %>%
  arrange(Type, Standardized, Original)
```

```{r names_table, echo=FALSE}
datatable(name_changes,
          rownames = FALSE,
          filter = "top",
          colnames = c("Type", "Original Entry", "Standardized Entry"),
          options = list(pageLength = 8, scrollX = FALSE))
```

Row {data-height=800}
---------------------------------------------------------------------

### Step 6: Handle Duplicates and Missing Values

The next step is to find a way to deal with any missing values. There are three ways to deal with them: either do nothing, filter out the rows, or impute (fill in) values. The AQ placement score is the outcome I'm looking for, so a student without one can't contribute to any chart or ranking, so those few students are filtered out. For GPA, test scores, school, and career goal I'm not going to do anything since those students still have a valid placement score, so filling in made-up values would mean "playing God" with the data. I'm also going to be sure to remove exact duplicate rows with the `distinct` function. The table below tracks how many students remain after each stage.

```{r missing}
n_raw <- nrow(STAR_data_for_MS_282)

star_clean <- star_clean %>%
  distinct()
n_distinct <- nrow(star_clean)

star_clean <- star_clean %>%
  filter(!is.na(AQ_Score)) %>%
  mutate(Student_ID = row_number(), .before = 1)
n_final <- nrow(star_clean)

row_log <- tibble(
  Stage = c("Students in the raw spreadsheet",
            "After removing exact duplicate rows",
            "After removing students with no valid AQ score"),
  Students = c(n_raw, n_distinct, n_final))
```

```{r row_log_table, echo=FALSE}
datatable(row_log,
          rownames = FALSE,
          options = list(dom = "t", scrollX = FALSE))
```

Row {data-height=900}
---------------------------------------------------------------------

### Step 7: Join the ACT-to-SAT Concordance

SAT and ACT math scores are on different scales, so I'm going to use the official 2018 concordance table (Table B2: ACT Math to SAT Math) that I've already imported. These two data sets are linked by the ACT Math score, so I'll rename that column to have the same name in both tables and then use the `left_join` function to add each student's converted SAT score. The table below shows the concordance itself. Plus, any ACT scores under 10 are not on the official table, so those students just won't have a converted score.

```{r concordance}
concordance <- ACT_SAT_Concordance_All_Tables %>%
  filter(Table == "B2") %>%
  select(From_Score, To_Score) %>%
  rename(ACT_Math = From_Score,
         SAT_from_ACT = To_Score)

star_clean <- star_clean %>%
  left_join(concordance, by = "ACT_Math") %>%
  mutate(SAT_ACT_Max = pmax(SAT_Math, SAT_from_ACT, na.rm = TRUE)) %>%
  select(Student_ID, High_School, Career_Goal, STAR_Date,
         GPA, ACT_Math, SAT_Math, SAT_from_ACT, SAT_ACT_Max, AQ_Score)
```

```{r concordance_table, echo=FALSE}
datatable(concordance,
          rownames = FALSE,
          colnames = c("ACT Math", "Converted SAT Math"),
          options = list(pageLength = 6, dom = "tp", scrollX = FALSE))
```

Cleaned Data
=====================================================================

Row {data-height=1100}
---------------------------------------------------------------------

### Cleaned STAR Math Placement Data

This is the finished product of the preparation steps: one row per student, with every variable in its own column.

```{r cleaned_table}
star_clean %>%
  datatable(
    rownames = FALSE,
    filter = "top",
    colnames = c("Student ID", "High School", "Career Goal", "STAR Date",
                 "GPA", "ACT Math", "SAT Math", "SAT Math (Converted from ACT)",
                 "Higher of SAT Math / Converted ACT", "AQ Math Placement Score"),
    options = list(pageLength = 15, scrollX = FALSE)
  )
```

Score Distribution
=====================================================================

Row {data-height=350}
---------------------------------------------------------------------

### Distribution of AQ Math Placement Scores

Since the AQ score is a continuous measurement, a histogram is going to be the graph best suited to display the distribution.

Based on the histogram, we can see that the distribution shows a slight right skew, indicating that it is slightly more common to receive a placement score around the 10-15 mark.

```{r histogram_code, ref.label="histogram", eval=FALSE}
```

Row {data-height=450}
---------------------------------------------------------------------

### Histogram of AQ Math Placement Scores

```{r histogram, echo=FALSE}
ggplot(star_clean, aes(x = AQ_Score)) +
  geom_histogram(binwidth = 1, color = "white") +
  labs(x = "AQ Math Placement Score", y = "Number of Students")
```

Placement Score
=====================================================================

Row {data-height=350}
---------------------------------------------------------------------

### High School GPA vs. AQ Math Placement Score

Now the question becomes, does a strong high school record go with a strong placement score? Each dot represents one student, and the red line is the overall trend. This scatterplot does seem to indicate a moderately positive linear relationship between the placement score and GPA.

```{r gpa_scatter_code, ref.label="gpa_scatter", eval=FALSE}
```

Row {data-height=450}
---------------------------------------------------------------------

### Scatterplot: GPA vs. AQ Math Placement Score

```{r gpa_scatter, echo=FALSE}
star_clean %>%
  filter(!is.na(GPA)) %>%
  ggplot(aes(x = GPA, y = AQ_Score)) +
  geom_point(alpha = 0.5) +
  geom_smooth(method = "lm", formula = y ~ x, color = "firebrick") +
  labs(x = "High School GPA", y = "AQ Math Placement Score")
```

Row {data-height=400}
---------------------------------------------------------------------

### Best SAT/ACT Math Score vs. AQ Math Placement Score

Typically, standardized tests should be a stronger signal of math skill than GPA. To use every student who took either test, each student is plotted at the higher of their SAT Math score or their ACT Math score converted to the SAT scale. This scatterplot also seems to indicate a moderately positive linear relationship between the placement score and SAT/ACT score.

```{r sat_scatter_code, ref.label="sat_scatter", eval=FALSE}
```

Row {data-height=450}
---------------------------------------------------------------------

### Scatterplot: Best SAT/ACT Math vs. AQ Math Placement Score

```{r sat_scatter, echo=FALSE}
star_clean %>%
  filter(!is.na(SAT_ACT_Max)) %>%
  ggplot(aes(x = SAT_ACT_Max, y = AQ_Score)) +
  geom_point(alpha = 0.5) +
  geom_smooth(method = "lm", formula = y ~ x, color = "firebrick") +
  labs(x = "Higher of SAT Math or ACT Math (converted to SAT scale)",
       y = "AQ Math Placement Score")
```

Placement Score by STAR Date
=====================================================================

Row {data-height=400}
---------------------------------------------------------------------

### AQ Math Placement Scores by STAR Date

STAR sessions were held on only five dates, so the date is a category rather than a continuous number, and a scatterplot would just stack dots in five columns. In this scenario, a boxplot is a better fit: for each date, the box spans the middle half of scores, the line inside is the median, and the dots reflect unusually high or low scores.

Based on the boxplot, it appears that 06/24/19 has higher placement scores (a slight left skew that the other dates don't exhibit) than the other dates.

```{r boxplot_code, ref.label="boxplot", eval=FALSE}
```

Row {data-height=450}
---------------------------------------------------------------------

### Boxplot: AQ Math Placement Scores by STAR Date

```{r boxplot, echo=FALSE}
star_clean %>%
  filter(!is.na(STAR_Date)) %>%
  ggplot(aes(x = factor(STAR_Date), y = AQ_Score)) +
  geom_boxplot(alpha = 0.7, outlier.alpha = 0.4) +
  labs(x = "STAR Date", y = "AQ Math Placement Score")
```

Rankings
=====================================================================

Row {data-height=1100}
---------------------------------------------------------------------

### High Schools Ranked by Average AQ Math Placement Score

Here the high schools are ranked from highest to lowest average placement score. An average based on one or two students is not reliable, so only schools with at least three students at STAR are included; the student count is shown so you can judge how much weight each average deserves.

```{r school_ranking}
min_students <- 3

school_ranking <- star_clean %>%
  filter(!is.na(High_School)) %>%
  group_by(High_School) %>%
  summarize(Students = n(),
            Average_AQ_Score = round(mean(AQ_Score), 2),
            .groups = "drop") %>%
  filter(Students >= min_students) %>%
  arrange(desc(Average_AQ_Score)) %>%
  mutate(Rank = min_rank(desc(Average_AQ_Score)), .before = 1)

datatable(
  school_ranking,
  rownames = FALSE,
  colnames = c("Rank", "High School", "Number of Students",
               "Average AQ Math Placement Score"),
  options = list(pageLength = 10, scrollX = FALSE))
```

Row {data-height=1100}
---------------------------------------------------------------------

### Career Goals Ranked by Average AQ Math Placement Score

The same ranking is repeated for the career goal or intended major each student listed. As with schools, goals chosen by fewer than three students are left out so that one unusual score cannot dominate the list.

```{r career_ranking}
career_ranking <- star_clean %>%
  filter(!is.na(Career_Goal)) %>%
  group_by(Career_Goal) %>%
  summarize(Students = n(),
            Average_AQ_Score = round(mean(AQ_Score), 2),
            .groups = "drop") %>%
  filter(Students >= min_students) %>%
  arrange(desc(Average_AQ_Score)) %>%
  mutate(Rank = min_rank(desc(Average_AQ_Score)), .before = 1)

datatable(
  career_ranking,
  rownames = FALSE,
  colnames = c("Rank", "Career Goal / Intended Major", "Number of Students",
               "Average AQ Math Placement Score"),
  options = list(pageLength = 10, scrollX = FALSE))
```


### Career Goals Ranked by Average AQ Math Placement Score

The same ranking is repeated for the career goal or intended major each student listed. As with schools, goals chosen by fewer than three students are left out so that one unusual score cannot dominate the list.

```{r}
career_ranking <- star_clean %>%
  filter(!is.na(Career_Goal)) %>%
  group_by(Career_Goal) %>%
  summarize(Students = n(),
            Average_AQ_Score = round(mean(AQ_Score), 2),
            .groups = "drop") %>%
  filter(Students >= min_students) %>%
  arrange(desc(Average_AQ_Score)) %>%
  mutate(Rank = min_rank(desc(Average_AQ_Score)), .before = 1)

datatable(
  career_ranking,
  rownames = FALSE,
  colnames = c("Rank", "Career Goal / Intended Major", "Number of Students",
               "Average AQ Math Placement Score"),
  options = list(pageLength = 10, scrollX = TRUE))
```