server.R

##########################################################################################################
#
# Tuija Sonkkila
#
# An interactive R Shiny web application
# on Aalto University lecture data 
# from data.aalto.fi
#
# http://linkedscience.org/2013/07/09/an-interactive-r-shiny-application-on-data-aalto-fi-lectures/
#
# 22.6.2013
# 29.6.2013 Added some basic error handling
#  1.7.2013 There are some issues with polycharts,
#           see https://github.com/ramnathv/rCharts/issues/144
# 10.7.2013 Corrected the download procedure
# 29.9.2013 From all lectures, exclude those where the day is already behind. 
#           Otherwise, the lectures of next month were only shown if their day was bigger than today's date.
#           Date handling is on a very basic level in this exercise.
# 30.9.2013 Changed the min input range from 40 to 20
#
############################################################################################################

library(shiny)
library(SPARQL)
library(rCharts)

endpoint <- "http://data.aalto.fi/sparql"

q <- "SELECT DISTINCT ?startDate ?endDate ?Room ?Title ?SchoolCode

WHERE
{ GRAPH <http://data.aalto.fi/id/courses/noppa/> {
?course <http://linkedscience.org/teach/ns#arrangedAt> ?lecture ;
<http://linkedscience.org/teach/ns#courseTitle> ?title .
FILTER ( (lang(?title) = 'fi') || (lang(?title) = 'en') )
BIND (str(?title) AS ?Title)

?lecture <http://linkedscience.org/teach/ns#room> ?Room ;
<http://www.w3.org/2002/12/cal/icaltzd#dtstart> ?startTime ;
<http://www.w3.org/2002/12/cal/icaltzd#dtend> ?endTime .
BIND (str(?endTime) AS ?endDate)
BIND (str(?startTime) AS ?startDate)

?dept <http://purl.org/vocab/aiiso/schema#teaches> ?course;
<http://purl.org/vocab/aiiso/schema#part_of> ?school .

?school <http://purl.org/vocab/aiiso/schema#organization> ?dept ;
<http://purl.org/vocab/aiiso/schema#code> ?SchoolCode .

BIND (substr(str(?startTime),1,4) AS ?Year)
BIND (substr(str(?startTime),6,2) AS ?Month)
BIND (substr(str(?startTime), 9, 2) AS ?Day)

BIND (now() AS ?currentTime)
BIND (year(?currentTime) AS ?yearNow)
BIND (month(?currentTime) AS ?monthNow)
BIND (day(?currentTime) AS ?dayNow)

FILTER (
( <http://www.w3.org/2001/XMLSchema#integer>(?Year) = <http://www.w3.org/2001/XMLSchema#integer>(?yearNow) )
&& ( <http://www.w3.org/2001/XMLSchema#integer>(?Month) >= <http://www.w3.org/2001/XMLSchema#integer>(?monthNow)  )
&& (
( <http://www.w3.org/2001/XMLSchema#integer>(?Day) <= <http://www.w3.org/2001/XMLSchema#integer>(?dayNow) )
|| ( <http://www.w3.org/2001/XMLSchema#integer>(?Day) >= <http://www.w3.org/2001/XMLSchema#integer>(?dayNow) )
)
)}}"

res_all <- SPARQL(url=endpoint, query=q)$results

td <- Sys.Date()

# EDIT 29.9.2013 Exclude days that are already behind
res <- res_all[!as.Date(sub("T", " ", substr(res_all$startDate, 1, 19))) < td, ]

if ( nrow(res) > 0 ) {
  
  isData <- TRUE
  
  res$SchoolCode <- sub("TaiK", "ARTS", res$SchoolCode)
  res$SchoolCode <- sub("ECON", "BIZ", res$SchoolCode)
  res$SchoolCode <- sub("ERI", "OU", res$SchoolCode)
  
  res$Title <- iconv(res$Title, "UTF-8", "ISO-8859-1")
  res$Room <- iconv(res$Room, "UTF-8", "ISO-8859-1")
  
  res <- res[order(res$startDate, res$SchoolCode, res$Title), ]
}


shinyServer(function(input, output) {
  
  if ( isData ) {
  
   sliderValues <- reactive({
     
     switch(as.character(input$days),
            "20" = res[as.Date(sub("T", " ", substr(res$startDate, 1, 19))) <= td+20, ],
            "30" = res[as.Date(sub("T", " ", substr(res$startDate, 1, 19))) <= td+30, ],
            "40" = res[as.Date(sub("T", " ", substr(res$startDate, 1, 19))) <= td+40, ],
            "50" = res[as.Date(sub("T", " ", substr(res$startDate, 1, 19))) <= td+50, ],
            "60" = res[as.Date(sub("T", " ", substr(res$startDate, 1, 19))) <= td+60, ])
     
   }) } else {
     
    return(NULL)
    
   }

  

  output$table <- renderTable({
 
      sliderValues()
    
  }, include.rownames = FALSE) 

  
  
  output$chart <- renderChart ({
    
    # Make a copy so that we can add new columns
    sv <- sliderValues()
    
    # Tidy the date data
    sv$startDate <- sub("T", " ", substr(sv$startDate, 1, 19))
    sv$endDate <- sub("T", " ", substr(sv$endDate, 1, 19))
    
    # X axis
    # https://github.com/ramnathv/rCharts/issues/77       
    sv$Day <- as.character(as.Date(sv$startDate))
    
    # Y axis
    sv$startsAt <- format(as.POSIXct(sv$startDate), format="%H:%M")
    
    # For the tooltip
    sv$endsAt <- format(as.POSIXct(sv$endDate), format="%H:%M")

    # http://stackoverflow.com/questions/13669611/converting-three-columns-to-unix-time-r
    # Unix time so as to get min and max dates right
    mindate <- as.double(as.POSIXct(as.Date(sv$startDate[1])))
    maxdate <- as.double(as.POSIXct(as.Date(sv$startDate[nrow(sv)])))      
    nrofdays <- length(unique(sv$Day))
    
    # https://github.com/rcharts/nytinteractive/blob/gh-pages/app/server.R
    # Note: no line breaks and max 3(4?) lines
    mytooltip <- "function(item){return item.Title + '\n' + 'From: ' + item.startsAt + ' To: ' + item.endsAt + '\n' + 'In: ' + item.Room}"
    
    p1 <- rPlot(startsAt ~ Day, data = sv, type = 'point', tooltip = mytooltip)
    
    p1$set(title = 'Starting times of lectures', 
           dom = 'chart')
    
    # Pass info about the X axis
    p1$guides(
      x = list(
        min = mindate, 
        max = maxdate,
        numticks = nrofdays
      )
    )
  

    return(p1)
    
  })

  
  # EDIT 10.7. Need to preserve startDate and endDate for the iCal
  currentSelectionFull <- function() {

      switch(input$school,
           "All"  = sliderValues() ,
           "ARTS" = sliderValues()[sliderValues()$SchoolCode == 'ARTS', ],
           "BIZ"  = sliderValues()[sliderValues()$SchoolCode == 'BIZ', ],
           "CHEM" = sliderValues()[sliderValues()$SchoolCode == 'CHEM', ],
           "ELEC" = sliderValues()[sliderValues()$SchoolCode == 'ELEC', ],
           "ENG"  = sliderValues()[sliderValues()$SchoolCode == 'ENG', ],
           "SCI"  = sliderValues()[sliderValues()$SchoolCode == 'SCI', ],
           "Open University (OU)" = sliderValues()[sliderValues()$SchoolCode == 'OU', ])

  }



  currentSelection <- function() {
    
    drops <- c("startDate", "endDate", "Room")
    
    switch(input$school,
           "All"  = sliderValues()[ ,!(names(sliderValues()) %in% drops)] ,
           "ARTS" = sliderValues()[sliderValues()$SchoolCode == 'ARTS', !(names(sliderValues()) %in% drops)],
           "BIZ"  = sliderValues()[sliderValues()$SchoolCode == 'BIZ', !(names(sliderValues()) %in% drops)],
           "CHEM" = sliderValues()[sliderValues()$SchoolCode == 'CHEM', !(names(sliderValues()) %in% drops)],
           "ELEC" = sliderValues()[sliderValues()$SchoolCode == 'ELEC', !(names(sliderValues()) %in% drops)],
           "ENG"  = sliderValues()[sliderValues()$SchoolCode == 'ENG', !(names(sliderValues()) %in% drops)],
           "SCI"  = sliderValues()[sliderValues()$SchoolCode == 'SCI', !(names(sliderValues()) %in% drops)],
           "Open University (OU)" = sliderValues()[sliderValues()$SchoolCode == 'OU', !(names(sliderValues()) %in% drops)])     
    
  }
  

  output$subset <- renderTable({
    
    currentSelection()
    
  }, include.rownames = FALSE)
  
  

  output$downloadData <- downloadHandler(
    filename = "lectures.ics",
    content = function(file) {
      sink(file) 
      cat("BEGIN:VCALENDAR\n")
      cat("VERSION:2.0\n")
      cat("PRODID:-//ts.fi/iCal/EN\n")
      cat("X-WR-CALNAME:AaltoLectures\n")
      cat("X-WR-CALDESC:Selection of lectures from data.aalto.fi via an R shiny demo application\n")
      cat("BEGIN:VTIMEZONE\n")
      cat("TZID:Europe/Helsinki\n")
      cat("BEGIN:STANDARD\n")
      cat("DTSTART:19811001T040000\n")
      cat("RRULE:FREQ=YEARLY;BYDAY=-1SU;BYMONTH=10\n")
      cat("TZNAME:Europe/Helsinki\n")
      cat("TZOFFSETFROM:+0300\n")
      cat("TZOFFSETTO:+0200\n")
      cat("END:STANDARD\n")
      cat("BEGIN:DAYLIGHT\n")
      cat("DTSTART:19810301T030000\n")
      cat("RRULE:FREQ=YEARLY;BYDAY=-1SU;BYMONTH=3\n")
      cat("TZNAME:Europe/Helsinki\n")
      cat("TZOFFSETFROM:+0200\n")
      cat("TZOFFSETTO:+0300\n")
      cat("END:DAYLIGHT\n")
      cat("END:VTIMEZONE\n")      
      for (i in 1:nrow(currentSelectionFull())) {
        cat("BEGIN:VEVENT\n")
        cat(paste("SUMMARY:", currentSelectionFull()$Title[i], " (" , currentSelectionFull()$SchoolCode[i], ") ", currentSelectionFull()$Room[i], "\n", sep=""))
        cat("DTSTAMP:20130530T180000Z\n")
        cat(paste("DTSTART;TZID=Europe/Helsinki:", paste(sub(':','',gsub('-','', substr(currentSelectionFull()$startDate[i], 1, 16))), '00Z', sep="")), "\n", sep="")
        cat(paste("DTEND;TZID=Europe/Helsinki:", paste(sub(':','',gsub('-', '', substr(currentSelectionFull()$endDate[i], 1, 16))), '00Z', sep="")), "\n", sep="")
        cat("END:VEVENT\n")
      }
      cat("END:VCALENDAR")
      sink()
    }
  ) 
  
  
}) 

ui.R

##############################################
#
# Tuija Sonkkila
# 22.6.2013
#
#
# An interactive R Shiny web application
# on Aalto University lecture data 
# from data.aalto.fi
#
# 30.9.2013 Changed the min input value range to 20,
#           the default (40) returned too much data
#
######################################################


library(shiny)
library(SPARQL)
library(rCharts)

shinyUI(pageWithSidebar(
  
  headerPanel("Lectures via data.aalto.fi"),
  
  sidebarPanel(
    
    
    sliderInput(inputId = "days", 
                label = "Number of days to show:",
                min = 20, 
                max = 60, 
                value = 20,
                step = 10),
    
    br(),
    
    selectInput("school", "Filter by school:", 
                choices = c("All",
                            "ARTS", 
                            "BIZ",
                            "CHEM", 
                            "ELEC",
                            "ENG",
                            "SCI",
                            "Open University (OU)")),
    
    br(),
    
    tableOutput("subset"),
    
    br(),
    
    downloadButton('downloadData', 'Download as iCal')
    
    
  ),
  
  mainPanel(
    
    showOutput("chart", "polycharts"),
    
    br(),
    
    tableOutput("table")
    
    
  )
  
))