Skip to content

Instantly share code, notes, and snippets.

@christophM
Last active December 10, 2015 09:08
Show Gist options
  • Save christophM/4412234 to your computer and use it in GitHub Desktop.
Save christophM/4412234 to your computer and use it in GitHub Desktop.
A drink tracker for your next party. This is a browser app using R and the new shiny package.
################################################################################
##
## Server-side script for the game
##
################################################################################
## required packages ###########################################################
## for convenient data.frame handling
library("plyr")
## for all of the plots
library("ggplot2")
## direct labels for the timeline
library("directlabels")
## some auxilary functions, mainly for plotting ################################
## read the history from disc
get_history <- function(filename, only_last = FALSE){
history_var<- load(filename)
history <- get(history_var)
history$Time <- as.numeric(history$Time)
if (only_last) {
return(history[nrow(history), ])
} else {
return(history)
}
}
## plot the timeline
plot_history <- function(filename){
history <- get_history(filename)
timeline <- history_to_timeline(history)
## build the graphic
p <- ggplot(timeline, aes(x = Time, y = count, group = Person, colour = Person)) +
geom_path() +
scale_x_continuous(limits = c(0, max(1, max(history$Time) * 1.2, na.rm = TRUE)))
print(direct.label(p, list("last.bumpup", cex = 1.6)))
}
## Function which plots the barplot (leaderboard)
plot_leaderboard <- function(filename){
history <- get_history(filename)
## turn history into count data
history_tab <- data.frame(sort(table(history$Person), decreasing = TRUE))
colnames(history_tab) <- "count"
## order counts, highest count should be on top
history_tab$Person <- factor(x = nrow(history_tab):1, labels = rownames(history_tab)[nrow(history_tab):1])
history_tab
## build graphic and print it
p <- ggplot(history_tab) +
geom_bar(aes(x = Person, y = count, fill = count), stat = "identity") +
scale_y_continuous(name = "Drinks counter") +
scale_x_discrete(name = "") +
theme(axis.text = element_text(size = 14)) +
coord_flip()
print(p)
}
## converts the history file to the data.frame needed to plot the timeline
history_to_timeline <- function(history){
history$Time <- as.numeric(history$Time)
## add count data to data.frame
history <- ddply(history, .(Person), function(x) {x$count <- 1:nrow(x); x})
## add starting point for everyone
history <- rbind(data.frame(Person = persons,
Time = rep(0, times = length(persons)),
count = rep(0, times = length(persons))
), history)
## add end point of counts for everyone
end_history <- ddply(history, .(Person), function(x) data.frame(count = max(x$count)))
end_history$Time <- max(history$Time, na.rm = TRUE)
## delete last entry, because duplicated entries causes duplicated direct labels
history <- history[-which(history$Time == max(history$Time)), ]
timeline <- rbind(history, end_history)
timeline
}
## Initialize the game #########################################################
## take time to give a unique filename
now <- gsub(" ", "_", Sys.time())
## build data.frame
history <- data.frame(Person = NA, Time = NA)
history <- data.frame(Person = character(0), Time = numeric(0))
history$Person <- factor(history$Person, levels = persons)
filename = paste("./drinks-history-", now, ".RData", sep = "")
save(history, file = filename)
## time when game was started
started_game_at <- as.numeric(Sys.time())
## Define server logic #########################################################
shinyServer(function(input, output) {
## function which changes if either the person was changed or the again button was pushed
## this function can be called in other reactive functions
## the result is, that the other functions are updated for every change in person / again-button push
## this is so ugly and I feel bad about it
something_happened <- reactive(function(){
c(input$person, input$again)
})
update <- function(){
something_happened()
update_history()
}
observe(update)
update_history <- function(){
if(input$person != "[choose person]"){
history <- get_history(filename)
time_passed <- Sys.time() - started_game_at
new_drinks <- c(input$person, time_passed)
## add new drinks
history[nrow(history) + 1, ] <- new_drinks
save(history, file = filename)
}
}
output$text <- reactiveText(function() {
something_happened()
text <- sample(x = c("Prost", "Cheers", "Salute", "Kanpai", "Gan Bei", "Salud", "Skal", "Serefe"),
size = 1)
history <- get_history(filename)
last <- history[nrow(history), "Person"]
if (any(last %in% persons)) {
paste(last, ", ", text, "!", sep = "")
} else ""
})
output$history <- reactiveTable(function(){
something_happened()
history <- get_history(filename)
if(nrow(history) > 0) {
history
} else {
NULL
}
})
## TIMELINE ##################################################################
output$timeline <- reactivePlot(function(){
something_happened()
plot_history(filename)
})
## LEADERBOARD ###############################################################
output$leaderboard <- reactivePlot(function(){
something_happened()
plot_leaderboard(filename)
})
## DEBUG OUTPUT ##############################################################
output$debug_timeline <- reactiveTable(function(){
something_happened()
history_to_timeline(get_history(filename))
})
output$debug_time <- reactiveText(function(){
something_happened()
history <- get_history(filename)
str(history)
})
})
################################################################################
##
## User Interface of the game
##
################################################################################
## add choose to persons, because when the game starts the first person in the list does not
## automatically drink
persons <- c("[choose person]", persons)
# Define UI for miles per gallon application
shinyUI(pageWithSidebar(
# Application title
headerPanel("Drink tracker"),
sidebarPanel(
selectInput("person", "", choices = persons),
br(),
actionButton("again", "Drink again!")
),
mainPanel(h3(textOutput("text")) ,
tabsetPanel(
tabPanel("Timeline", plotOutput("timeline")),
tabPanel("Leaderboard", plotOutput("leaderboard")),
tabPanel("Raw", tableOutput("history")),
tabPanel("Debug",
tableOutput("debug_timeline"),
textOutput("debug_time")
)
)
)
))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment