assessment_and_tracking/compute_final_case_grades.R

   1 ## load in the data
   2 #################################
   3 myuw <- read.csv("../data/2022_winter_COM_481_A_students.csv", stringsAsFactors=FALSE)
   4
   5 current.dir <- getwd()
   6 source("../assessment_and_tracking/track_participation.R")
   7 setwd(current.dir)
   8
   9 rownames(d) <- d$unique.name
  10 call.list$timestamp <- as.Date(call.list$timestamp)
  11
  12 ## class-level variables
  13 question.grades <- c("PLUS"=100, "CHECK"=100-(50/3.3), "MINUS"=100-(50/(3.3)*2))
  14 missed.question.penalty <- (50/3.3) * 0.2 ## 1/5 of a full point on the GPA scale
  15
  16 ## inspect set the absence threashold
  17 ggplot(d) + aes(x=absences) + geom_histogram(binwidth=1, fill="white",color="black")
  18 ## absence.threshold <- median(d$absences)
  19 absence.threshold <- 4 ## TODO talk about this
  20
  21 ## inspect and set the questions cutoff
  22 ## questions.cutoff <- median(d$num.calls)
  23 ## median(d$num.calls)
  24 ## questions.cutoff <- nrow(call.list) / nrow(d) ## TODO talk about this
  25 ## first these are the people were were not called simply because they got unlucky
  26
  27  ## this is the 95% percentile based on simulation in simulation.R
  28 questions.cutoff <- 4
  29
  30 ## show the distribution of assessments
  31 table(call.list$assessment)
  32 prop.table(table(call.list$assessment))
  33
  34 table(call.list.full$answered)
  35 prop.table(table(call.list.full$answered))
  36
  37 total.questions.asked <- nrow(call.list)
  38
  39 ## find out how man questions folks have present/absent for
  40 ##########################################################
  41 calls.per.day <- data.frame(day=as.Date(names(table(call.list$timestamp))),
  42                             questions.asked=as.numeric(table(call.list$timestamp)))
  43
  44 ## function to return the numbers of calls present for or zero if they
  45 ## were absent
  46 calls.for.student.day <- function (day, student.id) {
  47     if (any(absence$unique.name == student.id & absence$date.absent == day)) {
  48         return(0)
  49     } else {
  50         return(calls.per.day$questions.asked[calls.per.day$day == day])
  51     }
  52 }
  53
  54 compute.questions.present.for.student <- function (student.id) {
  55     sum(unlist(lapply(unique(calls.per.day$day), calls.for.student.day, student.id)))
  56 }
  57
  58 ## create new column with number of questions present
  59 d$q.present <- unlist(lapply(d$unique.name, compute.questions.present.for.student))
  60 d$prop.asked <- d$num.calls / d$q.present
  61
  62 ## generate statistics using these new variables
  63 prop.asks.quantiles <- quantile(d$prop.asked, probs=seq(0,1, 0.01))
  64 prop.asks.quantiles <- prop.asks.quantiles[!duplicated(prop.asks.quantiles)]
  65
  66 d$prop.asked.quant <- cut(d$prop.asked, right=FALSE, breaks=c(prop.asks.quantiles, 1),
  67     labels=names(prop.asks.quantiles)[1:(length(prop.asks.quantiles))])
  68
  69 ## generate grades
  70 ##########################################################
  71
  72 ## print the median number of questions for (a) everybody and (b)
  73 ## people that have been present 75% of the time
  74 median(d$num.calls)
  75
  76 ## helper function to generate average grade minus number of missing
  77 gen.part.grade <- function (x.unique.name) {
  78     q.scores <- question.grades[call.list$assessment[call.list$unique.name == x.unique.name]]
  79     base.score <- mean(q.scores, na.rm=TRUE)
  80
  81     ## number of missing days
  82     missing.in.class.days <- nrow(missing.in.class[missing.in.class$unique.name == x.unique.name,])
  83
  84     ## return the final score
  85     data.frame(unique.name=x.unique.name,
  86                base.grade=base.score,
  87                missing.in.class.days=missing.in.class.days)
  88 }
  89
  90
  91 ## create the base grades which do NOT include missing questions
  92 tmp <- do.call("rbind", lapply(d$unique.name, gen.part.grade))
  93 d <- merge(d, tmp)
  94 rownames(d) <- d$unique.name
  95
  96 ## apply the penality for number of days we called on them and they were gone
  97 d$part.grade <- d$base.grade - d$missing.in.class.days * missed.question.penalty
  98 d$part.grade.orig <- d$part.grade
  99
 100 ## first we handle the zeros
 101 ## step 1: first double check the people who have zeros and ensure that they didn't "just" get unlucky"
 102 d[d$num.calls == 0,]
 103
 104 ## set those people to 0 :(
 105 d[d$num.calls == 0]
 106 d$part.grade[d$num.calls == 0] <- 0
 107
 108 ## step 2: identify the people who were were not asked "enough" questions but were unlucky/lucky
 109 ## penalized.unique.names <- d$unique.name[d$num.calls < median(d$num.calls) & d$absences > median(d$absences)]
 110
 111 ## first these are the people were were not called simply because they got unlucky
 112 d[d$num.calls < questions.cutoff & d$absences < absence.threshold,]
 113
 114 ## first these are the people were were not called simply because they got unlucky
 115 penalized.unique.names <- d$unique.name[d$num.calls < questions.cutoff & d$absences > absence.threshold]
 116 d[d$unique.name %in% penalized.unique.names,]
 117
 118 ## now add "zeros" for every questions that is below the normal
 119 d[as.character(penalized.unique.names),"part.grade"] <- ((
 120     (questions.cutoff - d[as.character(penalized.unique.names),"num.calls"] * 0) +
 121     (d[as.character(penalized.unique.names),"num.calls"] * d[as.character(penalized.unique.names),"part.grade"]) )
 122     / questions.cutoff)
 123
 124 d[as.character(penalized.unique.names),]
 125
 126 ## TODO ensure this is right. i think it is
 127 ## map part grades back to 4.0 letter scale and points
 128 d$part.4point <- round((d$part.grade / (50/3.3)) - 2.6, 2)
 129
 130 d[sort.list(d$part.4point, decreasing=TRUE),
 131   c("unique.name", "short.name", "num.calls", "absences", "part.4point")]
 132
 133
 134 ## writing out data to CSV
 135 d.print <- merge(d, myuw[,c("StudentNo", "FirstName", "LastName", "UWNetID")],
 136                  by.x="unique.name", by.y="StudentNo")
 137 write.csv(d.print, file="../data/final_participation_grades.csv")
 138
 139 library(rmarkdown)
 140
 141 for (id in d$unique.name) {
 142     render(input="student_report_template.Rmd",
 143            output_format="html_document",
 144            output_file=paste("../data/case_grades/",
 145                              d.print$unique.name[d.print$unique.name == id],
 146                              sep=""))
 147 }