updated track participation code to see how we're doing

diff --git a/assessment_and_tracking/track_participation.R b/assessment_and_tracking/track_participation.R
index 28b8a4e8d03712fc0fe70ec586ef06ce620f1307..c2b1ef9c4f7aed9c67dfce60f554c4f6e8797817 100644 (file)
--- a/assessment_and_tracking/track_participation.R
+++ b/assessment_and_tracking/track_participation.R
@@ -1,25 +1,131 @@
 setwd("~/online_communities/coldcallbot/data/")
 
 setwd("~/online_communities/coldcallbot/data/")
 

-library(ggplot2)

 library(data.table)
 
 library(data.table)
 

-gs <- read.delim("student_information.tsv")
-d <- gs[,c(2,4)]
-colnames(d) <- c("student.num", "unique.name")
+################################################
+## LOAD call_list TSV data
+################################################

 
 call.list <- do.call("rbind", lapply(list.files(".", pattern="^call_list-.*tsv$"), function (x) {read.delim(x, stringsAsFactors=FALSE)[,1:4]}))
 
 colnames(call.list) <- gsub("_", ".", colnames(call.list))
 
 
 call.list <- do.call("rbind", lapply(list.files(".", pattern="^call_list-.*tsv$"), function (x) {read.delim(x, stringsAsFactors=FALSE)[,1:4]}))
 
 colnames(call.list) <- gsub("_", ".", colnames(call.list))
 

-table(call.list$unique_name[call.list$answered])
+table(call.list$unique.name[call.list$answered])

 
 ## drop calls where the person wasn't present
 call.list.full <- call.list
 call.list[!call.list$answered,]
 call.list <- call.list[call.list$answered,]
 
 
 ## drop calls where the person wasn't present
 call.list.full <- call.list
 call.list[!call.list$answered,]
 call.list <- call.list[call.list$answered,]
 

+## show the distribution of assessments
+prop.table(table(call.list$assessment))
+

 call.counts <- data.frame(table(call.list$unique.name))
 colnames(call.counts) <- c("unique.name", "num.calls")
 
 call.counts <- data.frame(table(call.list$unique.name))
 colnames(call.counts) <- c("unique.name", "num.calls")
 

-d <- merge(d, call.counts, all.x=TRUE, all.y=TRUE, by="unique.name"); d
+## create list of folks who are missing in class w/o reporting it
+absence.data.cols <- c("unique.name", "date.absent", "reported")
+
+missing.in.class <- call.list.full[!call.list.full$answered,
+                                   c("unique.name", "timestamp")]
+missing.in.class$date.absent <- as.Date(missing.in.class$timestamp)
+missing.in.class$reported <- FALSE
+missing.in.class <- missing.in.class[,absence.data.cols]
+missing.in.class <- unique(missing.in.class)
+
+################################################
+## LOAD absence data TSV data
+################################################
+
+absence.google <- read.delim("absence_poll_data.tsv")
+colnames(absence.google) <- c("timestamp", "unique.name", "date.absent")
+absence.google$date.absent <- as.Date(absence.google$date.absent, format="%m/%d/%Y")
+absence.google$reported <- TRUE
+absence.google <- absence.google[,absence.data.cols]
+absence.google <- unique(absence.google)
+
+## combine the two absence lists and then create a unique subset
+absence <- rbind(missing.in.class[,absence.data.cols],
+                 absence.google[,absence.data.cols])
+
+## these are people that show up in both lists (i.e., probably they
+## submitted too late but it's worth verifying before we penalize
+## them. i'd actually remove them from the absence sheet to suppress
+## this error
+absence[duplicated(absence[,1:2]),]
+absence <- absence[!duplicated(absence[,1:2]),]
+
+## print total questions asked and absences
+absence.count <- data.frame(table(unique(absence[,c("unique.name", "date.absent")])[,"unique.name"]))
+colnames(absence.count) <- c("unique.name", "absences")
+
+
+## load up the full class list
+gs <- read.delim("student_information.tsv")
+d <- gs[,c("Your.UW.student.number", "Name.you.d.like.to.go.by.in.class")]
+colnames(d) <- c("unique.name", "short.name")
+
+## merge in the call counts
+d <- merge(d, call.counts, all.x=TRUE, all.y=FALSE, by="unique.name")
+d <- merge(d, absence.count, by="unique.name", all.x=TRUE, all.y=FALSE)
+
+d
+
+## set anything that's missing to zero
+d$num.calls[is.na(d$num.calls)] <- 0
+d$absences[is.na(d$absences)] <- 0
+
+################################################
+## list people who have been absent often or called on a lot
+################################################
+
+
+## list students sorted in terms of (a) absences and (b) prev questions
+d[sort.list(d$absences),]
+
+d[sort.list(d$num.calls, decreasing=TRUE),]
+
+################################################
+## build visualizations
+################################################
+
+
+library(ggplot2)
+
+color.gradient <- scales::seq_gradient_pal("yellow", "magenta", "Lab")(seq(0,1,length.out=range(d$absences)[2]+1))
+
+table(d$num.calls, d$absences)
+
+ggplot(data=d) +
+    aes(x=as.factor(num.calls), y=absences) +
+    geom_violin()
+
+## png("questions_absence_histogram_combined.png", units="px", width=600, height=400)
+
+ggplot(d) +
+    aes(x=as.factor(num.calls), fill=as.factor(absences)) +
+    geom_bar(color="black") +
+    stat_count() +
+    scale_x_discrete("Number of questions asked") +
+    scale_y_continuous("Number of students") +
+    ##scale_fill_brewer("Absences", palette="Blues") +
+    scale_fill_manual("Absences", values=color.gradient) +
+    theme_bw()
+
+## dev.off()
+
+absence.labeller <- function (df) {
+    lapply(df, function (x) { paste("Absences:", x) })
+}
+
+## png("questions_absence_histogram_facets.png", units="px", width=600, height=400)
+
+ggplot(d) +
+    aes(x=as.factor(num.calls)) +
+    geom_bar() +
+    stat_count() +
+    scale_x_discrete("Number of questions asked as of 2020-02-12") +
+    scale_y_continuous("Number of students") +
+    theme_bw() +
+    facet_wrap(.~absences, ncol=5, labeller="absence.labeller")