## # A tibble: 5 x 2
##   Teacher  `Average Grade`
##   <fct>              <dbl>
## 1 Alan                52.9
## 2 Brindley            69.4
## 3 Devin               53.8
## 4 Madelyn             60.2
## 5 Suzana              61.0

Basics of AS Global Perspectives End of Term Exam

blahblahblah

Overall Performance

Generally, the first thing we want to look at in one of these analyses is the overall distribution of grades, which we can see in the histogram below.

#Single Histogram
#Histograms
ggplot(data=EoTTotals, aes(x=Percentage)) +
  geom_histogram(aes(y=..density..), alpha = 0.6, position = "identity") +
  labs(x="Grade (Percentage)", y="Density") +
  stat_function(fun=dnorm, args = list(mean=mean(EoTTotals$Percentage), sd=sd(EoTTotals$Percentage)), 
                color="black", size   = 1.4) +
  scale_fill_manual(values= c("darkred", "darkgrey")) +
  scale_x_continuous(limits = c(0,100)) +
  theme_alan() +
  ggtitle("Histogram of Grades in AS Global Perspectives End of Term Exams")

ggsave(here("EoT Histogram.png"), plot = last_plot(), device = NULL, path = NULL,
       width = 8, height = 4, units = c("in", "cm", "mm"),
       dpi = 600)

Overall performance was pretty poor, with an average score of 59.75% and a standard deviation of 17.4% (Range = 7% to 93%).

Grades by Teacher

Lets see how the grades fell on a by-teacher basis.

EoTSummaryTeacher <- summarySE(EoTTotals, measurevar = "Percentage", groupvars = c("Teacher"))

ggplot(data=EoTSummaryTeacher, aes(x=Teacher, y= Percentage, fill = Teacher)) +
  geom_bar(stat= "summary", position = pd, width = 0.8) +
  geom_errorbar(aes(ymin= Percentage - se, ymax= Percentage + se), width= 0.2, size = 1, position= pd)+
  #annotate("text", x=11.5, y=7.2, label = "Average Grades", hjust = 0, fontface = "bold") +
  #annotate("text", x=11.5, y=6.7, label = "Alan's Class = 52.3%", hjust = 0, color = "darkred") +
  #annotate("text", x=11.5, y=6.2, label = "June's Class = 67.2%", hjust = 0, color = "darkgrey") +
  labs(x="Teacher", y="Average Grade (Percentage)") +
  theme_alan() +
  ggtitle("Bar Plot of Grades (By Teacher) on AS Global Perspectives EoT") 

ggsave(here("EoT Grades by Teacher.png"), plot = last_plot(), device = NULL, path = NULL,
       width = 8, height = 4, units = c("in", "cm", "mm"),
       dpi = 600)

Most of the grades were similar here, with the notable exception being that Brindley’s class performed much better than the other classes- 16% higher than students in Alan and Devin’s class and about 9% higher than Madelyn and Suzana’s

Grades by Marker

EoTSummaryMarker <- summarySE(EoTTotals, measurevar = "Percentage", groupvars = c("Marker"))

ggplot(data=EoTSummaryMarker, aes(x=Marker, y= Percentage, fill = Marker)) +
  geom_bar(stat= "summary", position = pd, width = 0.8) +
  geom_errorbar(aes(ymin= Percentage - se, ymax= Percentage + se), width= 0.2, size = 1, position= pd)+
  #annotate("text", x=11.5, y=7.2, label = "Average Grades", hjust = 0, fontface = "bold") +
  #annotate("text", x=11.5, y=6.7, label = "Alan's Class = 52.3%", hjust = 0, color = "darkred") +
  #annotate("text", x=11.5, y=6.2, label = "June's Class = 67.2%", hjust = 0, color = "darkgrey") +
  labs(x="Question", y="Average Grade (Percentage)") +
  theme_alan() +
  ggtitle("Bar Plot of Grades (By Marker) on AS Global Perspectives EoT") 

ggsave(here("EoT Grades by Marker.png"), plot = last_plot(), device = NULL, path = NULL,
       width = 8, height = 4, units = c("in", "cm", "mm"),
       dpi = 600)

Marking was pretty uniform, which is good. Brindley marked a bit harder and Suzana a bit easier, but this is almost certainly not significant.

Grades by Own vs Other Students

EoTTotals %<>%
  mutate(OwnStudent = ifelse(Teacher == Marker, "Own Student", "Other Student"))
  
EoTSummaryOwnStudent <- summarySE(EoTTotals, measurevar = "Percentage", groupvars = c("OwnStudent", "Marker"))


ggplot(data=EoTSummaryOwnStudent, aes(x=Marker, y= Percentage, fill = OwnStudent)) +
  geom_bar(stat= "summary", position = pd, width = 0.8) +
  geom_errorbar(aes(ymin= Percentage - se, ymax= Percentage + se), width= 0.2, size = 1, position= pd)+
  #annotate("text", x=11.5, y=7.2, label = "Average Grades", hjust = 0, fontface = "bold") +
  #annotate("text", x=11.5, y=6.7, label = "Alan's Class = 52.3%", hjust = 0, color = "darkred") +
  #annotate("text", x=11.5, y=6.2, label = "June's Class = 67.2%", hjust = 0, color = "darkgrey") +
  labs(x="Marker", y="Average Grade (Percentage)") +
  theme_alan() + 
  ggtitle("Bar Plot of Grades (By Student) on AS Global Perspectives EoT") 

ggsave(here("EoT Grades by Own Student.png"), plot = last_plot(), device = NULL, path = NULL,
       width = 8, height = 4, units = c("in", "cm", "mm"),
       dpi = 600)

Again it’s hard to say much here. Brindley and Madelyn marked their own students easier, but at least Brindley’s students were the highest students overall - so you can’t really disentangle those two things from each other.

Histograms of Grades by Criteria

No one other than me included grades by criteria, so we can’t really look at these.

Grade Boundary Adjustments

There are many ways we could assign grade boundaries, depending on how generous we are feeling. The simplest would be to use the same grade boundaries the school usually uses: A star is 90, A is 80, B is 70, and so on and so forth. If we do that let’s take a look at where the grades would fall

AStars1 <- subset(EoTTotals, Percentage > 89.99)
AStars1$Boundary1 <- "A*"

As1 <- subset(EoTTotals, Percentage < 89.99 & Percentage > 79.99)
As1$Boundary1 <- "A"

Bs1 <- subset(EoTTotals, Percentage < 79.99 & Percentage > 69.99)
Bs1$Boundary1 <- "B"

Cs1 <- subset(EoTTotals, Percentage < 69.99 & Percentage > 59.99)
Cs1$Boundary1 <- "C"

Ds1 <- subset(EoTTotals, Percentage < 59.99 & Percentage > 49.99)
Ds1$Boundary1 <- "D"

Es1 <- subset(EoTTotals, Percentage < 49.99 & Percentage > 39.99)
Es1$Boundary1 <- "E"

Us1 <- subset(EoTTotals, Percentage < 39.99)
Us1$Boundary1 <- "U"

EoTTotals2 <- rbind.data.frame(AStars1, As1, Bs1, Cs1, Ds1, Es1, Us1)
EoTTotals2$Boundary1 <- factor(EoTTotals2$Boundary1, levels = c("U", "E", "D", "C", "B", "A", "A*"))

  ggplot(data=EoTTotals2, aes(x=Boundary1)) +
  geom_histogram(stat = "count", position = pd, width = 0.8) +
  labs(x="Score", y="Count") +
  theme_alan() +
  ggtitle("AS Global Perspectives - Grade Boundaries - EoT")

ggsave(here("AS Global Perspectives- Histogram of Grade Boundaries - EoT.png"), plot = last_plot(), device = NULL, path = NULL,
       width = 8, height = 6, units = c("in", "cm", "mm"),
       dpi = 600)

So first thing is first we can see that the overall grades are too low if we assign grade boundaries in this way, which of course again means that we need to curve the grades, because currently the average is sitting around a C, with over 40 students at a D or below.

  ggplot(data=EoTTotals2, aes(x=Boundary1, fill = Teacher)) +
  geom_histogram(stat = "count", position = pd, width = 0.8) +
  labs(x="Score", y="Count") +
  theme_alan() +
  facet_wrap( ~ Teacher, ncol = 1)+
  ggtitle("AS Global Perspectives - Grade Boundaries by Teacher")

ggsave(here("AS Global Perspectives- Histogram of Grade Boundaries by Teacher.png"), plot = last_plot(), device = NULL, path = NULL,
       width = 8, height = 6, units = c("in", "cm", "mm"),
       dpi = 600)

We can also see the differences between the classes even more starkly here. But not much to say about them.

Applying Grade Boundaries

Lets see how well simply apply a “standard” curve to the grades by turning them into a normal distribution

library(ProfessR)
B = boxplot(EoTTotals2$Percentage, plot=FALSE)
divs = c(min(EoTTotals2$Percentage), B$stats[1:4] + diff(B$stats)/2, max(EoTTotals2$Percentage) )
D1 = do.grades(EoTTotals2$Percentage, divs=divs, tit="AS GP Presentations")

## Grade divisions:
## 7
## 36.5
## 55
## 65
## 81.5
## 93
## Letter Grade Distribution:
## 1 A+ 4
## 2 A 5
## 3 A- 1
## 4 B+ 12
## 5 B 3
## 6 B- 13
## 7 C+ 9
## 8 C 9
## 9 C- 8
## 10 D+ 14
## 11 D 13
## 12 D- 6
## 13 F 6
## [1] "Mean Score= 74.8817937378141"

So this gives us some idea of what a normal distribution around these grades would look like, but its arguably still too many students being given a D or less, and of course doesn’t include grades of U, which we also need.

count(EoTTotals2$Percentage) %>%
    knitr::kable(caption = "AS GP Grade Counts", "html", row.names = F) %>%
    kable_styling(full_width = F)
AS GP Grade Counts
x freq
7 2
13 1
23 1
27 1
33 1
37 2
40 4
43 4
47 9
50 5
53 9
57 8
60 9
63 9
67 8
70 5
73 3
77 7
80 5
83 1
87 5
90 3
93 1

So there you can see the counts of actual grades, which we can use to try to set boundaries as we have done before. For the EoT we have grades from 103 students.

First we set a U boundary. Let’s aim for 3 students again, which meaning all students under 20% get a U

Next are Es. Lets give 5 of those. So students between 20 and 37 get an E

Next our A-stars. We either give 4 or we give 9. As before I think better to be generous than to be stingy, so grades of 87 or higher are an A*

We gave 17 students an A on presentations. Lets only give 16 As - to the kids who scored from 73-83

We want less Ds than As, so lets give 8 of them - all the kids who scored from 40 to 43

This leaves us with 62 students between B and C. We want the numbers of these two to be about even, maybe slightly skewed towards a C (because we gave more A/Astar than the lower grades). But clumbing doesn’t always allow this, so again we have to split basically in half. So we can give 32 Bs - for students who scored from 60 - 70

This leaves us 30 grades of C, for kids with scores

We give 29 grades of B for scores between 63 and 71%, and 30 grades of C for scores between 50 and 60%

So we end up with these for grade divisions (number of scores is in brackets):

A*: >87 (9) A: 73 - 83 (16) B: 60 - 70 (32) C: 47 - 57 (30) D: 40 - 43 (8) E: 20 - 37 (5) U: <20% (3)

Now we we just need to assign the grades for these, which I do below

#A Stars - 9 students over 87%
AStars1 <- subset(EoTTotals2, Percentage > 86)
AStars1$Boundary2 <- "A*"
AStars1$PercentageCurve <- 90 + (AStars1$Percentage - 87)

#As - 16 students between 73 and 83
As1 <- subset(EoTTotals2, Percentage < 84 & Percentage > 72)
As1$Boundary2 <- "A"
As1$PercentageCurve <- (As1$Percentage - 74) + 81

#Bs - 31 students between 60 and 70
Bs1 <- subset(EoTTotals2, Percentage < 71 & Percentage > 59)
Bs1$Boundary2 <- "B"
Bs1$PercentageCurve <- round((Bs1$Percentage - 60)/1.2 + 70,2)

#Cs - 31 students between 47 and 57
Cs1 <- subset(EoTTotals2, Percentage < 58 & Percentage > 46)
Cs1$Boundary2 <- "C"
Cs1$PercentageCurve <- round((Cs1$Percentage - 46) /1.25 + 60, 0)

#Ds- 8 students between 40 and 43
Ds1 <- subset(EoTTotals2, Percentage < 44 & Percentage > 39)
Ds1$Boundary2 <- "D"
Ds1$PercentageCurve <- (Ds1$Percentage - 41) + 54

#Es- 5 students between 20 and 37
Es1 <- subset(EoTTotals2, Percentage < 38 & Percentage > 19)
Es1$Boundary2 <- "E"
Es1$PercentageCurve <- round((Es1$Percentage - 20)/2 + 40,0)

#Us - 3 Students below 20% (all set to 30% to not allow this one project to completely tank their grades)
Us1 <- subset(EoTTotals2, Percentage < 21)
Us1$Boundary2 <- "U"
Us1$PercentageCurve <- 30

EoTTotals3 <- 
  rbind.data.frame(AStars1, As1, Bs1, Cs1, Ds1, Es1, Us1) %>%
  arrange(Student)

FinalGrades <-
  EoTTotals2 %>%
    arrange(Student) %>%
    mutate(`Percentage (Curved)` = EoTTotals3$PercentageCurve) %>%
    mutate(Boundary2 = EoTTotals3$Boundary2) %>%
    subset(select = c(Student, Teacher, Grade, Percentage, `Percentage (Curved)`, Boundary2)) %>%
    setNames(c("Student", "Teacher", "Grade", "Percentage", "Percentage (Curved)", "Letter Grade")) %>%
    mutate(`Letter Grade` = factor(`Letter Grade`, levels = c("U", "E", "D", "C", "B", "A", "A*")))  %>%
    arrange(-Percentage)

head(FinalGrades, 10)
##         Student  Teacher Grade Percentage Percentage (Curved) Letter Grade
## 1     Nina Wang   Suzana    28         93                  96           A*
## 2   Kyle  Cheng   Suzana    27         90                  93           A*
## 3  Makayla Chen Brindley    27         90                  93           A*
## 4       Tony Wu Brindley    27         90                  93           A*
## 5        Amy An   Suzana    26         87                  90           A*
## 6  Chelsea Wang   Suzana    26         87                  90           A*
## 7    Erica Zhao   Suzana    26         87                  90           A*
## 8     Frank  Wu     Alan    26         87                  90           A*
## 9  Paulin Zhang  Madelyn    26         87                  90           A*
## 10    Rika Chen  Madelyn    25         83                  90            A

So now lets look at the distribution of the grades now

ggplot(data=FinalGrades, aes(x=`Percentage (Curved)` , fill = `Letter Grade`)) +
  geom_histogram(stat = "count", position = pd, width = 0.8) +
  labs(x="Score", y="Count") +
  theme_alan() +
  ggtitle("AS Global Perspectives - Revised Distribution of Letter Grades")

Woohoo - looks pretty good. Lets output this as some spreadsheets

write.csv(FinalGrades, here("AS GP Revised EoT.csv"))

#Alan
write.csv(subset(FinalGrades, Teacher == "Alan"), here("AS GP Revised EoT- Alan.csv"))

#Brindley
write.csv(subset(FinalGrades, Teacher == "Brindley"), here("AS GP Revised EoT- Brindley.csv"))

#Devin
write.csv(subset(FinalGrades, Teacher == "Devin"), here("AS GP Revised EoT- Devin.csv"))

#Madelyn
write.csv(subset(FinalGrades, Teacher == "Madelyn"), here("AS GP Revised EoT- Madelyn.csv"))

#Suzana
write.csv(subset(FinalGrades, Teacher == "Suzana"), here("AS GP Revised EoT- Suzana.csv"))

Conclusions

If you have any questions or comments about student performance in the class, please don’t hesitate to get in touch via email to Alan Nielsen.

This report was generated using R Markdown.