From: Benjamin Mako Hill Date: Wed, 23 Dec 2020 20:59:17 +0000 (-0800) Subject: updated with final participation grades ( X-Git-Url: https://code.communitydata.science/coldcallbot-discord.git/commitdiff_plain/743e0a39f3f56beab45e22845cd5117a5e316506 updated with final participation grades ( - also includes the code necessary to generate those grades --- 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