149 lines
5.7 KiB
R
149 lines
5.7 KiB
R
## load in the data
|
|
#################################
|
|
myuw <- read.csv("data/2025_autumn_COMMLD_570_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("GOOD"=100, "FAIR"=100-gpa.point.value, "BAD"=100-(gpa.point.value*2))
|
|
question.grades <- c("GOOD"=100, "SATISFACTORY"=100-gpa.point.value, "POOR"=100-(gpa.point.value*2), "NO MEANINGFUL ANSWER"=0)
|
|
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 <- 34
|
|
|
|
## 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]]
|
|
print(q.scores)
|
|
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="assessment_and_tracking/student_report_template.Rmd",
|
|
output_format="html_document",
|
|
output_file=paste("data/case_grades/",
|
|
d.print$unique.name[d.print$unique.name == id],
|
|
sep=""))
|
|
}
|