fix an ordering bug with grade creation

diff --git a/assessment_and_tracking/compute_final_case_grades.R b/assessment_and_tracking/compute_final_case_grades.R
index 22dae474d3429f83e57c6d10bcc3664edbf8fd11..1c25538b3c0af662f764c1787ea405dc3e36d8d7 100644 (file)
--- a/assessment_and_tracking/compute_final_case_grades.R
+++ b/assessment_and_tracking/compute_final_case_grades.R
@@ -10,21 +10,20 @@ rownames(d) <- d$unique.name
 call.list$timestamp <- as.Date(call.list$timestamp)
 
 ## class-level variables
 call.list$timestamp <- as.Date(call.list$timestamp)
 
 ## class-level variables

-question.grades <- c("PLUS"=100, "CHECK"=100-(50/3.3), "MINUS"=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")
 
 ## inspect set the absence threashold
 ggplot(d) + aes(x=absences) + geom_histogram(binwidth=1, fill="white",color="black")

-## absence.threshold <- median(d$absences)
-absence.threshold <- 4 ## TODO talk about this
+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
 
 ## 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

-## first these are the people were were not called simply because they got unlucky
-
- ## this is the 95% percentile based on simulation in simulation.R
+## this is the 95% percentile based on simulation in simulation.R

 questions.cutoff <- 4
 
 ## show the distribution of assessments
 questions.cutoff <- 4
 
 ## show the distribution of assessments


@@ -36,8 +35,11 @@ prop.table(table(call.list.full$answered))
 
 total.questions.asked <- nrow(call.list)
 
 
 total.questions.asked <- nrow(call.list)
 

-## find out how man questions folks have present/absent for
-##########################################################
+## 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)))
 
 calls.per.day <- data.frame(day=as.Date(names(table(call.list$timestamp))),
                             questions.asked=as.numeric(table(call.list$timestamp)))
 


@@ -67,7 +69,7 @@ d$prop.asked.quant <- cut(d$prop.asked, right=FALSE, breaks=c(prop.asks.quantile
     labels=names(prop.asks.quantiles)[1:(length(prop.asks.quantiles))])
 
 ## generate grades
     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
 
 ## print the median number of questions for (a) everybody and (b)
 ## people that have been present 75% of the time


@@ -92,45 +94,44 @@ gen.part.grade <- function (x.unique.name) {
 tmp <- do.call("rbind", lapply(d$unique.name, gen.part.grade))
 d <- merge(d, tmp)
 rownames(d) <- d$unique.name
 tmp <- do.call("rbind", lapply(d$unique.name, gen.part.grade))
 d <- merge(d, tmp)
 rownames(d) <- d$unique.name

-
-## apply the penality for number of days we called on them and they were gone
-d$part.grade <- d$base.grade - d$missing.in.class.days * missed.question.penalty
-d$part.grade.orig <- d$part.grade
+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 :(
 
 ## 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[d$num.calls == 0]

 d$part.grade[d$num.calls == 0] <- 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
-## penalized.unique.names <- d$unique.name[d$num.calls < median(d$num.calls) & d$absences > median(d$absences)]
+## step 2: identify the people who were were not asked "enough"
+## questions but were unlucky/lucky

 
 

-## first these are the people were were not called simply because they got unlucky
+## 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,]
 
 d[d$num.calls < questions.cutoff & d$absences < absence.threshold,]
 

-## first these are the people were were not called simply because they got unlucky
+## 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
 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"] <- ((
-    (questions.cutoff - d[as.character(penalized.unique.names),"num.calls"] * 0) +
-    (d[as.character(penalized.unique.names),"num.calls"] * d[as.character(penalized.unique.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.unique.names),]
 
     / 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
 ## 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 / (50/3.3)) - 2.6, 2)
+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")]
 
 
 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")
 ## writing out data to CSV
 d.print <- merge(d, myuw[,c("StudentNo", "FirstName", "LastName", "UWNetID")],
                  by.x="unique.name", by.y="StudentNo")


@@ -145,3 +146,4 @@ for (id in d$unique.name) {
                              d.print$unique.name[d.print$unique.name == id],
                              sep=""))
 }
                              d.print$unique.name[d.print$unique.name == id],
                              sep=""))
 }

+k