X-Git-Url: https://code.communitydata.science/coldcallbot-discord.git/blobdiff_plain/9c4f81c30ac7c23cf1dfad7af54d1f12d4ba4d58..HEAD:/assessment_and_tracking/compute_final_case_grades.R diff --git a/assessment_and_tracking/compute_final_case_grades.R b/assessment_and_tracking/compute_final_case_grades.R index 60a60f3..b26270b 100644 --- a/assessment_and_tracking/compute_final_case_grades.R +++ b/assessment_and_tracking/compute_final_case_grades.R @@ -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 - -## 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 +tmp <- do.call("rbind", lapply(d$unique.name, gen.part.grade)) -## 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="")) +## }