assessment_and_tracking/compute_final_case_grades.R

   1 ## load in the data
   2 #################################
   3
   4 case.sessions  <- 15
   5 myuw <- read.csv("myuw-COM_482_A_autumn_2020_students.csv", stringsAsFactors=FALSE)
   6
   7 ## class-level variables
   8 question.grades <- c("GOOD"=100, "FAIR"=100-(50/3.3), "BAD"=100-(50/(3.3)*2))
   9 missed.question.penalty <- (50/3.3) * 0.2 ## 1/5 of a full point on the GPA scale
  10
  11 source("../assessment_and_tracking/track_participation.R")
  12 setwd("case_grades")
  13
  14 rownames(d) <- d$discord.name
  15
  16 ## show the distribution of assessments
  17 table(call.list.full$assessment)
  18 prop.table(table(call.list.full$assessment))
  19 table(call.list.full$answered)
  20 prop.table(table(call.list.full$answered))
  21
  22 total.questions.asked <- nrow(call.list.full)
  23
  24 ## create new column with number of questions present
  25 d$prop.asked <- d$num.calls / d$num.present
  26
  27 ## generate statistics using these new variables
  28 prop.asks.quantiles <- quantile(d$prop.asked, probs=seq(0,1, 0.01))
  29 prop.asks.quantiles <- prop.asks.quantiles[!duplicated(prop.asks.quantiles)]
  30
  31 ## this is generating broken stuff but it's not used for anything
  32 d$prop.asked.quant <- cut(d$prop.asked, breaks=prop.asks.quantiles,
  33     labels=names(prop.asks.quantiles)[1:(length(prop.asks.quantiles)-1)])
  34
  35 ## generate grades
  36 ##########################################################
  37
  38 d$part.grade <- NA
  39
  40 ## print the median number of questions for (a) everybody and (b)
  41 ## people that have been present 75% of the time
  42 median(d$num.calls[d$days.absent < 0.25*case.sessions])
  43 median(d$num.calls)
  44
  45 questions.cutoff <- median(d$num.calls)
  46
  47 ## helper function to generate average grade minus number of missing
  48 gen.part.grade <- function (x.discord.name) {
  49     q.scores <- question.grades[call.list$assessment[call.list$discord.name == x.discord.name]]
  50     base.score <- mean(q.scores, na.rm=TRUE)
  51
  52     ## number of missing days
  53     missing.days <- nrow(missing.in.class[missing.in.class$discord.name == x.discord.name,])
  54
  55     ## return the final score
  56     data.frame(discord.name=x.discord.name,
  57                part.grade=(base.score - missing.days * missed.question.penalty))
  58 }
  59
  60 tmp <- do.call("rbind", lapply(d$discord.name[d$num.calls >= questions.cutoff], gen.part.grade))
  61
  62 d[as.character(tmp$discord.name), "part.grade"] <- tmp$part.grade
  63
  64 ## next handle the folks *under* the median
  65
  66 ## first we handle the zeros
  67 ## step 1: first double check the people who have zeros and ensure that they didn't "just" get unlucky"
  68 d[d$num.calls == 0,]
  69
  70 ## set those people to 0 :(
  71 d$part.grade[d$num.calls == 0] <- 0
  72
  73 ## step 2 is to handle folks who got unlucky in the normal way
  74 tmp <- do.call("rbind", lapply(d$discord.name[is.na(d$part.grade) & d$prop.asked <= median(d$prop.asked)], gen.part.grade))
  75 d[as.character(tmp$discord.name), "part.grade"] <- tmp$part.grade
  76
  77 ## the people who are left are lucky and still undercounted so we'll penalize them
  78 d[is.na(d$part.grade),]
  79 penalized.discord.names <- d$discord.name[is.na(d$part.grade)]
  80
  81 ## generate the baseline participation grades as per the process above
  82 tmp <- do.call("rbind", lapply(penalized.discord.names, gen.part.grade))
  83 d[as.character(tmp$discord.name), "part.grade"] <- tmp$part.grade
  84
  85 ## now add "zeros" for every questions that is below the normal
  86 d[as.character(penalized.discord.names),"part.grade"] <- ((
  87     (questions.cutoff - d[as.character(penalized.discord.names),"num.calls"] * 0) +
  88     (d[as.character(penalized.discord.names),"num.calls"] * d[as.character(penalized.discord.names),"part.grade"]) )
  89     / questions.cutoff)
  90
  91 d[as.character(penalized.discord.names),]
  92
  93 ## map part grades back to 4.0 letter scale and points
  94 d$part.4point <-round((d$part.grade / (50/3.3)) - 2.6, 2)
  95
  96 d[sort.list(d$prop.asked), c("discord.name", "num.calls", "num.present",
  97                              "prop.asked", "prop.asked.quant", "part.grade", "part.4point",
  98                              "days.absent")]
  99
 100 d[sort.list(d$part.4point), c("discord.name", "num.calls", "num.present",
 101                              "prop.asked", "prop.asked.quant", "part.grade", "part.4point",
 102                              "days.absent")]
 103
 104
 105 ## writing out data
 106 quantile(d$num.calls, probs=(0:100*0.01))
 107 d.print <- merge(d, myuw[,c("StudentNo", "FirstName", "LastName", "UWNetID")],
 108            by.x="student.num", by.y="StudentNo")
 109 write.csv(d.print, file="final_participation_grades.csv")
 110
 111 library(rmarkdown)
 112
 113 for (x.discord.name in d$discord.name) {
 114     render(input="../../assessment_and_tracking/student_report_template.Rmd",
 115            output_format="html_document",
 116            output_file=paste("../data/case_grades/student_reports/",
 117                              d.print$UWNetID[d.print$discord.name == x.discord.name],
 118                              sep=""))
 119 }