library(shiny) library(jsonlite) # to handle the json file data correctly library(DT) # to render the data-tables correctely #library(webshot) # corrently not in use should work for the downloadbutton #library(knitr) # supposed to do Dynamic Report Generation in R library(leaflet) # to render the map --> instead of google #library(mapview) # not in use but could be used for map instead of leaflet #library(ggplot2) # not in use but for rendering plots library(timevis) # for rendering the fancy timeline #library(plotly) # not in use but for rendering plots library(Cairo) #creating the pdf for download library(grDevices) # also necessary for the download library(anytime) # for correctly parsing unixtimestamps into readable date and time formats library(shinydashboard) # creating the structure / dashboard structure-items library(gridExtra) server <- function(input, output, session) { set.seed(122) #Continue to data page observeEvent(input$dataSite, { updateTabItems(session, "tabs",selected = "data") }) #DATA PAGE #CoConUT Data import output$nut <- renderDataTable({ inFile <- input$nut if (is.null(inFile)) return(NULL) #loading CoConUT data json_data_coco <- fromJSON(paste(inFile$datapath, sep = ""), flatten = TRUE) coconut.df <<- json_data_coco[["data"]] lastCoConUT <<- inFile$name if(is.null(coconut.df$timestamp)){} else{unixTime<<-coconut.df$timestamp} if(is.null(coconut.df$gps.latitude)){} else{latitude<<-coconut.df$gps.latitude} if(is.null(coconut.df$gps.longitude)){} else{longitude<<-coconut.df$gps.longitude} if(is.null(coconut.df$gps.speed)){} else{speed<<-coconut.df$gps.speed} if(is.null(coconut.df$gps.accuracy)){} else{gpsAcc<<-coconut.df$gps.accuracy} if(is.null(coconut.df$light.lux)){} else{lux<<-coconut.df$light.lux} if(is.null(coconut.df$acc.coordinates)){} else{accCoord<<-coconut.df$acc.coordinates} if(is.null(coconut.df$acc.accuracy)){} else{accAcc<<-coconut.df$acc.accuracy} if(is.null(coconut.df$bluetooth.numOfBTDevices)){} else{bluetooth<<-coconut.df$bluetooth.numOfBTDevices} if(is.null(coconut.df$ble.bpm)){} else{bleBpm<<-coconut.df$ble.bpm} if(is.null(coconut.df$ble.bpmlist)){} else{bleBpmList<<-coconut.df$ble.bpmlist} if(is.null(coconut.df$ble.hrv)){} else{bleHrv<<-coconut.df$ble.hrv} if(is.null(coconut.df$ble.hrvlist)){} else{bleHrvList<<-coconut.df$ble.hrvlist} if(is.null(coconut.df$activity.name)){} else{activityName<<-coconut.df$activity.name} if(is.null(coconut.df$activity.confidence)){} else{activityConf<<-coconut.df$activity.confidence} if(is.null(coconut.df$screen.status)){} else{screenstatus<<-coconut.df$screen.status} if(is.null(coconut.df$interaction.touch)){} else{touch<<-coconut.df$interaction.touch} # setting the table style datatable( cbind(coconut.df), options = list( searching = TRUE, autoWidth = TRUE, rownames = FALSE, scroller = TRUE, scrollX = TRUE, scrollY = "500px", fixedHeader = TRUE, class = 'cell-border stripe' ) ) }) #last coconut_name output$lastLoadedNut<- renderText({ if (is.null(input$nut)) return(NULL) else lastCoConUT }) #CoCoQuest Data import output$quest <- renderDataTable({ inFile <- input$quest if (is.null(inFile)) return(NULL) #loading CoCoQuest data json_data_quest <<- fromJSON(paste(inFile$datapath, sep = ""), flatten = TRUE) lastCoCoQuest <<- inFile$name totalST <<- c(anytime(as.numeric(json_data_quest$startTime)/1000)) #unix parsed dat <- do.call(rbind, json_data_quest$tasks$data) endtimes <<- c(dat$endtime) parsedEndtimes <<- anytime(endtimes/1000) tasks <- rep(1:length(json_data_quest$tasks$data), sapply(json_data_quest$tasks$data, nrow)) together <<- c(tasks, endtimes) all <- rbind(together) #setting the table style datatable( cbind(tasks, endtimes), options = list( searching = FALSE, rownames = TRUE, class = 'cell-border stripe' ) ) }) #last cocoquest_name output$lastLoadedQuest <- renderText({ if (is.null(input$quest)) return(NULL) else lastCoCoQuest }) #cocoQuest Starttime output$totalStarttime <- renderText({ if (is.null(input$quest)) return(NULL) else { format(totalST, format="%d-%B-%Y %H:%M:%S") } }) #Continue to view page observeEvent(input$viewSite, { updateTabItems(session, "tabs",selected = "views") }) #View PAGE #Title Input output$title <- renderText({ input$title }) #Continue to dashboard page observeEvent(input$dashboardSite, { updateTabItems(session, "tabs",selected = "dashboard") }) #For counting the plots and giving axis and plots individual names plotCounter <<- 0 plotname <<- paste("plot", plotCounter, sep="") xplotname<<- paste("x",plotname,sep="") yplotname<<-paste("y",plotname, sep="") array_plots <<- list() #BARCHART box insert observeEvent(input$check_hist, { #Setting names plotname<<-paste("plot", plotCounter, sep="") plotCounter<<-plotCounter+1 xplotname<<- paste("x",plotname,sep="") yplotname<<-paste("y",plotname, sep="") array_plots <<- c(array_plots, plotname) #Inserting box & Chart insertUI( selector= "#viewpanel", #wo will ichs hinhaben ui= box( width = 12, title="Barchart", status= "warning", solidHeader = TRUE, collapsible = TRUE, selectInput(xplotname, "x-axis", choices=colnames(coconut.df)), selectInput(yplotname, "y-axis", choices=colnames(coconut.df)), plotOutput(plotname, height = 400)) ) local({ # data handling output[[plotname]] <- renderPlot({ #assign(paste("data", plotCounter,sep="_")) data<- structure(list(V1=as.numeric(coconut.df[[input[[xplotname]]]]), V2=as.numeric(coconut.df[[input[[yplotname]]]])), .Names=c("V1","V2"), row.names=c(NA,10L), class = "data.frame") # New Bar-Plot array_plots <<-arrangeGrob(array_plots, barplot(data$V2,data$V1, ylab=input[[yplotname]], xlab=input[[xplotname]], names.arg = data$V1 # NOTE: PLEASE COMMENT IN IF DATA SET WITH FEW DATA IS USED --> MAKES AXES BETTER READABLE #, #las=2 #axis.lty=1 )) }) }) #Local end }) #BARCHART text output$bar_explain <- renderText({ "Here you can add a barchart. A bar chart uses bars to show comparisons between categories of data. If you was trying to compare the height of something then intuitvely you would represent this by using columns. After clicking on the add button, a box with dropdownfields and a barchart will apear. Please set your wanted data for the x-and y-axis. Also be aware, that once you created another chart you won't be able to change the data of your previous charts." }) observeEvent(input$check_time, { insertUI( #Inserting box and Chart selector= "#viewpanel", #wo will ichs hinhaben ui= box( width = 12, title="Timeline", status= "warning", solidHeader = TRUE, collapsible = TRUE, timevisOutput("time", height = 250)) ) local({ output$time <- renderTimevis({ # data handling data <- data.frame( id = 1:length(parsedEndtimes), content= c(1:length(parsedEndtimes)), start = c(anytime(totalST), head(parsedEndtimes, -1)), end = parsedEndtimes ) #New Timeline timevis(data) #array_plots <<-arrangeGrob(array_plots,timevis(data)) }) }) }) # #TIMELINE insert box # output$time_box <- renderUI({ # if(input$check_time) # box( width = 12, # title="Timeline", # status= "warning", # solidHeader = TRUE, # collapsible = TRUE, # timevisOutput("time", height = 175) # ) # }) # # #TIMELINE view # output$time <- renderTimevis({ # data <- data.frame( # id = 1:length(parsedEndtimes), # content= c(1:length(parsedEndtimes)), # start = c(anytime(totalST), head(parsedEndtimes, -1)), # end = parsedEndtimes # ) # timevis(data) # # }) #TIMELINE text output$texttimeline <- renderText({ "Add Timeline for getting a Timeline about CoCoQuest Tasks and Questions.To see how long a the participant took for a certain task. Please note that the timeline is static, you can not show different types of data here. Also you can not add multiple charts here. " }) #LINECHART observeEvent(input$check_line, { #setting names plotname<<-paste("plot", plotCounter, sep="") plotCounter<<-plotCounter+1 xplotname<<- paste("x",plotname,sep="") yplotname<<-paste("y",plotname, sep="") #inserting box and chart insertUI( selector= "#viewpanel", #wo will ichs hinhaben ui= box( width = 12, title="Linechart", status= "warning", solidHeader = TRUE, collapsible = TRUE, selectInput(xplotname, "x-axis", choices=colnames(coconut.df)), selectInput(yplotname, "y-axis", choices=colnames(coconut.df)), plotOutput(plotname, height = 250)) ) local({ output[[plotname]] <- renderPlot({ #data handling data<- structure(list(V1=as.numeric(coconut.df[[input[[xplotname]]]]), V2=as.numeric(coconut.df[[input[[yplotname]]]])), .Names=c("V1","V2"), row.names=c(NA,10L), class = "data.frame") #new Linechart plot(data$V1,data$V2, type="l", ylab=input[[yplotname]], xlab=input[[xplotname]]) }) }) #Local end }) #LINECHART text output$line_explain <- renderText({ "Here you can add a linechart. After clicking on the add button, a box with dropdownfields and a linechart will apear. Please set your wanted data for the x-and y-axis. Also be aware, that once you created another chart you won't be able to change the data of your previous charts." }) #SCATTERPLOT observeEvent(input$check_scat, { #Setting names plotname<<-paste("plot", plotCounter, sep="") plotCounter<<-plotCounter+1 xplotname<<- paste("x",plotname,sep="") yplotname<<-paste("y",plotname, sep="") # Inserting Box and Plot insertUI( selector= "#viewpanel", #wo will ichs hinhaben ui= box( width = 12, title="Scatterplot", status= "warning", solidHeader = TRUE, collapsible = TRUE, selectInput(xplotname, "x-axis", choices=colnames(coconut.df)), selectInput(yplotname, "y-axis", choices=colnames(coconut.df)), plotOutput(plotname, height = 250)) ) local({ output[[plotname]] <- renderPlot({ #data handling data<- structure(list(V1=as.numeric(coconut.df[[input[[xplotname]]]]), V2=as.numeric(coconut.df[[input[[yplotname]]]])), .Names=c("V1","V2"), row.names=c(NA,10L), class = "data.frame") #new scatterplot plot(data$V1,data$V2, type="p", ylab=input[[yplotname]], xlab=input[[xplotname]]) }) }) #Local end }) #SCATTERPLOT text output$scat_explain <- renderText({ "Here you can add a scatterplot. After clicking on the add button, a box with dropdownfields and a scatterolot will apear. Please set your wanted data for the x-and y-axis. Also be aware, that once you created another chart you won't be able to change the data of your previous charts." }) #BOXPLOT observeEvent(input$check_box, { #Setting names plotname<<-paste("plot", plotCounter, sep="") plotCounter<<-plotCounter+1 xplotname<<- paste("x",plotname,sep="") yplotname<<-paste("y",plotname, sep="") #Inserting Box and plot insertUI( selector= "#viewpanel", #wo will ichs hinhaben ui= box( width = 12, title="Boxplot", status= "warning", solidHeader = TRUE, collapsible = TRUE, selectInput(xplotname, "data", choices=colnames(coconut.df)), plotOutput(plotname, height = 250)) ) local({ output[[plotname]] <- renderPlot({ #handling data data<- structure(list(V1=as.numeric(coconut.df[[input[[xplotname]]]])), .Names=c("V1"), row.names=c(NA,10L), class = "data.frame") #new Boxplot boxplot(data$V1, type="box", xlab=input[[xplotname]]) }) }) #Local end }) #BOXPLOT text output$box_explain <- renderText({ "Here you can add a boxplot. After clicking on the add button, a box with a dropdownfield and a boxplot will apear. Please set your wanted data for the data. Also be aware, that once you created another chart you won't be able to change the data of your previous charts." }) #MAP observeEvent(input$check_map, { #Setting names plotname<<-paste("plot", plotCounter, sep="") plotCounter<<-plotCounter+1 xplotname<<- paste("x",plotname,sep="") yplotname<<-paste("y",plotname, sep="") #Inserting box and plot insertUI( selector= "#viewpanel", #wo will ichs hinhaben ui= box( width = 12, title="Map", status= "warning", solidHeader = TRUE, collapsible = TRUE, selectInput(xplotname, "data", choices=colnames(coconut.df)), leafletOutput(plotname, height = 250)) ) local({ output[[plotname]] <- renderLeaflet({ #handling data data <- as.numeric(coconut.df[[input[[xplotname]]]]) #getting max for normation max_data<<- max(data) c<-1 #norming data for(c in 1:length(data)){ data[c]<-(data[c]/max_data)*10 } #encoding data colorData <- cut( data, c(0, 2, 5, 7, 10), include.lowest = T, lables = c('<2', '<5', '<7', '<10') ) #color encoding data colorGrad <- colorFactor('RdYlGn', colorData) #new map m <<- leaflet() x=1 m <<- addTiles(m) m<<-addCircleMarkers(m,lng=as.numeric(coconut.df$gps.longitude), lat=as.numeric(coconut.df$gps.latitude), radius = data, color = colorGrad(colorData)) #addPolylines does not work m<<-addLegend(m, 'bottomright', pal=colorGrad, values=colorData, title=' ',opacity=1) m }) }) #Local end }) #MAP text output$map_explain <- renderText({ "Here you can add a map. After clicking on the add button, a box with dropdownfield and a map will apear. Please set your wanted data. The map will show the way the participant went, also the data you selected is going to be normalized (highest value=10).Also be aware, that once you created another chart you won't be able to change the data of your previous charts." }) #TODO: TOOLTIP data_tooltip <- function(x){ if(is.null(x)) return(NULL) if(is.null(x$ID)) return(NULL) paste0(coconut.df[[input$line_x]]) } #TODO: DownloadButton output$down.pdf <- downloadHandler( print("DOWNLOAD"), #print(V1) filename = "download.pdf", content = function(file) { CairoPDF(file = file, width=12, height=8) #boxplot(data$V1, type="box", xlab=input$box_x) #m #leafletOutput("map", height = 250) # output[[plotname]] <- renderPlot({ # # #handling data # data<- structure(list(V1=as.numeric(coconut.df[[input[[xplotname]]]])), # .Names=c("V1"), row.names=c(NA,10L), class = "data.frame") # print(data) # #new Boxplot # boxplot(data$V1, type="box", xlab=input[[xplotname]]) # # }) data<- structure(list(V1=as.numeric(coconut.df[[input[[xplotname]]]])), .Names=c("V1"), row.names=c(NA,10L), class = "data.frame") boxplot(data$V1, type="box", xlab=input[[xplotname]]) #print(array_plots) dev.off() } ) }