A drink tracker for your next party. This is a browser app using R and the new shiny package.

server.R

################################################################################
##
## 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)
  })

  
})

ui.R

################################################################################
##
## 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")
                       )
              )
            )
))