Skip to content

Instantly share code, notes, and snippets.

@thoughtfulbloke
Created October 6, 2017 08:59
Show Gist options
  • Save thoughtfulbloke/da85e2946939ecf654b3ff8547c652e5 to your computer and use it in GitHub Desktop.
Save thoughtfulbloke/da85e2946939ecf654b3ff8547c652e5 to your computer and use it in GitHub Desktop.
library(lubridate)
library(dplyr)
library(ggplot2)
#some example data
set.seed(20180101)
example_data <- data.frame(
dt = sample(seq.Date(from=as.Date("2018-01-01"), to=as.Date("2018-12-31"), by="day"), size=400, replace=TRUE),
ampm = sample(c("AM","PM"), size=400, replace=TRUE),
tutor = sample(c("alpha","beta", "gamma"), size=400, replace=TRUE),
course = sample(LETTERS, size=400, replace=TRUE)
) %>% arrange(dt,ampm) %>% group_by(dt,ampm) %>% slice(1:2) %>% mutate(inRoom=1:n()) %>%
ungroup()
###########
# Processing- day of week and week of year
#
enhanced_data <- example_data %>%
mutate(woy = ceiling(yday(dt)/7), #week the day is in
dow = wday(dt), #day of week
woy = ifelse(dow == 1, woy + 1, woy), #shift the sunday to the next week to match dow
horiz = 2 * ifelse(ampm == "AM",dow, dow + 0.5) - 1)
##########
# Example of
# Visualisation checking for people teaching same thing at same time,
# showing places sessions can be shifted to
check_tutor <- "beta"
enhanced_data %>% group_by(dt, ampm, tutor, horiz, woy) %>%
summarise(tcount = sum(tutor == check_tutor), slot_total = n()) %>%
mutate(class_distribution = "available",
class_distribution = ifelse(tcount == 2, "doubleup", class_distribution),
class_distribution = ifelse(tcount == 1, "not available", class_distribution),
class_distribution = ifelse(slot_total == 2 & tcount == 0, "not available", class_distribution)) %>%
filter(class_distribution != "available") %>%
ggplot(aes(x=horiz, y=woy, shape=class_distribution, colour=class_distribution)) +
geom_point() + xlab("Day of Week") + ylab("Week of year") +
scale_x_continuous(breaks=1:14,
labels=c("Su\nAM", "Su\nPM", "Mo\nAM", "Mo\nPM", "Tu\nAM", "Tu\nPM", "Wd\nAM",
"Wd\nPM", "Th\nAM", "Th\nPM", "Fr\nAM", "Fr\nPM", "St\nAM", "St\nPM"))
##########
# Example of
# When a particular course is running,
# When a tutor is teaching
# and Available slots for rearranging
check_tutor <- "alpha"
check_class <- "H"
enhanced_data %>%
mutate(isTutor = as.numeric(tutor == check_tutor),
isClass = as.numeric(course == check_class)) %>%
group_by(dt, ampm) %>%
mutate(bysession = n(), isTutor = max(isTutor),
isClass = max(isClass)) %>% ungroup() %>%
filter(!(bysession == 1 & isTutor == 0 & isClass == 0)) %>%
mutate(TutorIs = ifelse(isTutor == 1, "Same Tutor", "other Tutor"),
ClassIs = ifelse(isClass == 1, "Same Class", "other Class"),
TutorIs = ifelse(isTutor == 0 & bysession==2, "No Space", TutorIs),
ClassIs = ifelse(isClass == 0 & bysession==2, "No Space", ClassIs)) %>%
ggplot(aes(x=horiz, y=woy, colour=ClassIs, shape=TutorIs)) +
geom_point() + xlab("Day of Week") + ylab("Week of year") +
scale_x_continuous(breaks=1:14,
labels=c("Su\nAM", "Su\nPM", "Mo\nAM", "Mo\nPM", "Tu\nAM", "Tu\nPM", "Wd\nAM",
"Wd\nPM", "Th\nAM", "Th\nPM", "Fr\nAM", "Fr\nPM", "St\nAM", "St\nPM"))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment