collective/coldcallbot
18
0
Fork 0
Code Activity

updated grade code

Browse Source 
- COMMLD570A did not penalize/track absences at all so i cut this completely
This commit is contained in:
Benjamin Mako Hill
2021-05-31 17:06:09 -07:00
parent da8f47aa27
commit 3bd4c9c2a6
2 changed files with 28 additions and 166 deletions
Download Patch File Download Diff File Expand all files Collapse all files

95
assessment_and_tracking/compute_final_case_grades.R
View File

@@ -1,36 +1,23 @@
## load in the data
#################################
case.sessions <- 15
myuw <- read.csv("myuw-COM_482_A_autumn_2020_students.csv", stringsAsFactors=FALSE)
myuw <- read.csv("myuw-COMMLD_570_A_spring_2021_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
question.grades <- c("GOOD"=100, "FAIR"=100-(50/3.3), "WEAK"=100-(50/(3.3)*2))
source("../assessment_and_tracking/track_participation.R")
setwd("case_grades")
rownames(d) <- d$discord.name
rownames(d) <- d$unique.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))
table(call.list$assessment)
prop.table(table(call.list$assessment))
table(call.list$answered)
prop.table(table(call.list$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)])
total.questions.asked <- nrow(call.list)
## generate grades
##########################################################
@@ -39,81 +26,47 @@ 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]]
gen.part.grade <- function (x.unique.name) {
q.scores <- question.grades[call.list$assessment[call.list$unique.name == x.unique.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,])
# missing.days <- nrow(missing.in.class[missing.in.class$unique.name == x.unique.name,])
## return the final score
data.frame(discord.name=x.discord.name,
part.grade=(base.score - missing.days * missed.question.penalty))
data.frame(unique.name=x.unique.name,
part.grade=(base.score))
}
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
tmp <- do.call("rbind", lapply(d$unique.name, gen.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)]
d[as.character(tmp$unique.name), "part.grade"] <- tmp$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")]
d[sort.list(d$part.4point),]
## 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)
## library(rmarkdown)
for (x.discord.name in d$discord.name) {
render(input="../../assessment_and_tracking/student_report_template.Rmd",
output_format="html_document",
output_file=paste("../data/case_grades/student_reports/",
d.print$UWNetID[d.print$discord.name == x.discord.name],
sep=""))
}
## for (x.unique.name in d$unique.name) {
## render(input="../../assessment_and_tracking/student_report_template.Rmd",
## output_format="html_document",
## output_file=paste("../data/case_grades/student_reports/",
## d.print$UWNetID[d.print$unique.name == x.unique.name],
## sep=""))
## }