130 lines
4.4 KiB
R
130 lines
4.4 KiB
R
setwd("data/")
|
|
|
|
library(data.table)
|
|
|
|
################################################
|
|
## 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:5]}))
|
|
|
|
colnames(call.list) <- gsub("_", ".", colnames(call.list))
|
|
colnames(call.list)[1] <- "unique.name"
|
|
colnames(call.list)[2] <- "preferred.name"
|
|
|
|
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,]
|
|
|
|
## 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")
|
|
|
|
## 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 <- rep(FALSE, nrow(missing.in.class))
|
|
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("optout_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)
|
|
|
|
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 answered") +
|
|
scale_y_continuous("Number of students") +
|
|
##scale_fill_brewer("Absences", palette="Blues") +
|
|
scale_fill_manual("Opt-outs", 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 answered") +
|
|
## scale_y_continuous("Number of students") +
|
|
## theme_bw() +
|
|
## facet_wrap(.~absences, ncol=5, labeller="absence.labeller")
|
|
|