server.R 16.1 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
server <- function(input, output, session) {
Stephanie's avatar
Stephanie committed
18
  set.seed(122)
19
  
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
20 21
  
  #Continue to data page  
22 23 24
  observeEvent(input$dataSite, {
    
    updateTabItems(session, "tabs",selected = "data")
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
25
    
26
  })
27
  
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
28
  #DATA PAGE
29
  #CoConUT Data import 
30 31
  output$nut <- renderDataTable({
    inFile <- input$nut
32 33
    if (is.null(inFile))
      return(NULL)
34
    
35
    #loading CoConUT data
36
    json_data_coco <- fromJSON(paste(inFile$datapath, sep = ""), flatten = TRUE)
37
    coconut.df <<- json_data_coco[["data"]]
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
38
    
39
    lastCoConUT <<- inFile$name
40 41 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
    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
90

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

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

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

    #Inserting box & Chart
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
191 192
    insertUI(
      selector= "#viewpanel", #wo will ichs hinhaben
193 194
      ui= box(  width = 12,
                title="Barchart",
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
195 196 197
                status= "warning",
                solidHeader = TRUE,
                collapsible = TRUE,
198 199 200
                selectInput(xplotname, "x-axis", choices=colnames(coconut.df)),
                selectInput(yplotname, "y-axis", choices=colnames(coconut.df)),
                plotOutput(plotname, height = 400))
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
201
    )
202
    local({ 
203
        # data handling
204 205 206 207
      output[[plotname]] <- renderPlot({
        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")
208 209 210 211 212 213 214 215 216 217
        # New Bar-Plot
        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
                )
218 219
      })
    }) #Local end
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
220 221
  })
  
222 223
  #BARCHART text
  output$bar_explain <- renderText({
224
    "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."
225 226
  })
  
227
  observeEvent(input$check_time, {
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
228
    
229 230 231 232 233 234 235 236 237 238
    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))
      
239
    )
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
240
    
241 242 243 244 245 246 247 248 249 250 251 252 253 254 255
      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)
        
      })
      })
256
  })
257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280

  # #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
281
  
282
  #TIMELINE text
283
  output$texttimeline <- renderText({
284
  "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. "
285 286
  })
  
287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315
#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
316
        plot(data$V1,data$V2, type="l", ylab=input[[yplotname]], xlab=input[[xplotname]])
317 318 319
        
      })
    }) #Local end
320 321
  })
  
322 323
  #LINECHART text
  output$line_explain <- renderText({
324 325 326
    "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."
    
    
327 328
  })
  
329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357
#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
358
        plot(data$V1,data$V2, type="p", ylab=input[[yplotname]], xlab=input[[xplotname]])
359 360 361
        
      })
    }) #Local end
362 363
  })
  
364
  
365 366
  #SCATTERPLOT text
  output$scat_explain <- renderText({
367
    "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."
368 369
  })
  
370
  
371 372 373 374 375 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
#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
403 404
  })
  
405
  
406 407
  #BOXPLOT text
  output$box_explain <- renderText({
408 409
    "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
410 411
  })
  
412 413 414 415 416 417 418
#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
419
    
420 421 422 423 424 425 426 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
    #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
467 468
  })
  
469 470
  #MAP text
  output$map_explain <- renderText({
471 472 473
    "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
474
  
475
  #TODO: TOOLTIP
476 477 478 479 480
  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
481
  
482
  #TODO: DownloadButton
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
483
  output$down.pdf <- downloadHandler(
484
    filename = "download.pdf",
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
485
    content = function(file) {
486
      CairoPDF(file = file, width=12, height=8)
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
487
      #boxplot(data$V1, type="box", xlab=input$box_x)
488 489
      #m
      #leafletOutput("map", height = 250)
490
      output$box 
491 492 493 494
      data<- structure(list(V1=as.numeric(coconut.df[[input$scat_x]]),
                            V2=as.numeric(coconut.df[[input$scat_y]])),
                       .Names=c("V1","V2"), row.names=c(NA,6L), class = "data.frame")
      plot(data$V1,data$V2, type="p", xlab=input$scat_x, ylab=input$scat_y )
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
495 496
      dev.off()
    })
Stephanie's avatar
Stephanie committed
497
}