server.R 16.7 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 231
  #BARCHART text
  output$bar_explain <- renderText({
232
    "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."
233 234
  })
  
235
  observeEvent(input$check_time, {
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
236
    
237 238 239 240 241 242 243 244 245 246
    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))
      
247
    )
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
248
    
249 250 251 252 253 254 255 256 257 258 259
      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
260
        array_plots <<-arrangeGrob(array_plots,timevis(data))
261 262 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

  # #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
289
  
290
  #TIMELINE text
291
  output$texttimeline <- renderText({
292
  "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. "
293 294
  })
  
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
#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
324
        plot(data$V1,data$V2, type="l", ylab=input[[yplotname]], xlab=input[[xplotname]])
325 326 327
        
      })
    }) #Local end
328 329
  })
  
330 331
  #LINECHART text
  output$line_explain <- renderText({
332 333 334
    "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."
    
    
335 336
  })
  
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
#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
366
        plot(data$V1,data$V2, type="p", ylab=input[[yplotname]], xlab=input[[xplotname]])
367 368 369
        
      })
    }) #Local end
370 371
  })
  
372
  
373 374
  #SCATTERPLOT text
  output$scat_explain <- renderText({
375
    "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."
376 377
  })
  
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 404 405 406 407 408 409 410
#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
411 412
  })
  
413
  
414 415
  #BOXPLOT text
  output$box_explain <- renderText({
416 417
    "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
418 419
  })
  
420 421 422 423 424 425 426
#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
427
    
428 429 430 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 467 468 469 470 471 472 473 474
    #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
475 476
  })
  
477 478
  #MAP text
  output$map_explain <- renderText({
479 480 481
    "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
482
  
483
  #TODO: TOOLTIP
484 485 486 487 488
  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
489
  
490
  #TODO: DownloadButton
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
491
  output$down.pdf <- downloadHandler(
492 493
    print("DOWNLOAD"),
    #print(V1)
494
    filename = "download.pdf",
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
495
    content = function(file) {
496
      CairoPDF(file = file, width=12, height=8)
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
497
      #boxplot(data$V1, type="box", xlab=input$box_x)
498 499
      #m
      #leafletOutput("map", height = 250)
500 501 502 503 504 505 506 507 508 509 510 511 512 513
      # 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
514
      dev.off()
515 516 517
    }

  )
Stephanie's avatar
Stephanie committed
518
}