GRADING ON A CURVE DECOUPLES THE ACTUAL RAW SCORES FROM THE GRADE & MAKES IT A PEER-to-PEER SYSTEM:


The students:

n <- 150     # Number of students
x <- expand.grid(rep(list(c(LETTERS)), 2))
options <- do.call(paste0, x)
names   <- sample(options, size = n, replace = T)

The points - raw test scores:

points  <- c(sample(seq(40, 50, 0.1), 15, replace = T), 
             sample(seq(50, 60, 0.1), 46, replace = T),
             sample(seq(60, 70, 0.1), 25, replace = T),
             sample(seq(70, 80, 0.1), 47, replace = T),
             sample(seq(80, 100, 0.1), 17, replace = T))

data <- data.frame(names, points)

hist(points, xlim=c(0,100), border = F, col = 'tan') # Not normal

shapiro.test(points)                    # ... with high degree of certainty...
## 
##  Shapiro-Wilk normality test
## 
## data:  points
## W = 0.9691, p-value = 0.001843
qqnorm(points)                                  # ...even visually.

Grading on the curve:

cutoffs <- quantile(points, probs = pnorm(seq(-2,2))) # Select quantiles with frequency distr like SD of N(0,1)

data$final <- cut(data$points,
                     breaks=c(-Inf,cutoffs,+Inf),
                     labels=c(LETTERS[6:1])) # And we assign final grades based on these cutoffs

barplot(prop.table(table(data$final))) # Now they look normal

(freq_distr <- prop.table(table(data$final))) # These is how the grades are distributed.
## 
##          F          E          D          C          B          A 
## 0.02666667 0.13333333 0.34000000 0.34000000 0.13333333 0.02666667
(Normal_distr <- c(pnorm(-2), pnorm(-1) - pnorm(-2), pnorm(0) - pnorm(-1),
                  pnorm(1) - pnorm(0), pnorm(2) - pnorm(1), pnorm(2, lower.tail = F))) 
## [1] 0.02275013 0.13590512 0.34134475 0.34134475 0.13590512 0.02275013
# This is how the normal would have them.
chisq.test(freq_distr, p = Normal_distr) #And the GOF confirms normality.
## Warning in chisq.test(freq_distr, p = Normal_distr): Chi-squared
## approximation may be incorrect
## 
##  Chi-squared test for given probabilities
## 
## data:  freq_distr
## X-squared = 0.0015, df = 5, p-value = 1

Alternatively, the percentile can be given as the final grade, or used as an additional grade (percentile + ordinal score):

zscores <- scale(points) # Normalizes the points
mean(zscores); sd(zscores) #N(0,1)
## [1] 2.490022e-16
## [1] 1
hist(zscores, breaks = 18, border = F, col = 'tan') # The data distribution is normalized but not distributed normally

percentiles <- pnorm(zscores) * 100
plot(percentiles, pch = 20, col = 2)

At this point we can assign the percentiles as the final grade:

data$percentiles <- round(percentiles)
tail(data)
##     names points final percentiles
## 145    LV   96.8     A          99
## 146    MP   85.2     B          92
## 147    SQ   96.0     B          98
## 148    VC   97.9     A          99
## 149    DQ   96.3     A          99
## 150    KV   90.1     B          96

Or we can assign grades based on percentiles as we did with “points”:

cutoffs <- quantile(percentiles, probs = pnorm(seq(-2,2)))
data$alternative <- cut(data$percentiles,
                  breaks=c(-Inf,cutoffs,+Inf),
                  labels=c(LETTERS[6:1])) # And we assign final grades based on these cutoffs
tail(data)
##     names points final percentiles alternative
## 145    LV   96.8     A          99           A
## 146    MP   85.2     B          92           B
## 147    SQ   96.0     B          98           B
## 148    VC   97.9     A          99           A
## 149    DQ   96.3     A          99           A
## 150    KV   90.1     B          96           B
barplot(prop.table(table(data$alternative)))


Home Page