2021_02_24 Time Paper Revisions
This document is to create the figures and tables needed for the resubmission of the Extended Time Paper.
Libraries
library(readxl)
library(dplyr)
library(boot)
library(ggplot2)
library(colorspace)
library(knitr)Import, Clean, and Combine Data Files
This includes demographic and exam data for Winter terms 2013-2016 and 2018. (not displayed… importing all these data files, selecting relevant variables, combining demographic and exam data)
Combine all of the cleaned exam data and demographic data from Winter 2013-2016 and 2018 into one table - \(allData\). Note, students that took the course multiple times might show up in data multiple times. But, they have a distinct row for each time they took the class.
allData <- full_join(clean_combined_Dem_Data, combined_RepQuest_Scores,
by = "umid") %>% select(c(1,9,2,10,3,5,6,7,4,8,11:48))Better Than Expected Scores on Repeated Questions for All Students
BTE Score
To do all of our BTE comparisons, we need a BTE score on repeated questions for every student. Better Than Expected (BTE) is the student’s grade on the topic of interest minus their cumulative grade in all of their other classes (GPAO). (\(BTE = grade - GPAO\)). We need to calculate their Repeated Questions Grade.
First, we need to find out how many of the 38 total repeated questions each student had the opportunity to answer. This is because for the old terms, only a subset of the repeated questions were included in the exams. Second, we need to calculate their score on the repeated questions they did have the opportunity to answer.
Students got either a 1 (correct) or 0 (incorrect) for every repeated question they were exposed to. If we add up their score on all the repeated questions, we get their repeated questions total correct (\(SumQScore\))
Error on BTE Score
We will also need to calculate the error on the Repeated Question BTE Score for every student. This is because BTE is a calculation based on the student’s performance on the repeated questions and their GPAO. If they were to take these exams again, how likely would it be for them to get the same scores? We answer this through bootstrap resampling, a statistical technique that makes no assumptions about the distribution.
Bootstrap Resampling
To get set up for the bootstrap resampling standard error calculation, we need to set up a list of vectors where every vector is of length 38 and holds the student’s scores on the repeated questions. \(RepQuestScores\) will be the list that holds all these vectors. These are the vectors we will use to calculate the standard error for the BTE scores.
Note that we could have used these vectors to also calculate BTE. I chose to do this in smaller steps using \(NAcount\) and \(SumQScore\) so I could check calculations more easily along the way and make sure my code was working as expected. This also becomes useful later in that we are separating the constant (\(NAcount\)) and the variable (\(SumQScore\)) instead of lumping them into one calculation (\(grade\)).
allData <- mutate(allData, NAcount = 0, SumQScore = 0)
# Create empty list where each element will be the vector for one student
RepQuestScores <- vector(mode = "list", length = nrow(allData))
for (i in 1:nrow(allData)) {
for(j in 11:48) {
# allData[i,j] means allData[row number, column number]
if (is.na(allData[i,j]) == TRUE) {
allData$NAcount[i] = allData$NAcount[i] + 1
}
if (is.na(allData[i,j]) == FALSE) {
allData$SumQScore[i] = allData$SumQScore[i] + allData[[i,j]]
}
RepQuestScores[[i]] = append(RepQuestScores[[i]],
allData[[i,j]])
}
}To calcuate BTE, the repeated questions grade and the GPAO need to be on the same scale. GPAO is on a 4.0 scale. To calculate repeated questions grade on a 4.0 scale, need to divide total correct by total exposed to and multiply by 4.
BTE and Error Calculation (Bootstrap)
For every student, there are a fixed number of repeated questions they were exposed to. With that constraint, we need to resample for the questions they were exposed to in order to estimate what their repeated question grade would be if they took these exams again.
Note that by error propagation rules, we can calculate the error on the repeated question grade and that will be the same as for the BTE, because we are assuming no error on the students’ GPAO.
My understanding of error propagation:
For a calculation \(A = B - C\)
\(A_{error} = \sqrt{B_{error}^2 + C_{error}^2}\)
In our case of \(BTE = grade - gpao\)
there is no error on the \(gpao\). So \(BTE_{error} = grade_{error}\)
For a calculation \(X = aK\), where \(a\) is constant, \(X_{error} = aK_{error}\)
In our case \(grade = aSumQScore\) where \(a = \frac{4}{38-NAcount}\)
\(NAcount\) is constant for each student, because they were only exposed to a specific set of the repeated questions.
So, \(BTE_{error} = SumQScore_{error}\frac{4}{38-NAcount}\)
Additional notes on error propagation (to justify to myself this is the right process:
For a calculation \(X = \frac{FG}{K}\)
\(X_{error} = X\sqrt{(\frac{F_{error}}{F})^2 + (\frac{G_{error}}{G})^2 + (\frac{K{error}}{K})^2}\)
In our case of \(grade = \frac{SumQScore(4)}{38-(NAcount)}\)
there is no error on \(4\), \(38\), or \(NAcount\). So \(grade_{error} = grade\sqrt{(\frac{SumQScore_{error}}{SumQScore})^2}\) or, \(grade_{error} = grade\frac{SumQScore_{error}}{SumQScore}\)
Thus, \(BTE_{error} = \frac{SumQScore(4)}{38-(NAcount)} * \frac{SumQScore_{error}}{SumQScore}\) which simplifies to \(BTE_{error} = SumQScore_{error}\frac{4}{38-NAcount}\), the same as above.
To calculate BTE error in code We need to set up a function that will be used for the bootstrap resampling. We are setting up this function now so we can calculate BTE and BTE standard error during the same for loop. This saves on the time it takes for the code to run if we limit the for loops. Our bootstrap resampling will be on the \(RepQuestScores\) for each student. The function we are doing over and over again is summing the scores to calculate \(SumQScore\) and the standard error on this value.
sample_sum <- function(data, indices) {
sample = data[indices]
bar = sum(sample)
return(bar)
}allData$RepQuest_BTE <- NA
allData$RepQuest_PercentScore <- NA
allData$RepQuest_SumQScore_std_error <- NA
for (k in 1:nrow(allData)) {
allData$RepQuest_BTE[[k]] = ((allData$SumQScore[[k]]*4)/
(38-allData$NAcount[[k]])) - allData$gpao[[k]]
allData$RepQuest_PercentScore[[k]] = (allData$SumQScore[[k]]/
(38-allData$NAcount[[k]])) * 100
allData$RepQuest_SumQScore_std_error[[k]] = sd(boot(RepQuestScores[[k]][!is.na(RepQuestScores[[k]])],
sample_sum,R=1000)$t)
}Note, we also cacluate \(PercentScore\) above. This is because if later we decide to plot using overall score instead of BTE score, we will have the calculations done.
\(PercentScore = SumQScore\frac{100}{38-NAcount}\)
\(PercentScore_{error} = SumQScore{error}\frac{100}{38-NAcount}\)
allData$RepQuest_BTE_error <- allData$RepQuest_SumQScore_std_error *
(4/(38-allData$NAcount))
allData$RepQuest_PercentScore_error <- allData$RepQuest_SumQScore_std_error*
(100/(38-allData$NAcount))Note that for students who got all right or all wrong for the repeated questions they were exposed to, the BTE standard error and percent score standard error are zero. This is because with bootstrap resampling, the only options to sample from are either all right or all wrong. So, there is no standard error because the resampled versions would also be either all right or all wrong.
Is this a problem?
Now we are ready to plot average BTEs for specific student groups and the error on these averages. We will also calculate the p-value for the differences between average BTEs to show significance for skeptical reviewers (that don’t understand the error bars…)!
Data to Use for Research Questions 1 and 2
graphData <- allData %>% select(c(4:10,49,50,53,51,54,52,55))Research Questions & Plots
RESEARCH QUESTION 1
Do historical performance differences favoring historically privileged students over historically marginalized students decrease when the course is restructured to alleviate time pressure on exams by extending the time limits?
Notes:
In setting up this question, we specify the gaps we are interested in:
1. Gendered performance gap, comparing performance of females and males
2. Racial performance gap, comparing underrepresented minorities to non-underrepresented minorities 3. College-generation gap, comparing first-generation college students to continuing generation college students
To answer this question, we need to identify the gap for each comparison in the original (normal time) terms for the Repeated Questions and compare it to the gap in the Winter 2018 (extended time) term. We need to determine if the change in the gaps are significant and justify this with a p-value.
Preparing Data for Comparisons
gender_BTE <- graphData %>% group_by(term_group, gender) %>%
summarise(BTE_avg = mean(RepQuest_BTE), number_people = n(),
BTE_avg_error = sqrt(sum(RepQuest_BTE_error^2))/number_people,
.groups = "keep")
for (a in 1:nrow(gender_BTE)) {
if (is.na(gender_BTE$gender[a]) == TRUE) {
gender_BTE$gender[a] = "Gender Unknown"
}
if (gender_BTE$gender[a] != "Female" && gender_BTE$gender[a] != "Male") {
gender_BTE$gender[a] = "Gender Unknown"
}
}
gender_BTE <- rename(gender_BTE, demographic = gender)urm_BTE <- graphData %>% group_by(term_group, urm) %>%
summarise(BTE_avg = mean(RepQuest_BTE), number_people = n(),
BTE_avg_error = sqrt(sum(RepQuest_BTE_error^2))/number_people,
.groups = "keep")
for (b in 1:nrow(urm_BTE)) {
if (is.na(urm_BTE$urm[b])) {
urm_BTE$urm[b] = "Race/Ethnicity Unknown"
}
if (urm_BTE$urm[b] != "a URM" && urm_BTE$urm[b] != "b non-URM") {
urm_BTE$urm[b] = "Race/Ethnicity Unknown"
}
if (urm_BTE$urm[b] == "a URM") {
urm_BTE$urm[b] = "Underrepresented Minority"
}
if (urm_BTE$urm[b] == "b non-URM") {
urm_BTE$urm[b] = "Racial Majority"
}
}
urm_BTE <- rename(urm_BTE, demographic = urm)firstgen_BTE <- graphData %>% group_by(term_group, firstgen) %>%
summarise(BTE_avg = mean(RepQuest_BTE), number_people = n(),
BTE_avg_error = sqrt(sum(RepQuest_BTE_error^2))/number_people,
.groups = "keep")
for (c in 1:nrow(firstgen_BTE)) {
if (is.na(firstgen_BTE$firstgen[c])) {
firstgen_BTE$firstgen[c] = "College Generation Unknown"
}
if (firstgen_BTE$firstgen[c] != "FG" && firstgen_BTE$firstgen[c] != "non-FG") {
firstgen_BTE$firstgen[c] = "College Generation Unknown"
}
if (firstgen_BTE$firstgen[c] == "FG") {
firstgen_BTE$firstgen[c] = "First Generation"
}
if (firstgen_BTE$firstgen[c] == "non-FG") {
firstgen_BTE$firstgen[c] = "Continuing Generation"
}
}
firstgen_BTE <- rename(firstgen_BTE, demographic = firstgen)RQ1_data <- bind_rows(gender_BTE, urm_BTE, firstgen_BTE, .id = "source")
RQ1_data$demographic <- factor(RQ1_data$demographic,
levels = c("Female", "Male", "Gender Unknown",
"Underrepresented Minority", "Racial Majority",
"Race/Ethnicity Unknown", "First Generation",
"Continuing Generation", "College Generation Unknown"))
RQ1_dataResearch Question 1 Plot 1
RQ1_plot_BTE <- ggplot(subset(RQ1_data, !is.na(BTE_avg)),
aes(x = term_group, y = BTE_avg,
ymin = BTE_avg - BTE_avg_error, ymax = BTE_avg + BTE_avg_error,
fill = demographic)) + scale_fill_brewer(palette = "Set2") +
geom_col(position = position_dodge(.9)) +
geom_errorbar(position = position_dodge(.9), width = .2, color = "gray30") +
facet_wrap(~source,
labeller = as_labeller(c(`1` = "Gender", `2` = "Race/Ethnicity", `3` = "College Generation"))) +
ggtitle("Better Than Expected Scores with Extended Time") +
theme(legend.position = "bottom", legend.title = element_blank()) +
xlab("Term") + ylab("Average BTE Score") +
scale_x_discrete(breaks=c("old", "WN18"),
labels=c("Old Terms", "Winter 2018"))
print(RQ1_plot_BTE)
Research Question 1 Plot 1.5 (Used in Time Paper 3/5 Draft, Figure 1)
# Removed "Race/Ethnicity unknown" and "College generation unknown" from plot
RQ1_plot_BTE_known <- ggplot((subset(RQ1_data, !is.na(BTE_avg)) %>%
filter(demographic == "Female" ||
demographic == "Male" ||
demographic == "Underrepresented Minority" ||
demographic == "Racial Majority" ||
demographic == "First Generation" ||
demographic == "Continuing Generation")),
aes(x = term_group, y = BTE_avg,
ymin = BTE_avg - BTE_avg_error, ymax = BTE_avg + BTE_avg_error,
fill = demographic)) +
scale_fill_manual(values = c("#66ccee","#4477AA","#228833","#ccbb44","#EE6677","#AA3377")) +
geom_col(position = position_dodge(.9)) +
geom_errorbar(position = position_dodge(.9), width = .2, color = "gray20") +
geom_point(aes(term_group, y = BTE_avg, shape = demographic), color = "gray20",
position = position_dodge(.9)) +
facet_wrap(~source,
labeller = as_labeller(c(`1` = "Sex", `2` = "Race/Ethnicity", `3` = "College Generation"))) +
theme_bw() +
theme(legend.position = "bottom", legend.title = element_blank()) +
xlab("Term") + ylab("Average BTE Score") +
scale_x_discrete(breaks=c("old", "WN18"),
labels=c("Old Terms", "Winter 2018"))
print(RQ1_plot_BTE_known)
Are the changes in performance differences significant?
PerformanceDifferences <- data.frame(matrix(ncol = 0, nrow = 3))
PerformanceDifferences$Comparison <- c("Gender", "Race/Ethnicity", "College Generation")
PerformanceDifferences$Comparison <- factor(PerformanceDifferences$Comparison,
levels = c("Gender", "Race/Ethnicity", "College Generation"))
# Old Differences
PerformanceDifferences$Old_Diff <- c((filter(RQ1_data, demographic == "Female",
term_group == "old")$BTE_avg -
filter(RQ1_data, demographic == "Male",
term_group == "old")$BTE_avg),
(filter(RQ1_data, demographic == "Underrepresented Minority",
term_group == "old")$BTE_avg -
filter(RQ1_data, demographic == "Racial Majority",
term_group == "old")$BTE_avg),
(filter(RQ1_data, demographic == "First Generation",
term_group == "old")$BTE_avg -
filter(RQ1_data, demographic == "Continuing Generation",
term_group == "old")$BTE_avg))
PerformanceDifferences$Old_Diff_error <- c(sqrt(filter(RQ1_data, demographic == "Female",
term_group == "old")$BTE_avg_error^2 +
filter(RQ1_data, demographic == "Male",
term_group == "old")$BTE_avg_error^2),
sqrt(filter(RQ1_data, demographic == "Underrepresented Minority",
term_group == "old")$BTE_avg_error^2 +
filter(RQ1_data, demographic == "Racial Majority",
term_group == "old")$BTE_avg_error^2),
sqrt(filter(RQ1_data, demographic == "First Generation",
term_group == "old")$BTE_avg_error^2 +
filter(RQ1_data, demographic == "Continuing Generation",
term_group == "old")$BTE_avg_error^2))# Winter 2018 Differences
PerformanceDifferences$WN18_Diff <- c((filter(RQ1_data, demographic == "Female",
term_group == "WN18")$BTE_avg -
filter(RQ1_data, demographic == "Male",
term_group == "WN18")$BTE_avg),
(filter(RQ1_data, demographic == "Underrepresented Minority",
term_group == "WN18")$BTE_avg -
filter(RQ1_data, demographic == "Racial Majority",
term_group == "WN18")$BTE_avg),
(filter(RQ1_data, demographic == "First Generation",
term_group == "WN18")$BTE_avg -
filter(RQ1_data, demographic == "Continuing Generation",
term_group == "WN18")$BTE_avg))
PerformanceDifferences$WN18_Diff_error <- c(sqrt(filter(RQ1_data, demographic == "Female",
term_group == "WN18")$BTE_avg_error^2 +
filter(RQ1_data, demographic == "Male",
term_group == "WN18")$BTE_avg_error^2),
sqrt(filter(RQ1_data, demographic == "Underrepresented Minority",
term_group == "WN18")$BTE_avg_error^2 +
filter(RQ1_data, demographic == "Racial Majority",
term_group == "WN18")$BTE_avg_error^2),
sqrt(filter(RQ1_data, demographic == "First Generation",
term_group == "WN18")$BTE_avg_error^2 +
filter(RQ1_data, demographic == "Continuing Generation",
term_group == "WN18")$BTE_avg_error^2))Adjust PerformanceDifferences table to make it easier to graph next plot.
OldPerfDiff <- PerformanceDifferences[c(1:3)] %>% mutate(Term = "Old Terms") %>%
rename(Difference = Old_Diff, Error = Old_Diff_error)
WN18PerfDiff <- PerformanceDifferences[c(1,4,5)] %>% mutate(Term = "Winter 2018") %>%
rename(Difference = WN18_Diff, Error = WN18_Diff_error)
PerfDiff_Comparison <- bind_rows(OldPerfDiff, WN18PerfDiff, .id = "source")Research Question 1 Plot 2 (Used in Time Paper 3/5 Draft, Figure 2)
RQ1_plot_BTE_Diff <- ggplot(PerfDiff_Comparison, aes(x = Comparison, y = Difference)) +
geom_point(aes(color = Term, shape = Term), size = 3, position = position_dodge(.1)) +
geom_errorbar(aes(ymin = Difference - Error, ymax = Difference + Error,
color = Term), width = .1, position = position_dodge(.1)) +
xlab("Demographic Category") + ylab("BTE Difference") +
theme_bw() +
theme(legend.position = "bottom", legend.title = element_blank()) +
scale_color_manual(values = c("#BB5566", "#004488")) +
scale_x_discrete(breaks=c("Gender", "Race/Ethnicity", "College Generation"),
labels=c("Sex", "Race/Ethnicity", "College Generation"))
print(RQ1_plot_BTE_Diff)
P-Value Confusion
I would like to show through p-values the same conclusion that can be drawn from the error bars above. The BTE Difference from the old terms to Winter 2018 is only significant for the Race/Ethnicity comparison.
To find the p-value, I need to compare two distributions. For gender, I am looking at the difference in female and male BTE performance in the old terms compared to the difference in female and male BTE performance in Winter 2018.
Null hypothesis - The performance difference between females and males in the old terms is not different from the performance difference between females and males in Winter 2018.
How do I test this? I do not have a distribution of performance differences for old terms and for WN 2018. I only have the one calculated performance difference for old and the one for new. Should I use resampling to create a set of performance differences?
Questions to Consider for Research Question 1:
- How was gender information collected? Currently reported as “Female,” and “Male.” Should this variable be called sex instead of gender?
- How about using PEER instead of URM? PEER - persons excluded because of ethnicity or race. It focuses on exclusion, rather than underrepresentation. And, it highlights we are looking at race and ethnicity.
- In general, is it useful to look at PEER vs. non-PEER? Would it be better to disaggregate? Look at the different races and ethnicities we are lumping in to the one category?
- How to calculate p-values?
RESEARCH QUESTION 2
Does overall student performance increase when the course reduces the time pressure by providing longer time limits for exams?
Preparing Data for Comparison
RQ2_data_BTE <- graphData %>% subset(!is.na(RepQuest_BTE)) %>%
group_by(term_group) %>%
summarise(Overall_BTE_avg = mean(RepQuest_BTE), number_people_BTE = n(),
Overall_BTE_avg_error = sqrt(sum(RepQuest_BTE_error^2))/number_people_BTE,
.groups = "keep")
RQ2_data_percent <- graphData %>% group_by(term_group) %>%
summarise(Overall_percent_avg = mean(RepQuest_PercentScore),
number_people_percent = n(),
Overall_percent_avg_error =
sqrt(sum(RepQuest_PercentScore_error^2))/number_people_percent, .groups = "keep")
RQ2_data <- full_join(RQ2_data_BTE, RQ2_data_percent, by = "term_group")
RQ2_dataResearch Question 2 Plot 1 (Used in Time Paper 3/5 Draft, Figure 3)
RQ2_plot_BTE <- ggplot(RQ2_data, aes(term_group, Overall_BTE_avg)) +
geom_point(size = 3) +
geom_errorbar(aes(ymin = Overall_BTE_avg - Overall_BTE_avg_error,
ymax = Overall_BTE_avg + Overall_BTE_avg_error), width = .1) +
xlab("Term") + ylab("Average BTE Score") +
scale_x_discrete(breaks=c("old", "WN18"),
labels=c("Old Terms", "Winter 2018")) +
theme_bw()
print(RQ2_plot_BTE)
Research Question 2 Plot 2
RQ2_plot_percent <- ggplot(RQ2_data, aes(term_group, Overall_percent_avg)) +
geom_point() +
geom_errorbar(aes(ymin = Overall_percent_avg - Overall_percent_avg_error,
ymax = Overall_percent_avg + Overall_percent_avg_error), width = .2) +
ggtitle("Performance with Extended Time",
subtitle = "Overall performance is higher with extended time") +
xlab("Term") + ylab("Average Performance (%)") +
scale_x_discrete(breaks=c("old", "WN18"),
labels=c("Old Terms", "Winter 2018"))
print(RQ2_plot_percent)
Questions to Consider for Research Question 2:
- In initial paper, we focused on overall performance of students in old terms vs. Winter 2018. But, based on our argument that Better-Than-Expected measures are a better way to compare performance, should we compare BTE scores on repeated questions for the old and Winter 2018 terms instead? Both graphs are shown above.
- Would this information be better presented through a table? Should we show the difference between two random halves of Winter 2018 for comparison?
RESEARCH QUESTION 3
Do students use their extended time differently?
Notes: In initial paper we grouped students into three cohorts - early, middle, and late - for each exam based on when they turned in the exams. We looked to see the distribution of student groups in the different cohorts. We found first generation college students fell in the early cohort more than other student groups, especially in the earlier exams. We also looked at GPAO and ACT Math scores and how they correlated.
Preparing Data for Comparisons
RQ3_data <- WN18_Term_Dem_Data %>% select(c(6,9:11,24,25,44,45,7,8,26,12:23,27:31)) %>% filter(BTE != "NA")
for (d in 1:nrow(RQ3_data)) {
if (RQ3_data$satM[d] == "NA") RQ3_data$satM[d] = NA
if (RQ3_data$actM[d] == "NA") RQ3_data$actM[d] = NA
if (RQ3_data$BTE[d] == "NA") RQ3_data$BTE[d] = NA
if (RQ3_data$grade[d] == "NA") RQ3_data$grade[d] = NA
}
RQ3_data$satM <- as.numeric(RQ3_data$satM)
RQ3_data$actM <- as.numeric(RQ3_data$actM)
RQ3_data$BTE <- as.numeric(RQ3_data$BTE)
RQ3_data$grade <- as.numeric(RQ3_data$grade)Note in general that the \(number\_people\_cluster\) below may not be the exact number that the means are calculated on for SATM and ACTM because we are removing NA values when calculating the mean. So the \(number\_people\_cluster\) just tells you how many people were in that cohort. Not, what the average (\(SATM\) or \(ACTM\)) was for that whole group.
RQ3_data_c1 <- RQ3_data %>% group_by(c1) %>% summarise(Exam_BTE_avg = mean(bte1),
number_people_cluster = n(),
Time_avg = mean(t1),
Exam_Grade_avg = mean(e1),
BTE_avg = mean(BTE),
GPAO_avg = mean(gpao),
GPAO_error = sd(gpao)/sqrt(number_people_cluster),
Class_Grade_avg = mean(grade),
SAT_Math_avg = mean(satM[!is.na(satM)]),
ACT_Math_avg = mean(actM[!is.na(actM)])) %>%
mutate(Exam = c("Exam 1")) %>% rename(time_cluster = c1)
RQ3_data_c1 <- RQ3_data_c1[c(12,1,3,4,10,11,9,7,8,6,5,2)]RQ3_data_c2 <- RQ3_data %>% group_by(c2) %>% summarise(Exam_BTE_avg = mean(bte2),
number_people_cluster = n(),
Time_avg = mean(t2),
Exam_Grade_avg = mean(e2),
BTE_avg = mean(BTE),
GPAO_avg = mean(gpao),
GPAO_error = sd(gpao)/sqrt(number_people_cluster),
Class_Grade_avg = mean(grade),
SAT_Math_avg = mean(satM[!is.na(satM)]),
ACT_Math_avg = mean(actM[!is.na(actM)])) %>%
mutate(Exam = c("Exam 2")) %>% rename(time_cluster = c2)
RQ3_data_c2 <- RQ3_data_c2[c(12,1,3,4,10,11,9,7,8,6,5,2)]RQ3_data_c3 <- RQ3_data %>% group_by(c3) %>% summarise(Exam_BTE_avg = mean(bte3),
number_people_cluster = n(),
Time_avg = mean(t3),
Exam_Grade_avg = mean(e3),
BTE_avg = mean(BTE),
GPAO_avg = mean(gpao),
GPAO_error = sd(gpao)/sqrt(number_people_cluster),
Class_Grade_avg = mean(grade),
SAT_Math_avg = mean(satM[!is.na(satM)]),
ACT_Math_avg = mean(actM[!is.na(actM)])) %>%
mutate(Exam = c("Exam 3")) %>% rename(time_cluster = c3)
RQ3_data_c3 <- RQ3_data_c3[c(12,1,3,4,10,11,9,7,8,6,5,2)]RQ3_data_c4 <- RQ3_data %>% group_by(c4) %>% summarise(Exam_BTE_avg = mean(bte4),
number_people_cluster = n(),
Time_avg = mean(t4),
Exam_Grade_avg = mean(e4),
BTE_avg = mean(BTE),
GPAO_avg = mean(gpao),
GPAO_error = sd(gpao)/sqrt(number_people_cluster),
Class_Grade_avg = mean(grade),
SAT_Math_avg = mean(satM[!is.na(satM)]),
ACT_Math_avg = mean(actM[!is.na(actM)])) %>%
mutate(Exam = c("Exam 4")) %>% rename(time_cluster = c4)
RQ3_data_c4 <- RQ3_data_c4[c(12,1,3,4,10,11,9,7,8,6,5,2)]Note that all of the averages calculated in the RQ3 data clusters tables also have errors associated with them. I didn’t calculate all of these yet because I wanted to see what direction we were planning to go with the plots before spending the time on calculating errors. I included the number of people in the clusters to give a sense of size of errors.
RQ3_data_clusters <- bind_rows(RQ3_data_c1, RQ3_data_c2, RQ3_data_c3, RQ3_data_c4, .id = "source")
RQ3_data_clusters <- mutate(RQ3_data_clusters, standard_time = 0)
for (o in (1:nrow(RQ3_data_clusters))) {
if(RQ3_data_clusters[[o,1]] == "1" || RQ3_data_clusters[[o,1]] == "2" ||
RQ3_data_clusters[[o,1]] == "3") {
RQ3_data_clusters$standard_time[o] = 90
}
if(RQ3_data_clusters[[o,1]] == "4") {
RQ3_data_clusters$standard_time[o] = 120
}
}
RQ3_data_clustersResearch Question 3 Plot 1
RQ3_plot_time_avg <- ggplot(RQ3_data_clusters,
aes(time_cluster, Time_avg, fill = Exam)) +
geom_col(position = "dodge") + scale_fill_brewer(palette = "RdYlBu") +
ggtitle("Time Spent for Each Cluster") +
theme(legend.position = "bottom", legend.title = element_blank()) +
xlab("Time Cluster") + ylab("Time (mins)") +
scale_x_continuous(breaks=c(1, 2, 3),
labels=c("Early", "Middle", "Late"))
print(RQ3_plot_time_avg)
Research Question 3 Plot 2
RQ3_plot_totals <- ggplot(RQ3_data_clusters,
aes(time_cluster, number_people_cluster, fill = Exam)) +
geom_col(position = "dodge") + scale_fill_brewer(palette = "RdYlBu") +
ggtitle("Total Students in Each Cluster",
subtitle = "Students stayed the longest for Exams 2 and 3") +
theme(legend.position = "bottom", legend.title = element_blank()) +
xlab("Time Cluster") + ylab("Total Students") +
scale_x_continuous(breaks=c(1, 2, 3),
labels=c("Early", "Middle", "Late"))
print(RQ3_plot_totals)
Research Question 3 Plot 3
RQ3_plot_totals_time <- ggplot(RQ3_data_clusters,
aes(time_cluster, Time_avg/standard_time*100,
fill = Exam, alpha = number_people_cluster)) +
geom_col(position = "dodge") + scale_fill_brewer(palette = "RdYlBu") +
geom_text(aes(label = number_people_cluster), position = position_dodge(width = .9)) +
ggtitle("Percent of Standard Time Spent for Each Cluster, Shaded by Number of People",
subtitle = "Students stayed the longest for Exams 2 and 3") +
theme(legend.position = "bottom", legend.title = element_blank()) +
xlab("Time Cluster") + ylab("Percent of Standard Time Used (%)") +
scale_x_continuous(breaks=c(1, 2, 3),
labels=c("Early", "Middle", "Late")) + guides(alpha = FALSE)
print(RQ3_plot_totals_time)
Research Question 3 Plot 4
RQ3_plot_ACTM <- ggplot(RQ3_data_clusters,
aes(time_cluster, ACT_Math_avg, color = Exam)) +
geom_point(position = position_dodge(.2), size = 3) + scale_color_brewer(palette = "RdYlBu") +
ggtitle("ACT Math Scores by Cluster") +
theme(legend.position = "bottom", legend.title = element_blank()) +
xlab("Time Cluster") + ylab("Average ACT Math") +
scale_x_continuous(breaks=c(1, 2, 3),
labels=c("Early", "Middle", "Late"))
print(RQ3_plot_ACTM)
Research Question 3 Plot 5
RQ3_plot_GPAO <- ggplot(RQ3_data_clusters,
aes(time_cluster, GPAO_avg, color = Exam)) +
geom_point(position = position_dodge(.2), size = 3) + scale_color_brewer(palette = "RdYlBu") +
ggtitle("GPAO by Cluster") +
theme(legend.position = "bottom", legend.title = element_blank()) +
xlab("Time Cluster") + ylab("Average GPAO") +
scale_x_continuous(breaks=c(1, 2, 3),
labels=c("Early", "Middle", "Late"))
print(RQ3_plot_GPAO)
Research Question 3 Plot 5.5 (Used in Time Paper 3/5 Draft, Figure 4)
RQ3_plot_GPAO_error <- ggplot(RQ3_data_clusters,
aes(time_cluster, GPAO_avg, color = Exam, shape = Exam)) +
geom_point(position = position_dodge(.2), size = 3) +
scale_color_manual(values = c("#4477AA","#228833","#AA3377","#000000")) +
geom_errorbar(aes(time_cluster, ymin = GPAO_avg - GPAO_error, ymax = GPAO_avg + GPAO_error),
position = position_dodge(.2), width = .2) +
theme_bw() +
theme(legend.position = "bottom", legend.title = element_blank()) +
xlab("Time Cluster") + ylab("Average GPAO") +
scale_x_continuous(breaks=c(1, 2, 3),
labels=c("Early", "Middle", "Late"))
print(RQ3_plot_GPAO_error)
Research Question 3 Plot 6
RQ3_plot_Exam_BTE <- ggplot(RQ3_data_clusters,
aes(time_cluster, Exam_BTE_avg, fill = Exam)) +
geom_col(position = "dodge") + scale_fill_brewer(palette = "RdYlBu") +
ggtitle("Exam BTE by Cluster") +
theme(legend.position = "bottom", legend.title = element_blank()) +
xlab("Time Cluster") + ylab("Average Exam BTE") +
scale_x_continuous(breaks=c(1, 2, 3),
labels=c("Early", "Middle", "Late"))
print(RQ3_plot_Exam_BTE)
Preparing Data for Demographic Break Down by Cluster
RQ3_data_gender <- RQ3_data %>% group_by(gender,cmean) %>%
summarise(number_people_cluster = n(), BTE_avg = mean(BTE[!is.na(BTE)]), .groups = "keep") %>%
rename(demographic = gender)RQ3_data_urm <- RQ3_data %>% group_by(urm,cmean) %>%
summarise(number_people_cluster = n(), BTE_avg = mean(BTE[!is.na(BTE)]), .groups = "keep") %>%
rename(demographic = urm)
for (e in 1:nrow(RQ3_data_urm)) {
if (RQ3_data_urm$demographic[e] != "a URM" && RQ3_data_urm$demographic[e] != "b non-URM") {
RQ3_data_urm$demographic[e] = "Race/Ethnicity Unknown"
}
if (RQ3_data_urm$demographic[e] == "a URM") {
RQ3_data_urm$demographic[e] = "Underrepresented Minority"
}
if (RQ3_data_urm$demographic[e] == "b non-URM") {
RQ3_data_urm$demographic[e] = "Racial Majority"
}
}RQ3_data_firstgen <- RQ3_data %>% group_by(firstgen,cmean) %>%
summarise(number_people_cluster = n(), BTE_avg = mean(BTE[!is.na(BTE)]), .groups = "keep") %>%
rename(demographic = firstgen)
for (f in 1:nrow(RQ3_data_firstgen)) {
if (RQ3_data_firstgen$demographic[f] != "FG" && RQ3_data_firstgen$demographic[f] != "non-FG") {
RQ3_data_firstgen$demographic[f] = "College Generation Unknown"
}
if (RQ3_data_firstgen$demographic[f] == "FG") {
RQ3_data_firstgen$demographic[f] = "First Generation"
}
if (RQ3_data_firstgen$demographic[f] == "non-FG") {
RQ3_data_firstgen$demographic[f] = "Continuing Generation"
}
}RQ3_data_demographics <- bind_rows(RQ3_data_gender, RQ3_data_urm, RQ3_data_firstgen, .id = "source") %>%
mutate(total_demographic = NA)
for (g in 1:nrow(RQ3_data_demographics)) {
if(RQ3_data_demographics$demographic[g] == "Female") {
RQ3_data_demographics$total_demographic[g] = nrow(RQ3_data %>% filter(gender == "Female"))
}
if(RQ3_data_demographics$demographic[g] == "Male") {
RQ3_data_demographics$total_demographic[g] = nrow(RQ3_data %>% filter(gender == "Male"))
}
if(RQ3_data_demographics$demographic[g] == "Underrepresented Minority") {
RQ3_data_demographics$total_demographic[g] = nrow(RQ3_data %>% filter(urm == "a URM"))
}
if(RQ3_data_demographics$demographic[g] == "Racial Majority") {
RQ3_data_demographics$total_demographic[g] = nrow(RQ3_data %>% filter(urm == "b non-URM"))
}
if(RQ3_data_demographics$demographic[g] == "Race/Ethnicity Unknown") {
RQ3_data_demographics$total_demographic[g] = nrow(RQ3_data %>% filter(urm == "NA"))
}
if(RQ3_data_demographics$demographic[g] == "First Generation") {
RQ3_data_demographics$total_demographic[g] = nrow(RQ3_data %>% filter(firstgen == "FG"))
}
if(RQ3_data_demographics$demographic[g] == "College Generation Unknown") {
RQ3_data_demographics$total_demographic[g] = nrow(RQ3_data %>% filter(firstgen == "NA"))
}
if(RQ3_data_demographics$demographic[g] == "Continuing Generation") {
RQ3_data_demographics$total_demographic[g] = nrow(RQ3_data %>% filter(firstgen == "non-FG"))
}
}
RQ3_data_demographics$demographic <- factor(RQ3_data_demographics$demographic,
levels = c("Female", "Male",
"Underrepresented Minority", "Racial Majority",
"Race/Ethnicity Unknown", "First Generation",
"Continuing Generation", "College Generation Unknown"))
RQ3_data_demographicsResearch Question 3 Plot 7
RQ3_plot_demographic_prop <- ggplot(RQ3_data_demographics,
aes(cmean, (number_people_cluster/total_demographic),
fill = demographic)) +
geom_col(position = "dodge") + scale_fill_brewer(palette = "Set2") +
facet_wrap(~source, labeller =
as_labeller(c(`1` = "Gender", `2` = "Race/Ethnicity", `3` = "College Generation"))) +
ggtitle("Proportion of Demographic Group by Average Cluster") +
xlab("Average Cluster Across Exams") +
ylab("Proportion") +
theme(legend.position = "bottom", legend.title = element_blank())
print(RQ3_plot_demographic_prop)
Research Question 3 Plot 8
RQ3_plot_demographic_BTE <- ggplot(RQ3_data_demographics,
aes(cmean, BTE_avg,
fill = demographic)) +
geom_col(position = "dodge") + scale_fill_brewer(palette = "Set2") +
facet_wrap(~source, labeller =
as_labeller(c(`1` = "Gender", `2` = "Race/Ethnicity", `3` = "College Generation"))) +
ggtitle("Better Than Expected Score by Average Cluster") +
xlab("Average Cluster Across Exams") +
ylab("Class BTE") +
theme(legend.position = "bottom", legend.title = element_blank())
print(RQ3_plot_demographic_BTE)
The 2 graphs above feel too busy. They are meant to look at students’ average time cluster across all 4 exams. Let’s say if a student’s average cluster was 1, 1.25, or 1.5, then they are in the “Early” cluster on average. If a student’s average cluster was 1.75, 2, or 2.25, they are in the “Middle” cluster on average. If a student’s average cluster was 2.5, 2.75, or 3, they are in the “Late” cluster on average.
Preparing Data for Cluster Averages
RQ3_data_cluster_avg <- RQ3_data %>% mutate(Cluster_avg = NA)
for (h in (1:nrow(RQ3_data_cluster_avg))) {
if (RQ3_data_cluster_avg$cmean[h] == 1.00 ||
RQ3_data_cluster_avg$cmean[h] == 1.25 ||
RQ3_data_cluster_avg$cmean[h] == 1.50) {
RQ3_data_cluster_avg$Cluster_avg[h] = "Early"
}
if (RQ3_data_cluster_avg$cmean[h] == 1.75 ||
RQ3_data_cluster_avg$cmean[h] == 2.00 ||
RQ3_data_cluster_avg$cmean[h] == 2.25) {
RQ3_data_cluster_avg$Cluster_avg[h] = "Middle"
}
if (RQ3_data_cluster_avg$cmean[h] == 2.50 ||
RQ3_data_cluster_avg$cmean[h] == 2.75 ||
RQ3_data_cluster_avg$cmean[h] == 3.00) {
RQ3_data_cluster_avg$Cluster_avg[h] = "Late"
}
}RQ3_data_cluster_gender <- RQ3_data_cluster_avg %>%
group_by(Cluster_avg, gender) %>%
summarise(number_people_cluster = n(),
BTE_avg = mean(BTE),
BTE_error = sd(BTE)/sqrt(number_people_cluster), .groups = "keep") %>%
rename(demographic = gender)RQ3_data_cluster_urm <- RQ3_data_cluster_avg %>%
group_by(Cluster_avg, urm) %>%
summarise(number_people_cluster = n(),
BTE_avg = mean(BTE),
BTE_error = sd(BTE)/sqrt(number_people_cluster), .groups = "keep") %>%
rename(demographic = urm)
for (l in 1:nrow(RQ3_data_cluster_urm)) {
if (RQ3_data_cluster_urm$demographic[l] != "a URM" &&
RQ3_data_cluster_urm$demographic[l] != "b non-URM") {
RQ3_data_cluster_urm$demographic[l] = "Race/Ethnicity Unknown"
}
if (RQ3_data_cluster_urm$demographic[l] == "a URM") {
RQ3_data_cluster_urm$demographic[l] = "Underrepresented Minority"
}
if (RQ3_data_cluster_urm$demographic[l] == "b non-URM") {
RQ3_data_cluster_urm$demographic[l] = "Racial Majority"
}
}RQ3_data_cluster_firstgen <- RQ3_data_cluster_avg %>%
group_by(Cluster_avg, firstgen) %>%
summarise(number_people_cluster = n(),
BTE_avg = mean(BTE),
BTE_error = sd(BTE)/sqrt(number_people_cluster), .groups = "keep") %>%
rename(demographic = firstgen)
for (m in 1:nrow(RQ3_data_cluster_firstgen)) {
if (RQ3_data_cluster_firstgen$demographic[m] != "FG" &&
RQ3_data_cluster_firstgen$demographic[m] != "non-FG") {
RQ3_data_cluster_firstgen$demographic[m] = "College Generation Unknown"
}
if (RQ3_data_cluster_firstgen$demographic[m] == "FG") {
RQ3_data_cluster_firstgen$demographic[m] = "First Generation"
}
if (RQ3_data_cluster_firstgen$demographic[m] == "non-FG") {
RQ3_data_cluster_firstgen$demographic[m] = "Continuing Generation"
}
}RQ3_data_cluster_demographics <- bind_rows(RQ3_data_cluster_gender,
RQ3_data_cluster_urm,
RQ3_data_cluster_firstgen,
.id = "source") %>%
mutate(total_demographic = NA)
for (n in 1:nrow(RQ3_data_cluster_demographics)) {
if(RQ3_data_cluster_demographics$demographic[n] == "Female") {
RQ3_data_cluster_demographics$total_demographic[n] = nrow(RQ3_data %>% filter(gender == "Female"))
}
if(RQ3_data_cluster_demographics$demographic[n] == "Male") {
RQ3_data_cluster_demographics$total_demographic[n] = nrow(RQ3_data %>% filter(gender == "Male"))
}
if(RQ3_data_cluster_demographics$demographic[n] == "Underrepresented Minority") {
RQ3_data_cluster_demographics$total_demographic[n] = nrow(RQ3_data %>% filter(urm == "a URM"))
}
if(RQ3_data_cluster_demographics$demographic[n] == "Racial Majority") {
RQ3_data_cluster_demographics$total_demographic[n] = nrow(RQ3_data %>% filter(urm == "b non-URM"))
}
if(RQ3_data_cluster_demographics$demographic[n] == "Race/Ethnicity Unknown") {
RQ3_data_cluster_demographics$total_demographic[n] = nrow(RQ3_data %>% filter(urm == "NA"))
}
if(RQ3_data_cluster_demographics$demographic[n] == "First Generation") {
RQ3_data_cluster_demographics$total_demographic[n] = nrow(RQ3_data %>% filter(firstgen == "FG"))
}
if(RQ3_data_cluster_demographics$demographic[n] == "College Generation Unknown") {
RQ3_data_cluster_demographics$total_demographic[n] = nrow(RQ3_data %>% filter(firstgen == "NA"))
}
if(RQ3_data_cluster_demographics$demographic[n] == "Continuing Generation") {
RQ3_data_cluster_demographics$total_demographic[n] = nrow(RQ3_data %>% filter(firstgen == "non-FG"))
}
}
RQ3_data_cluster_demographics$demographic <- factor(RQ3_data_cluster_demographics$demographic,
levels = c("Female", "Male",
"Underrepresented Minority", "Racial Majority",
"Race/Ethnicity Unknown", "First Generation",
"Continuing Generation",
"College Generation Unknown"))
RQ3_data_cluster_demographics$Cluster_avg <- factor(RQ3_data_cluster_demographics$Cluster_avg,
levels= c("Early", "Middle", "Late"))
RQ3_data_cluster_demographicsResearch Question 3 Plot 9
RQ3_plot_cluster_demographics_prop <- ggplot(RQ3_data_cluster_demographics,
aes(Cluster_avg, (number_people_cluster/total_demographic),
fill = demographic)) +
geom_col(position = "dodge") + scale_fill_brewer(palette = "Set2") +
facet_wrap(~source, labeller =
as_labeller(c(`1` = "Gender", `2` = "Race/Ethnicity", `3` = "College Generation"))) +
ggtitle("Proportion of Demographic Group by Average Cluster") +
xlab("Average Cluster Across Exams") +
ylab("Proportion") +
theme(legend.position = "bottom", legend.title = element_blank())
print(RQ3_plot_cluster_demographics_prop)
Research Question 3 Plot 10 (Used in Time Paper 3/5 Draft, Figure 5)
# Removed "Race/Ethnicity unknown" and "College generation unknown" from plot
RQ3_plot_cluster_demographics_prop <- ggplot(filter(RQ3_data_cluster_demographics,
demographic == "Female" ||
demographic == "Male" ||
demographic == "Underrepresented Minority" ||
demographic == "Racial Majority" ||
demographic == "First Generation" ||
demographic == "Continuing Generation"),
aes(Cluster_avg, (number_people_cluster/total_demographic),
fill = demographic)) +
geom_col(position = "dodge") +
geom_point(aes(Cluster_avg, y = (number_people_cluster/total_demographic),
shape = demographic), color = "gray20",
position = position_dodge(.9)) +
scale_fill_manual(values = c("#66ccee","#4477AA","#228833","#ccbb44","#EE6677","#AA3377")) +
facet_wrap(~source, labeller =
as_labeller(c(`1` = "Sex", `2` = "Race/Ethnicity", `3` = "College Generation"))) +
xlab("Average Cluster Across Exams") +
ylab("Proportion") +
theme_bw() +
theme(legend.position = "bottom", legend.title = element_blank())
print(RQ3_plot_cluster_demographics_prop)
Research Question 3 Plot 11
RQ3_plot_cluster_demographic_BTE <- ggplot(RQ3_data_cluster_demographics,
aes(Cluster_avg, BTE_avg,
fill = demographic)) +
geom_col(position = "dodge") + scale_fill_brewer(palette = "Set2") +
facet_wrap(~source, labeller =
as_labeller(c(`1` = "Gender", `2` = "Race/Ethnicity", `3` = "College Generation"))) +
ggtitle("Better Than Expected Score by Average Cluster") +
xlab("Average Cluster Across Exams") +
ylab("Class BTE") +
theme(legend.position = "bottom", legend.title = element_blank())
print(RQ3_plot_cluster_demographic_BTE)
Research Question 3 Plot 12
# Removed "Race/Ethnicity unknown" and "College generation unknown" from plot
RQ3_plot_cluster_demographic_BTE <- ggplot(filter(RQ3_data_cluster_demographics,
demographic == "Female" ||
demographic == "Male" ||
demographic == "Underrepresented Minority" ||
demographic == "Racial Majority" ||
demographic == "First Generation" ||
demographic == "Continuing Generation"),
aes(Cluster_avg, BTE_avg,
fill = demographic)) +
geom_col(position = "dodge") + scale_fill_brewer(palette = "Set2") +
facet_wrap(~source, labeller =
as_labeller(c(`1` = "Gender", `2` = "Race/Ethnicity", `3` = "College Generation"))) +
ggtitle("Better Than Expected Score by Average Cluster") +
xlab("Average Cluster Across Exams") +
ylab("Class BTE") +
theme(legend.position = "bottom", legend.title = element_blank())
print(RQ3_plot_cluster_demographic_BTE)
Research Question 3 Plot 12.5 (Used in Time Paper 3/5 Draft, Figure 6)
# Removed "Race/Ethnicity unknown" and "College generation unknown" from plot
RQ3_plot_cluster_demographic_BTE <- ggplot(filter(RQ3_data_cluster_demographics,
demographic == "Female" ||
demographic == "Male" ||
demographic == "Underrepresented Minority" ||
demographic == "Racial Majority" ||
demographic == "First Generation" ||
demographic == "Continuing Generation"),
aes(Cluster_avg, BTE_avg,
fill = demographic)) +
geom_col(position = "dodge") +
scale_fill_manual(values = c("#66ccee","#4477AA","#228833","#ccbb44","#EE6677","#AA3377")) +
geom_errorbar(aes(Cluster_avg, ymin = BTE_avg - BTE_error, ymax = BTE_avg + BTE_error),
position = position_dodge(.9),width = .2, color = "gray20") +
geom_point(aes(Cluster_avg, y = BTE_avg, shape = demographic), color = "gray20",
position = position_dodge(.9)) +
facet_wrap(~source, labeller =
as_labeller(c(`1` = "Sex", `2` = "Race/Ethnicity", `3` = "College Generation"))) +
xlab("Average Cluster Across Exams") +
ylab("Class BTE") +
theme_bw() +
theme(legend.position = "bottom", legend.title = element_blank())
print(RQ3_plot_cluster_demographic_BTE)
Questions to Consider for Research Question 3:
- How can we focus this section more? What is the key story?
Qualitative Survey Discussed in Paper
- How much do you feel like having extra time helped or hurt you?
- How did having the extra time help you?
- Which, if any, of the following do you think might have hurt your exam performance?
Survey Data
Qual_Survey <- read_excel("~/Documents/PHYSICS140WN2018SurveyData.xlsx")For now, too much work to clean the table to make figures representing survey data. Can revisit this if needed. Since we don’t say too much about the survey questions in the paper, we may not even need a graphic. We could format how we talk about the survey data better in the paper.