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
  
22 23
  
  #Continue to data page  
24 25 26
  observeEvent(input$dataSite, {
    
    updateTabItems(session, "tabs",selected = "data")
27
    
28
  })
29
  
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"]]
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}
92

93
    # setting the table style
94
    datatable(
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
  })
108
  
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
125
    totalST <<- c(anytime(as.numeric(json_data_quest$startTime)/1000))
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)
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'
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
  })
152
  
153
  #cocoQuest Starttime
154 155 156
  output$totalStarttime <- renderText({
    if (is.null(input$quest))
      return(NULL)
157
    else {
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
  })
  
168
  #View PAGE
169
  #Title Input
170
  output$title <- renderText({ input$title })
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
185 186
  observeEvent(input$check_hist, {
    
187
    #Setting names
188
    plotname<<-paste("plot", plotCounter, sep="")
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
196 197
    insertUI(
      selector= "#viewpanel", #wo will ichs hinhaben
198 199
      ui= box(  width = 12,
                title="Barchart",
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))
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
    
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, {
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
    )
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
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)
  #   
  # })
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
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="")
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
516
  output$down.pdf <- downloadHandler(
517 518
    print("DOWNLOAD"),
    #print(V1)
519
    filename = "download.pdf",
520
    content = function(file) {
521
      CairoPDF(file = file, width=12, height=8)
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)
539
      dev.off()
540 541 542
    }

  )
Stephanie's avatar
Stephanie committed
543
}