collective/coldcallbot
17
0
Fork 0
Code

fix an ordering bug with grade creation

Browse Source
This commit is contained in:
Benjamin Mako Hill 2022-03-05 22:48:40 -08:00
parent 78ac188f04
commit a50468cac2
1 changed files with 26 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

50
assessment_and_tracking/compute_final_case_grades.R
View File

@ -10,21 +10,20 @@ rownames(d) <- d$unique.name
call.list$timestamp <- as.Date(call.list$timestamp) call.list$timestamp <- as.Date(call.list$timestamp)
## class-level variables ## class-level variables
question.grades <- c("PLUS"=100, "CHECK"=100-(50/3.3), "MINUS"=100-(50/(3.3)*2)) gpa.point.value <- 50/(4 - 0.7)
missed.question.penalty <- (50/3.3) * 0.2 ## 1/5 of a full point on the GPA scale question.grades <- c("PLUS"=100, "CHECK"=100-gpa.point.value, "MINUS"=100-(gpa.point.value*2))
missed.question.penalty <- gpa.point.value * 0.2 ## 1/5 of a full point on the GPA scale
## inspect set the absence threashold ## inspect set the absence threashold
ggplot(d) + aes(x=absences) + geom_histogram(binwidth=1, fill="white",color="black") ggplot(d) + aes(x=absences) + geom_histogram(binwidth=1, fill="white",color="black")
## absence.threshold <- median(d$absences) absence.threshold <- median(d$absences)
absence.threshold <- 4 ## TODO talk about this
## inspect and set the questions cutoff ## inspect and set the questions cutoff
## questions.cutoff <- median(d$num.calls) ## questions.cutoff <- median(d$num.calls)
## median(d$num.calls) ## median(d$num.calls)
## questions.cutoff <- nrow(call.list) / nrow(d) ## TODO talk about this ## questions.cutoff <- nrow(call.list) / nrow(d) ## TODO talk about this
## first these are the people were were not called simply because they got unlucky ## this is the 95% percentile based on simulation in simulation.R
## this is the 95% percentile based on simulation in simulation.R
questions.cutoff <- 4 questions.cutoff <- 4
## show the distribution of assessments ## show the distribution of assessments
@ -36,8 +35,11 @@ prop.table(table(call.list.full$answered))
total.questions.asked <- nrow(call.list) total.questions.asked <- nrow(call.list)
## find out how man questions folks have present/absent for ## find out how man questions folks have present/absent for.
########################################################## ##
## NOTE: this is currently only for informational purposes and is NOT
## being used to compute grants in any way.
########################################################################
calls.per.day <- data.frame(day=as.Date(names(table(call.list$timestamp))), calls.per.day <- data.frame(day=as.Date(names(table(call.list$timestamp))),
questions.asked=as.numeric(table(call.list$timestamp))) questions.asked=as.numeric(table(call.list$timestamp)))
@ -67,7 +69,7 @@ d$prop.asked.quant <- cut(d$prop.asked, right=FALSE, breaks=c(prop.asks.quantile
labels=names(prop.asks.quantiles)[1:(length(prop.asks.quantiles))]) labels=names(prop.asks.quantiles)[1:(length(prop.asks.quantiles))])
## generate grades ## generate grades
########################################################## ########################################################################
## print the median number of questions for (a) everybody and (b) ## print the median number of questions for (a) everybody and (b)
## people that have been present 75% of the time ## people that have been present 75% of the time
@ -92,45 +94,44 @@ gen.part.grade <- function (x.unique.name) {
tmp <- do.call("rbind", lapply(d$unique.name, gen.part.grade)) tmp <- do.call("rbind", lapply(d$unique.name, gen.part.grade))
d <- merge(d, tmp) d <- merge(d, tmp)
rownames(d) <- d$unique.name rownames(d) <- d$unique.name
d$part.grade <- d$base.grade
## apply the penality for number of days we called on them and they were gone
d$part.grade <- d$base.grade - d$missing.in.class.days * missed.question.penalty
d$part.grade.orig <- d$part.grade
## first we handle the zeros ## first we handle the zeros
## step 1: first double check the people who have zeros and ensure that they didn't "just" get unlucky" ## step 1: first double check the people who have zeros and ensure that they didn't "just" get unlucky"
d[d$num.calls == 0,] d[d$num.calls == 0,]
## set those people to 0 :( ## set those people to 0 :(
d[d$num.calls == 0]
d$part.grade[d$num.calls == 0] <- 0 d$part.grade[d$num.calls == 0] <- 0
## step 2: identify the people who were were not asked "enough" questions but were unlucky/lucky ## step 2: identify the people who were were not asked "enough"
## penalized.unique.names <- d$unique.name[d$num.calls < median(d$num.calls) & d$absences > median(d$absences)] ## questions but were unlucky/lucky
## first these are the people were were not called simply because they got unlucky ## first this just prints out are the people were were not called
## simply because they got unlucky
d[d$num.calls < questions.cutoff & d$absences < absence.threshold,] d[d$num.calls < questions.cutoff & d$absences < absence.threshold,]
## first these are the people were were not called simply because they got unlucky ## these are the people were were not called simply unlucky (i.e.,
## they were not in class very often)
penalized.unique.names <- d$unique.name[d$num.calls < questions.cutoff & d$absences > absence.threshold] penalized.unique.names <- d$unique.name[d$num.calls < questions.cutoff & d$absences > absence.threshold]
d[d$unique.name %in% penalized.unique.names,] d[d$unique.name %in% penalized.unique.names,]
## now add "zeros" for every questions that is below the normal ## now add "zeros" for every questions that is below the normal
d[as.character(penalized.unique.names),"part.grade"] <- (( d[as.character(penalized.unique.names),"part.grade"] <- (
(questions.cutoff - d[as.character(penalized.unique.names),"num.calls"] * 0) + (d[as.character(penalized.unique.names),"num.calls"] * d[as.character(penalized.unique.names),"part.grade"])
(d[as.character(penalized.unique.names),"num.calls"] * d[as.character(penalized.unique.names),"part.grade"]) )
/ questions.cutoff) / questions.cutoff)
d[as.character(penalized.unique.names),] d[as.character(penalized.unique.names),]
## apply the penality for number of days we called on them and they were gone
d$part.grade <- d$part.grade - d$missing.in.class.days * missed.question.penalty
## TODO ensure this is right. i think it is ## TODO ensure this is right. i think it is
## map part grades back to 4.0 letter scale and points ## 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$part.4point <- round((d$part.grade / gpa.point.value) - ((100 / gpa.point.value) - 4), 2)
d[sort.list(d$part.4point, decreasing=TRUE), d[sort.list(d$part.4point, decreasing=TRUE),
c("unique.name", "short.name", "num.calls", "absences", "part.4point")] c("unique.name", "short.name", "num.calls", "absences", "part.4point")]
## writing out data to CSV ## writing out data to CSV
d.print <- merge(d, myuw[,c("StudentNo", "FirstName", "LastName", "UWNetID")], d.print <- merge(d, myuw[,c("StudentNo", "FirstName", "LastName", "UWNetID")],
by.x="unique.name", by.y="StudentNo") by.x="unique.name", by.y="StudentNo")
@ -145,3 +146,4 @@ for (id in d$unique.name) {
d.print$unique.name[d.print$unique.name == id], d.print$unique.name[d.print$unique.name == id],
sep="")) sep=""))
} }
k