Last active
December 18, 2015 20:29
-
-
Save tts/5840990 to your computer and use it in GitHub Desktop.
aalto.data.fi lecture data as a Shiny web app
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
########################################################################################################## | |
# | |
# 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() | |
} | |
) | |
}) |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
############################################################################################################# | |
# | |
# 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