Create a gist now

Instantly share code, notes, and snippets.

@tts /server.R
Last active Dec 18, 2015

What would you like to do?
aalto.data.fi lecture data as a Shiny web app
##########################################################################################################
#
# 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
# 19.1.2015 Because the data is not updated any longer since early 2014 but the endpoint is still alive,
# changed the logic to show 5-15 days starting 2014-01-01
#
############################################################################################################
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>(2014) )
&& ( <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 <- SPARQL(url=endpoint, query=q)$results
# See 19.1.2015 comment above
td <- as.Date("2014-01-01")
# 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),
"5" = res[as.Date(sub("T", " ", substr(res$startDate, 1, 19))) <= td+5, ],
"10" = res[as.Date(sub("T", " ", substr(res$startDate, 1, 19))) <= td+10, ],
"15" = res[as.Date(sub("T", " ", substr(res$startDate, 1, 19))) <= td+15, ])
}) } 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 + ' From: ' + item.startsAt + ' To: ' + item.endsAt + ' 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()
}
)
})
#############################################################################################################
#
# 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
# 19.1.2015 Because the data is not updated any longer since early 2014 but the endpoint is still alive,
# changed the logic to show 5-15 days starting 2014-01-01
#
#############################################################################################################
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 = 5,
max = 15,
value = 5,
step = 5),
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")
)
))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment