server.R 16.8 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
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
216
        print(as.numeric(data$V1))
217
       array_plots <<-arrangeGrob(array_plots, barplot(data$V2,data$V1, 
218 219 220 221 222 223 224
                 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
225
                )) 
226 227
      })
    }) #Local end
228
    
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
229 230
  })
  
231 232
  #BARCHART text
  output$bar_explain <- renderText({
233
    "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."
234 235
  })
  
236
  observeEvent(input$check_time, {
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
237
    
238 239 240 241 242 243 244 245 246 247
    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))
      
248
    )
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
249
    
250 251 252 253 254 255 256 257 258 259 260
      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
261 262
        timevis(data)
        #array_plots <<-arrangeGrob(array_plots,timevis(data))
263 264 265
        
      })
      })
266
  })
267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290

  # #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
291
  
292
  #TIMELINE text
293
  output$texttimeline <- renderText({
294
  "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. "
295 296
  })
  
297 298 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
#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
326
        plot(data$V1,data$V2, type="l", ylab=input[[yplotname]], xlab=input[[xplotname]])
327 328 329
        
      })
    }) #Local end
330 331
  })
  
332 333
  #LINECHART text
  output$line_explain <- renderText({
334 335 336
    "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."
    
    
337 338
  })
  
339 340 341 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
#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
368
        plot(data$V1,data$V2, type="p", ylab=input[[yplotname]], xlab=input[[xplotname]], pch=16)
369 370 371
        
      })
    }) #Local end
372 373
  })
  
374
  
375 376
  #SCATTERPLOT text
  output$scat_explain <- renderText({
377
    "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."
378 379
  })
  
380
  
381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403
#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
404
      
405 406 407 408
        
        #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
409
       
410 411 412 413 414
        #new Boxplot
        boxplot(data$V1, type="box", xlab=input[[xplotname]])
        
      })
    }) #Local end
415 416
  })
  
417
  
418 419
  #BOXPLOT text
  output$box_explain <- renderText({
420 421
    "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."
    
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
422 423
  })
  
424 425 426 427 428 429 430
#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
431
    
432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466
    #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
467 468 469 470 471
        
        colorGrad <- colorFactor('Blues', colorData)
        
        
        #colorGrad <- colorFactor('RdYlGn', colorData) 
472 473 474 475 476
        
        #new map
        m <<- leaflet()
        x=1
        m <<- addTiles(m)
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
477
        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
478 479 480 481 482
        m<<-addLegend(m, 'bottomright', pal=colorGrad, values=colorData, title=' ',opacity=1)
        m
        
      })
    }) #Local end
483 484
  })
  
485 486
  #MAP text
  output$map_explain <- renderText({
487 488 489
    "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."

    })
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
490
  
491
  #TODO: TOOLTIP
492 493 494 495 496
  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
497
  
498
  #TODO: DownloadButton
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
499
  output$down.pdf <- downloadHandler(
500 501
    print("DOWNLOAD"),
    #print(V1)
502
    filename = "download.pdf",
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
503
    content = function(file) {
504
      CairoPDF(file = file, width=12, height=8)
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
505
      #boxplot(data$V1, type="box", xlab=input$box_x)
506 507
      #m
      #leafletOutput("map", height = 250)
508 509 510 511 512 513 514 515 516 517 518 519 520 521
      # 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
522
      dev.off()
523 524 525
    }

  )
Stephanie's avatar
Stephanie committed
526
}