From 743e0a39f3f56beab45e22845cd5117a5e316506 Mon Sep 17 00:00:00 2001
From: Benjamin Mako Hill <mako@atdot.cc>
Date: Wed, 23 Dec 2020 12:59:17 -0800
Subject: [PATCH] updated with final participation grades (

- also includes the code necessary to generate those grades
---
 data/case_grades/compute_final_case_grades.R | 120 +++++++++++++++++++
 data/case_grades/student_report_template.Rmd |  25 ++++
 data/track_participation.R                   |  25 +++-
 3 files changed, 167 insertions(+), 3 deletions(-)
 create mode 100644 data/case_grades/compute_final_case_grades.R
 create mode 100644 data/case_grades/student_report_template.Rmd

diff --git a/data/case_grades/compute_final_case_grades.R b/data/case_grades/compute_final_case_grades.R
new file mode 100644
index 0000000..e11b1a9
--- /dev/null
+++ b/data/case_grades/compute_final_case_grades.R
@@ -0,0 +1,120 @@
+## load in the data
+#################################
+
+case.sessions  <- 15
+myuw <- read.csv("../myuw-COM_482_A_autumn_2020_students.csv", stringsAsFactors=FALSE)
+
+## class-level variables
+question.grades <- c("GOOD"=100, "FAIR"=100-(50/3.3), "BAD"=100-(50/(3.3)*2))
+missed.question.penalty <- (50/3.3) * 0.2 ## 1/5 of a full point on the GPA scale
+
+setwd("../")
+source("track_participation.R")
+setwd("case_grades")
+
+rownames(d) <- d$discord.name
+
+## show the distribution of assessments
+table(call.list.full$assessment)
+prop.table(table(call.list.full$assessment))
+table(call.list.full$answered)
+prop.table(table(call.list.full$answered))
+
+total.questions.asked <- nrow(call.list.full)
+
+## create new column with number of questions present
+d$prop.asked <- d$num.calls / d$num.present
+
+## generate statistics using these new variables
+prop.asks.quantiles <- quantile(d$prop.asked, probs=seq(0,1, 0.01))
+prop.asks.quantiles <- prop.asks.quantiles[!duplicated(prop.asks.quantiles)]
+
+## this is generating broken stuff but it's not used for anything
+d$prop.asked.quant <- cut(d$prop.asked, breaks=prop.asks.quantiles,
+    labels=names(prop.asks.quantiles)[1:(length(prop.asks.quantiles)-1)])
+
+## generate grades
+##########################################################
+
+d$part.grade <- NA
+
+## print the median number of questions for (a) everybody and (b)
+## people that have been present 75% of the time
+median(d$num.calls[d$days.absent < 0.25*case.sessions])
+median(d$num.calls)
+
+questions.cutoff <- median(d$num.calls)
+
+## helper function to generate average grade minus number of missing
+gen.part.grade <- function (x.discord.name) {
+    q.scores <- question.grades[call.list$assessment[call.list$discord.name == x.discord.name]]
+    base.score <- mean(q.scores, na.rm=TRUE)
+
+    ## number of missing days
+    missing.days <- nrow(missing.in.class[missing.in.class$discord.name == x.discord.name,])
+
+    ## return the final score
+    data.frame(discord.name=x.discord.name,
+               part.grade=(base.score - missing.days * missed.question.penalty))
+}
+
+tmp <- do.call("rbind", lapply(d$discord.name[d$num.calls >= questions.cutoff], gen.part.grade))
+
+d[as.character(tmp$discord.name), "part.grade"] <- tmp$part.grade
+
+## next handle the folks *under* the median
+
+## first we handle the zeros
+## step 1: first double check the people who have zeros and ensure that they didn't "just" get unlucky"
+d[d$num.calls == 0,]
+
+## set those people to 0 :(
+d$part.grade[d$num.calls == 0] <- 0
+
+## step 2 is to handle folks who got unlucky in the normal way
+tmp <- do.call("rbind", lapply(d$discord.name[is.na(d$part.grade) & d$prop.asked <= median(d$prop.asked)], gen.part.grade))
+d[as.character(tmp$discord.name), "part.grade"] <- tmp$part.grade
+
+## the people who are left are lucky and still undercounted so we'll penalize them
+d[is.na(d$part.grade),]
+penalized.discord.names <- d$discord.name[is.na(d$part.grade)]
+
+## generate the baseline participation grades as per the process above
+tmp <- do.call("rbind", lapply(penalized.discord.names, gen.part.grade))
+d[as.character(tmp$discord.name), "part.grade"] <- tmp$part.grade
+
+## now add "zeros" for every questions that is below the normal
+d[as.character(penalized.discord.names),"part.grade"] <- ((
+    (questions.cutoff - d[as.character(penalized.discord.names),"num.calls"] * 0) +
+    (d[as.character(penalized.discord.names),"num.calls"] * d[as.character(penalized.discord.names),"part.grade"]) )
+    / questions.cutoff)
+
+d[as.character(penalized.discord.names),]
+
+## map part grades back to 4.0 letter scale and points
+d$part.4point <-round((d$part.grade / (50/3.3)) - 2.6, 2)
+
+d[sort.list(d$prop.asked), c("discord.name", "num.calls", "num.present",
+                             "prop.asked", "prop.asked.quant", "part.grade", "part.4point",
+                             "days.absent")]
+
+d[sort.list(d$part.4point), c("discord.name", "num.calls", "num.present",
+                             "prop.asked", "prop.asked.quant", "part.grade", "part.4point",
+                             "days.absent")]
+
+
+## writing out data
+quantile(d$num.calls, probs=(0:100*0.01))
+d.print <- merge(d, myuw[,c("StudentNo", "FirstName", "LastName", "UWNetID")],
+           by.x="student.num", by.y="StudentNo")
+write.csv(d.print, file="final_participation_grades.csv")
+
+library(rmarkdown)
+
+for (x.discord.name in d$discord.name) {
+    render(input="student_report_template.Rmd",
+           output_format="html_document",
+           output_file=paste("student_reports/",
+                             d.print$UWNetID[d.print$discord.name == x.discord.name],
+                             sep=""))
+}
diff --git a/data/case_grades/student_report_template.Rmd b/data/case_grades/student_report_template.Rmd
new file mode 100644
index 0000000..a0b2145
--- /dev/null
+++ b/data/case_grades/student_report_template.Rmd
@@ -0,0 +1,25 @@
+**Student Name:** `r paste(d.print[d.print$discord.name == x.discord.name, c("FirstName", "LastName")])`
+
+**Discord Name:** `r d.print[d.print$discord.name == x.discord.name, c("discord.name")]`
+
+**Participation grade:** `r d.print$part.4point[d.print$discord.name == x.discord.name]`
+
+**Questions asked:** `r d.print[d$discord.name == x.discord.name, "prev.questions"]`
+
+**Days Absent:** `r d.print[d.print$discord.name == x.discord.name, "days.absent"]` / `r case.sessions`
+
+**List of questions:**
+
+```{r echo=FALSE}
+call.list[call.list$discord.name == x.discord.name,]
+```
+
+**Luckiness:** `r d.print[d.print$discord.name == x.discord.name, "prop.asked.quant"]`
+
+If you a student has a luckiness over 50% that means that they were helped by the weighting of the system and/or got lucky. We did not penalize *any* students with a luckiness under 50% for absences.
+
+
+
+
+
+
diff --git a/data/track_participation.R b/data/track_participation.R
index 8bce2e5..9a51084 100644
--- a/data/track_participation.R
+++ b/data/track_participation.R
@@ -1,15 +1,17 @@
 library(ggplot2)
+library(data.table)
 
 gs <- read.delim("student_information.tsv")
 d <- gs[,c(2,5)]
 colnames(d) <- c("student.num", "discord.name")
 
-call.list <- do.call("rbind", lapply(list.files(".", pattern="^call_list-.*tsv$"), function (x) {read.delim(x)[,1:3]}))
+call.list <- do.call("rbind", lapply(list.files(".", pattern="^call_list-.*tsv$"), function (x) {read.delim(x)[,1:4]}))
 colnames(call.list) <- gsub("_", ".", colnames(call.list))
 
 call.list$day <- as.Date(call.list$timestamp)
 
 ## drop calls where the person wasn't present
+call.list.full <- call.list
 call.list[!call.list$answered,]
 call.list <- call.list[call.list$answered,]
 
@@ -23,7 +25,6 @@ d$num.calls[is.na(d$num.calls)] <- 0
       
 attendance <- unlist(lapply(list.files(".", pattern="^attendance-.*tsv$"), function (x) {d <- read.delim(x); strsplit(d[[2]], ",")}))
 
-
 file.to.attendance.list <- function (x) {
     tmp <- read.delim(x)
     d.out <- data.frame(discord.name=unlist(strsplit(tmp[[2]], ",")))
@@ -35,6 +36,22 @@ attendance <- do.call("rbind",
                       lapply(list.files(".", pattern="^attendance-.*tsv$"),
                              file.to.attendance.list))
 
+## create list of folks who are missing in class 
+missing.in.class  <- call.list.full[is.na(call.list.full$answered) |
+                                    (!is.na(call.list.full$answered) & !call.list.full$answered),
+                                    c("discord.name", "day")]
+
+missing.in.class <- unique(missing.in.class)
+
+setDT(attendance)
+setkey(attendance, discord.name, day)
+setDT(missing.in.class)
+setkey(missing.in.class, discord.name, day)
+
+## drop presence for people on missing days
+attendance[missing.in.class,]
+attendance <- as.data.frame(attendance[!missing.in.class,])
+
 attendance.counts <- data.frame(table(attendance$discord.name))
 colnames(attendance.counts) <- c("discord.name", "num.present")
 
@@ -43,9 +60,10 @@ d <- merge(d, attendance.counts,
            by="discord.name")
 
 days.list <- lapply(unique(attendance$day), function (day) {
-    day.total <- table(call.list$day == day)[["TRUE"]]
+    day.total <- table(call.list.full$day == day)[["TRUE"]]
     lapply(d$discord.name, function (discord.name) {
         num.present <- nrow(attendance[attendance$day == day & attendance$discord.name == discord.name,])
+        if (num.present/day.total > 1) {print(day)}
         data.frame(discord.name=discord.name,
                    days.present=(num.present/day.total))
     })
@@ -61,6 +79,7 @@ attendance.days <- data.frame(discord.name=names(days.tbl),
 
 d <- merge(d, attendance.days,
            all.x=TRUE, all.y=TRUE, by="discord.name")
+
 d[sort.list(d$days.absent), c("discord.name", "num.calls", "days.absent")]
 
 ## make some visualizations of whose here/not here
-- 
2.39.2