## load in the data
#################################
+myuw <- read.csv("../data/2022_winter_COM_481_A_students.csv", stringsAsFactors=FALSE)
-case.sessions <- 15
-myuw <- read.csv("myuw-COM_482_A_autumn_2020_students.csv", stringsAsFactors=FALSE)
+current.dir <- getwd()
+source("../assessment_and_tracking/track_participation.R")
+setwd(current.dir)
+
+rownames(d) <- d$unique.name
+call.list$timestamp <- as.Date(call.list$timestamp)
## 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
+gpa.point.value <- 50/(4 - 0.7)
+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
+ggplot(d) + aes(x=absences) + geom_histogram(binwidth=1, fill="white",color="black")
+absence.threshold <- median(d$absences)
-source("../assessment_and_tracking/track_participation.R")
-setwd("case_grades")
-rownames(d) <- d$discord.name
+## inspect and set the questions cutoff
+## questions.cutoff <- median(d$num.calls)
+## median(d$num.calls)
+## questions.cutoff <- nrow(call.list) / nrow(d) ## TODO talk about this
+## this is the 95% percentile based on simulation in simulation.R
+questions.cutoff <- 4
## show the distribution of assessments
-table(call.list.full$assessment)
-prop.table(table(call.list.full$assessment))
+table(call.list$assessment)
+prop.table(table(call.list$assessment))
+
table(call.list.full$answered)
prop.table(table(call.list.full$answered))
-total.questions.asked <- nrow(call.list.full)
+total.questions.asked <- nrow(call.list)
+
+## 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))),
+ questions.asked=as.numeric(table(call.list$timestamp)))
+
+## function to return the numbers of calls present for or zero if they
+## were absent
+calls.for.student.day <- function (day, student.id) {
+ if (any(absence$unique.name == student.id & absence$date.absent == day)) {
+ return(0)
+ } else {
+ return(calls.per.day$questions.asked[calls.per.day$day == day])
+ }
+}
+
+compute.questions.present.for.student <- function (student.id) {
+ sum(unlist(lapply(unique(calls.per.day$day), calls.for.student.day, student.id)))
+}
## create new column with number of questions present
-d$prop.asked <- d$num.calls / d$num.present
+d$q.present <- unlist(lapply(d$unique.name, compute.questions.present.for.student))
+d$prop.asked <- d$num.calls / d$q.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)])
+d$prop.asked.quant <- cut(d$prop.asked, right=FALSE, breaks=c(prop.asks.quantiles, 1),
+ labels=names(prop.asks.quantiles)[1:(length(prop.asks.quantiles))])
## 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]]
+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.in.class.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,
+ base.grade=base.score,
+ missing.in.class.days=missing.in.class.days)
}
-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
+## create the base grades which do NOT include missing questions
+tmp <- do.call("rbind", lapply(d$unique.name, gen.part.grade))
+d <- merge(d, tmp)
+rownames(d) <- d$unique.name
+d$part.grade <- d$base.grade
## first we handle the zeros
## step 1: first double check the people who have zeros and ensure that they didn't "just" get unlucky"
## 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
+## step 2: identify the people who were were not asked "enough"
+## questions but were unlucky/lucky
-## 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)]
+## 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,]
-## 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
+## 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]
+d[d$unique.name %in% penalized.unique.names,]
## 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"]) )
+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)
-d[as.character(penalized.discord.names),]
+d[as.character(penalized.unique.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")]
+## 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
-d[sort.list(d$part.4point), c("discord.name", "num.calls", "num.present",
- "prop.asked", "prop.asked.quant", "part.grade", "part.4point",
- "days.absent")]
+## TODO ensure this is right. i think it is
+## map part grades back to 4.0 letter scale and points
+d$part.4point <- round((d$part.grade / gpa.point.value) - ((100 / gpa.point.value) - 4), 2)
+d[sort.list(d$part.4point, decreasing=TRUE),
+ c("unique.name", "short.name", "num.calls", "absences", "part.4point")]
-## writing out data
-quantile(d$num.calls, probs=(0:100*0.01))
+## writing out data to CSV
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")
+ by.x="unique.name", by.y="StudentNo")
+write.csv(d.print, file="../data/final_participation_grades.csv")
library(rmarkdown)
-for (x.discord.name in d$discord.name) {
- render(input="../../assessment_and_tracking/student_report_template.Rmd",
+for (id in d$unique.name) {
+ render(input="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],
+ output_file=paste("../data/case_grades/",
+ d.print$unique.name[d.print$unique.name == id],
sep=""))
}
projects / coldcallbot-discord.git / blobdiff