server.R 17.3 KB
Newer Older
Stephanie's avatar
Stephanie committed
1 2

library(shiny)
3 4 5 6 7 8 9 10 11 12 13 14 15
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
16 17
library(gridExtra)

18

19
server <- function(input, output, session) {
Stephanie's avatar
Stephanie committed
20
  set.seed(122)
21
  
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
22 23
  
  #Continue to data page  
24 25 26
  observeEvent(input$dataSite, {
    
    updateTabItems(session, "tabs",selected = "data")
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
27
    
28
  })
29
  
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
30
  #DATA PAGE
31
  #CoConUT Data import 
32 33
  output$nut <- renderDataTable({
    inFile <- input$nut
34 35
    if (is.null(inFile))
      return(NULL)
36
    
37
    #loading CoConUT data
38
    json_data_coco <- fromJSON(paste(inFile$datapath, sep = ""), flatten = TRUE)
39
    coconut.df <<- json_data_coco[["data"]]
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
40
    
41
    lastCoConUT <<- inFile$name
42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91
    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}
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
92

93
    # setting the table style
94
    datatable(
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
95 96 97 98 99 100 101 102 103 104 105
      cbind(coconut.df), 
      options = list(
        searching = TRUE,
        autoWidth = TRUE,
        rownames = FALSE,
        scroller = TRUE,
        scrollX = TRUE,
        scrollY = "500px",
        fixedHeader = TRUE,
        class = 'cell-border stripe'
      )
106
    )
107
  })
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
108
  
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
109 110 111 112 113 114 115
  #last coconut_name
  output$lastLoadedNut<- renderText({
    if (is.null(input$nut))
      return(NULL)
    else lastCoConUT
  })
  
116 117
  #CoCoQuest Data import
  output$quest <- renderDataTable({
118 119 120 121
    inFile <- input$quest
    if (is.null(inFile))
      return(NULL)
    
122 123
    #loading CoCoQuest data
    json_data_quest <<- fromJSON(paste(inFile$datapath, sep = ""), flatten = TRUE)
124
    lastCoCoQuest <<- inFile$name
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
125
    totalST <<- c(anytime(as.numeric(json_data_quest$startTime)/1000))
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
126

127
    #unix  parsed
128
    dat <- do.call(rbind, json_data_quest$tasks$data)
129 130
    endtimes <<- c(dat$endtime)
    parsedEndtimes <<- anytime(endtimes/1000)
131 132
    tasks <- rep(1:length(json_data_quest$tasks$data), sapply(json_data_quest$tasks$data, nrow))
    together <<- c(tasks, endtimes)
133
    all <- rbind(together)
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
134
    
135
    #setting the table style
136
    datatable(
137
      cbind(tasks, endtimes),
138
      options = list(
139 140
        searching = FALSE,
        rownames = TRUE,
141
        class = 'cell-border stripe'
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
142
      )
143 144
    )
  })
145 146 147 148 149 150 151
  
  #last cocoquest_name
  output$lastLoadedQuest <- renderText({
    if (is.null(input$quest))
      return(NULL)
    else lastCoCoQuest
  })
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
152
  
153
  #cocoQuest Starttime
154 155 156
  output$totalStarttime <- renderText({
    if (is.null(input$quest))
      return(NULL)
157
    else {
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
158
      format(totalST, format="%d-%B-%Y %H:%M:%S")
159 160
      
    }
161
  })
162
  
163 164 165
  #Continue to view page  
  observeEvent(input$viewSite, {
    updateTabItems(session, "tabs",selected = "views")
166 167
  })
  
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
168
  #View PAGE
169
  #Title Input
170
  output$title <- renderText({ input$title })
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
171

172 173 174 175
  #Continue to dashboard page  
  observeEvent(input$dashboardSite, {
    updateTabItems(session, "tabs",selected = "dashboard")
  })
176
  
177
  #For counting the plots and giving axis and plots individual names
178
  plotCounter <<- 0
179 180 181
  plotname <<- paste("plot", plotCounter, sep="")
  xplotname<<- paste("x",plotname,sep="")
  yplotname<<-paste("y",plotname, sep="")
182
  array_plots <<- list()
183 184
  
  #BARCHART box insert
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
185 186
  observeEvent(input$check_hist, {
    
187
    #Setting names
188
    plotname<<-paste("plot", plotCounter, sep="")
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
189
    plotCounter<<-plotCounter+1
190 191
    xplotname<<- paste("x",plotname,sep="")
    yplotname<<-paste("y",plotname, sep="")
192 193
    array_plots <<- c(array_plots, plotname)
    
194 195

    #Inserting box & Chart
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
196 197
    insertUI(
      selector= "#viewpanel", #wo will ichs hinhaben
198 199
      ui= box(  width = 12,
                title="Barchart",
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
200 201 202
                status= "warning",
                solidHeader = TRUE,
                collapsible = TRUE,
203 204
                selectInput(xplotname, "x-axis", choices=colnames(coconut.df)),
                selectInput(yplotname, "y-axis", choices=colnames(coconut.df)),
205
                
206
                plotOutput(plotname, height = 400))
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
207
    )
208
    local({ 
209
        # data handling
210
      output[[plotname]] <- renderPlot({
211
        #assign(paste("data", plotCounter,sep="_")) 
212 213 214
        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")
215
        # New Bar-Plot
216
       array_plots <<-arrangeGrob(array_plots, barplot(data$V2,data$V1, 
217 218 219 220 221 222 223
                 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
224
                )) 
225 226
      })
    }) #Local end
227
    
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
228 229
  })
  
230
  #BARCHART text
231 232 233 234 235
  output$bar_info <- renderText({
    paste("Please be aware, that once you created another chart you won't be able to change the data of your previous charts. The newer chart will crash. ")
  })
  
  
236
  output$bar_explain <- renderText({
237
    paste("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.")
238 239
  })
  
240
  observeEvent(input$check_time, {
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
241
    
242 243 244 245 246 247 248 249 250 251
    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))
      
252
    )
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
253
    
254 255 256 257 258 259 260 261 262 263 264
      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
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
265 266
        timevis(data)
        #array_plots <<-arrangeGrob(array_plots,timevis(data))
267 268 269
        
      })
      })
270
  })
271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294

  # #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)
  #   
  # })
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
295
  
296
  #TIMELINE text
297
  output$texttimeline <- renderText({
298
  "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. "
299 300
  })
  
301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329
#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
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
330
        plot(data$V1,data$V2, type="l", ylab=input[[yplotname]], xlab=input[[xplotname]])
331 332 333
        
      })
    }) #Local end
334 335
  })
  
336
  #LINECHART text
337 338 339
  output$line_info <- renderText({
    paste("Please be aware, that once you created another chart you won't be able to change the data of your previous charts. The newer chart will crash. ")
  })
340
  output$line_explain <- renderText({
341
    "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."
342 343
    
    
344 345
  })
  
346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374
#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
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
375
        plot(data$V1,data$V2, type="p", ylab=input[[yplotname]], xlab=input[[xplotname]], pch=16)
376 377 378
        
      })
    }) #Local end
379 380
  })
  
381
  
382
  #SCATTERPLOT text
383 384 385
  output$scat_info <- renderText({
    paste("Please be aware, that once you created another chart you won't be able to change the data of your previous charts. The newer chart will crash. ")
  })
386
  output$scat_explain <- renderText({
387
    "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."
388 389
  })
  
390
  
391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413
#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({
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
414
      
415 416 417 418
        
        #handling data
        data<- structure(list(V1=as.numeric(coconut.df[[input[[xplotname]]]])),
                         .Names=c("V1"), row.names=c(NA,10L), class = "data.frame")
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
419
       
420 421 422 423 424
        #new Boxplot
        boxplot(data$V1, type="box", xlab=input[[xplotname]])
        
      })
    }) #Local end
425 426
  })
  
427
  
428
  #BOXPLOT text
429 430 431
  output$box_info <- renderText({
    paste("Please be aware, that once you created another chart you won't be able to change the data of your previous charts. The newer chart will crash. ")
  })
432
  output$box_explain <- renderText({
433
    "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."
434
    
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
435 436
  })
  
437 438 439 440 441 442 443
#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="")
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
444
    
445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479
    #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
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
480 481 482 483 484
        
        colorGrad <- colorFactor('Blues', colorData)
        
        
        #colorGrad <- colorFactor('RdYlGn', colorData) 
485 486 487 488 489
        
        #new map
        m <<- leaflet()
        x=1
        m <<- addTiles(m)
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
490
        m<<-addCircleMarkers(m,lng=as.numeric(coconut.df$gps.longitude), lat=as.numeric(coconut.df$gps.latitude), radius = data, color = colorGrad(colorData), fillOpacity = 1 ) #addPolylines does not work
491 492 493 494 495
        m<<-addLegend(m, 'bottomright', pal=colorGrad, values=colorData, title=' ',opacity=1)
        m
        
      })
    }) #Local end
496 497
  })
  
498
  #MAP text
499 500 501 502
  output$map_info <- renderText({
    paste("Please be aware, that once you created another chart you won't be able to change the data of your previous charts. The newer chart will crash. ")
  })
  
503
  output$map_explain <- renderText({
504
    "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)."
505 506

    })
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
507
  
508
  #TODO: TOOLTIP
509 510 511 512 513
  data_tooltip <- function(x){
    if(is.null(x)) return(NULL)
    if(is.null(x$ID)) return(NULL)
    paste0(coconut.df[[input$line_x]])
  }
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
514
  
515
  #TODO: DownloadButton
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
516
  output$down.pdf <- downloadHandler(
517 518
    print("DOWNLOAD"),
    #print(V1)
519
    filename = "download.pdf",
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
520
    content = function(file) {
521
      CairoPDF(file = file, width=12, height=8)
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
522
      #boxplot(data$V1, type="box", xlab=input$box_x)
523 524
      #m
      #leafletOutput("map", height = 250)
525 526 527 528 529 530 531 532 533 534 535 536 537 538
      # 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)
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
539
      dev.off()
540 541 542
    }

  )
Stephanie's avatar
Stephanie committed
543
}