## load in the data ################################# myuw <- read.csv("../data/2022_winter_COM_481_A_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 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) ## 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$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) ## 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$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)] 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 ######################################################################## ## print the median number of questions for (a) everybody and (b) ## people that have been present 75% of the time median(d$num.calls) ## helper function to generate average grade minus number of missing 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.in.class.days <- nrow(missing.in.class[missing.in.class$unique.name == x.unique.name,]) ## return the final score data.frame(unique.name=x.unique.name, base.grade=base.score, missing.in.class.days=missing.in.class.days) } ## 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" d[d$num.calls == 0,] ## set those people to 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 ## 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,] ## 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.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.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 ## 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 to CSV d.print <- merge(d, myuw[,c("StudentNo", "FirstName", "LastName", "UWNetID")], by.x="unique.name", by.y="StudentNo") write.csv(d.print, file="../data/final_participation_grades.csv") library(rmarkdown) for (id in d$unique.name) { render(input="student_report_template.Rmd", output_format="html_document", output_file=paste("../data/case_grades/", d.print$unique.name[d.print$unique.name == id], sep="")) }