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

library(shiny)
3
library(jsonlite)
4
library(DT)
5
library(webshot)
6
library(knitr)
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
7
library(leaflet)
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
8
library(mapview)
9
library(ggplot2)
10
library(timevis)
11
library(plotly)
Stephanie's avatar
Stephanie committed
12

13

14
server <- function(input, output, session) {
Stephanie's avatar
Stephanie committed
15
  set.seed(122)
16

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

    #coconut.df$timestamp <- format(coconut.df$timestamp, format="%d-%B-%Y %H:%M:%S")
41
  
42
    
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
43
    #print(coconut.df)
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 92 93 94 95
    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}

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

133
    #unix  parsed
134 135
    dat <- do.call(rbind, json_data_quest$tasks$data)
  
136
    endtimes <<- c(dat$endtime)
137
    
138
    parsedEndtimes <<- anytime(endtimes/1000)
139 140
    #endtimes <<- format(dat$endtime, format="%d-%B-%Y %H:%M:%S")
    print("endtime quest")
141
    print(parsedEndtimes)
142
    tasks <- rep(1:length(json_data_quest$tasks$data), sapply(json_data_quest$tasks$data, nrow))
143 144
    #questions 
    #print("Questions:", questions)
145
    together <<- c(tasks, endtimes)
146 147
    print("together")
    print(together)
148 149
    all <- rbind(together)

150
    #setting the table style
151
    datatable(
152
      cbind(tasks, endtimes),
153
      options = list(
154 155
        searching = FALSE,
        rownames = TRUE,
156
        class = 'cell-border stripe'
157
     )
158 159
    )
  })
160 161 162 163 164 165 166
  
  #last cocoquest_name
  output$lastLoadedQuest <- renderText({
    if (is.null(input$quest))
      return(NULL)
    else lastCoCoQuest
  })
167 168

  #cocoQuest Starttime
169 170 171
  output$totalStarttime <- renderText({
    if (is.null(input$quest))
      return(NULL)
172
    else {
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
173
      format(totalST, format="%d-%B-%Y %H:%M:%S")
174 175
      
    }
176
  })
177
  
178 179
  #Continue to view page  
  observeEvent(input$viewSite, {
180
    
181
    updateTabItems(session, "tabs",selected = "views")
182 183 184
    
  })
  
185
#View PAGE
186 187
  
  #Title Input
188
  output$title <- renderText({ input$title })
189
  
190
  #barchart
191
  
192
  output$input_hist_x <- renderUI({
193
    if (is.null(input$nut))
194
     return(NULL)
195
    selectInput("in1", "x-axis:", cbind("unixTime", "longitude", "latitude", "speed", "gps.acc","lux", "light.acc","acc.coordinates", "acc.acc","bluetooth","ble.bpm","ble.bpmlist","ble.hrv","ble.hrvlist","activity.name", "acctivity.confidence","screen.status" ,"touch"),multiple=TRUE, selectize=TRUE) 
196 197 198
  })
  
  output$input_hist_y <- renderUI({
199 200
    if (is.null(input$nut))
      return(NULL)
201
    selectInput("in2", "y-axis:", cbind("unixTime", "longitude", "latitude", "speed", "gps.acc","lux", "light.acc","acc.coordinates", "acc.acc","bluetooth","ble.bpm","ble.bpmlist","ble.hrv","ble.hrvlist","activity.name", "acctivity.confidence","screen.status" ,"touch"),multiple=TRUE, selectize=TRUE) 
202 203
  })
  
204
  
205 206
  #Timeline

207
  output$input_time_x <- renderUI({
208 209
   if (is.null(input$nut))
     return(NULL)
210
    selectInput("in3", "x-axis:", cbind("unixTime", "longitude", "latitude", "speed", "gps.acc","lux", "light.acc","acc.coordinates", "acc.acc","bluetooth","ble.bpm","ble.bpmlist","ble.hrv","ble.hrvlist","activity.name", "acctivity.confidence","screen.status" ,"touch"),multiple=TRUE, selectize=TRUE) 
211
  })
212
  
213
 output$input_time_y <- renderUI({
214 215
    if (is.null(input$nut))
      return(NULL)
216
    selectInput("in4", "y-axis:", cbind("unixTime", "longitude", "latitude", "speed", "gps.acc","lux", "light.acc","acc.coordinates", "acc.acc","bluetooth","ble.bpm","ble.bpmlist","ble.hrv","ble.hrvlist","activity.name", "acctivity.confidence","screen.status" ,"touch"),multiple=TRUE, selectize=TRUE) 
217 218
  })
  
219
  
220
  #Map
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
221 222 223 224 225
  output$input_map <- renderUI({
      if (is.null(input$nut))
        return(NULL)
     selectInput("in5", "Data:", cbind("unixTime", "speed", "gps.acc","lux", "light.acc","acc.coordinates", "acc.acc","bluetooth","ble.bpm","ble.bpmlist","ble.hrv","ble.hrvlist","activity.name", "acctivity.confidence","screen.status" ,"touch"),multiple=TRUE, selectize=TRUE) 
    })
226
  
227 228 229 230 231 232 233 234 235 236 237
  output$input_map_x <- renderUI({
    if (is.null(input$nut))
     return(NULL)
    selectInput("in5", "x-axis:", cbind("unixTime", "longitude", "latitude", "speed", "gps.acc","lux", "light.acc","acc.coordinates", "acc.acc","bluetooth","ble.bpm","ble.bpmlist","ble.hrv","ble.hrvlist","activity.name", "acctivity.confidence","screen.status" ,"touch"),multiple=TRUE, selectize=TRUE) 
  })
  
  output$input_map_y <- renderUI({
    if (is.null(input$nut))
      return(NULL)
    selectInput("in6", "y-axis:", cbind("unixTime", "longitude", "latitude", "speed", "gps.acc","lux", "light.acc","acc.coordinates", "acc.acc","bluetooth","ble.bpm","ble.bpmlist","ble.hrv","ble.hrvlist","activity.name", "acctivity.confidence","screen.status" ,"touch"),multiple=TRUE, selectize=TRUE) 
  })
238
  
239
  
240
  #linechart
241
 
242
  output$input_line_x <- renderUI({
243 244
    if (is.null(input$nut))
      return(NULL)
245
    selectInput("in7", "x-axis:", cbind("unixTime", "longitude", "latitude", "speed", "gps.acc","lux", "light.acc","acc.coordinates", "acc.acc","bluetooth","ble.bpm","ble.bpmlist","ble.hrv","ble.hrvlist","activity.name", "acctivity.confidence","screen.status" ,"touch"),multiple=TRUE, selectize=TRUE) 
246 247 248
  })
  
  output$input_line_y <- renderUI({
249
   if (is.null(input$nut))
250
      return(NULL)
251
    selectInput("in8", "y-axis:", cbind("unixTime", "longitude", "latitude", "speed", "gps.acc","lux", "light.acc","acc.coordinates", "acc.acc","bluetooth","ble.bpm","ble.bpmlist","ble.hrv","ble.hrvlist","activity.name", "acctivity.confidence","screen.status" ,"touch"),multiple=TRUE, selectize=TRUE) 
252
  })
253
  
254
  
255 256 257 258 259 260
  #Continue to dashboard page  
  observeEvent(input$dashboardSite, {
    
    updateTabItems(session, "tabs",selected = "dashboard")
    
  })
261
  
262
#DASHBOARD  
263
  
264
  #barchart
265 266
  output$hist_box <- renderUI({
    if(input$check_hist)
267
      box(  title="Barchart",
268 269 270
           status= "warning",
          solidHeader = TRUE,
          collapsible = TRUE,
271
          plotOutput("bar", height = 250))
272 273
  })
  
274
  #BAR VIEW
275
  output$bar <- renderPlot({
276
    print("BAR wird aufgerufen.")
277 278 279 280 281 282 283 284 285 286 287 288 289
    data<- structure(list(V1=as.numeric(coconut.df[[input$bar_y]]), 
                          V2=as.numeric(coconut.df[[input$bar_x]])),
                     .Names=c("V1","V2"), row.names=c(NA,6L), class = "data.frame")
    #Neues Plot
    barplot(data$V1,data$V2, 
            ylab= input$bar_y,
            xlab=input$bar_x)
    
    
    ## ALTES PLOT
   #a=1
    
    #for(a in 1:length(coconut.df$bluetooth.numOfBTDevices)){
290 291 292 293 294
     
      #g <-geom_bar(mapping = NULL, data = , stat = "count",
      #             position = "stack", width = NULL, binwidth = NULL, na.rm = FALSE,
      #             show.legend = NA, inherit.aes = TRUE)
    
295
      #g <- ggplot(coconut.df, aes("timestamp","bluetooth"))
296
      #g + geom_bar()
297
     # a=a+1}
298
    
299
      #g
300
    #hist(bluetooth)
301

302 303 304 305 306 307 308
  })
  
  
  #TIMELINE
  output$time_box <- renderUI({
    if(input$check_time)
      box(  title="Timeline",
309 310 311
            status= "warning",
            solidHeader = TRUE,
            collapsible = TRUE,
312 313
            timevisOutput("time", height = 250)
            )
314 315
  })
  
316 317
  #TODO: Timelineview
  output$time <- renderTimevis({
318
    print("TIME wird aufgerufen")
319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334

    print("Length:")
    print(length(parsedEndtimes))
    print("combined")
    print( c(anytime(totalST), head(parsedEndtimes, -1)))
    print("endtimes")
    print(parsedEndtimes)
    
    
    data <-  data.frame(
      id      = 1:length(parsedEndtimes),
      content= c(1:length(parsedEndtimes)),
      start   = c(anytime(totalST), head(parsedEndtimes, -1)),
      end     = parsedEndtimes
    )
    timevis(data)
335 336
   
  })
337

338 339 340 341 342
  output$texttimeline <- renderText({
    "Check Timeline for getting a Timeline about CoCoQuest Tasks and Questions."
  })
   
 
343 344 345 346 347 348 349 350
  
  #linechart
  output$line_box <- renderUI({
    if(input$check_line)
      box(  title="Linechart",
            status= "warning",
            solidHeader = TRUE,
            collapsible = TRUE,
351 352 353 354 355 356
            plotOutput("line", height = 250))
  })
  
  #TODO: linechart View
  output$line <- renderPlot({
    print("LINE wird aufgerufen")
357 358 359 360 361 362 363
    data<- structure(list(V1=as.numeric(coconut.df[[input$line_x]]), 
                          V2=as.numeric(coconut.df[[input$line_y]])),
                     .Names=c("V1","V2"), row.names=c(NA,6L), class = "data.frame")
    plot(data$V1,data$V2, type="l", ylab=input$line_y, xlab=input$line_x)
         
    
    
364
    
365 366
  })
  
367
  # Scatterplot
368 369 370 371 372 373
  output$scat_box <- renderUI({
    if(input$check_scat)
      box(  title="Scatterplot",
            status= "warning",
            solidHeader = TRUE,
            collapsible = TRUE,
374
            plotOutput("scat", height = 250))
375 376
  })
  
377 378
  #TODO: Scatterplot View
  output$scat <- renderPlot({
379 380
    data<- structure(list(V1=as.numeric(coconut.df[[input$scat_x]]), 
                          V2=as.numeric(coconut.df[[input$scat_y]])),
381 382 383
                     .Names=c("V1","V2"), row.names=c(NA,6L), class = "data.frame")
    print("SCAT wird aufgerufen")
    
384
    plot(data$V1, data$V2, type="p", labx=input$scat_x, laby=input$scat_y )
385 386 387
  })
  
  # Boxplot
388 389 390
  output$box_box <- renderUI({
    if(input$check_box)
      box(  title="Boxplot",
391 392 393
            status= "warning",
            solidHeader = TRUE,
            collapsible = TRUE,
394 395 396 397 398 399
            plotOutput("box", height = 250))
  })
  
  #TODO: Boxplot View
  output$box <- renderPlot({
    print("BOX wird aufgerufen")
Stephanie Wegscheidl's avatar
boxplot  
Stephanie Wegscheidl committed
400 401 402 403
    data<- structure(list(V1=as.numeric(coconut.df[[input$box_x]])),
                     .Names=c("V1"), row.names=c(NA,6L), class = "data.frame")
    
    boxplot(data$V1, type="box", labx=input$box_x )
404 405 406 407 408 409 410 411 412
  })
  
  #MAP
  output$map_box <- renderUI({
    if(input$check_map)
      box(  title="Map",
            status= "warning",
            solidHeader = TRUE,
            collapsible = TRUE,
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
413
            leafletOutput("map", height = 250))
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
414 415
  })
  
416
  # MAP VIEW 
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
417
  output$map <- renderLeaflet({
418
    print("MAP wird aufgerufen")
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
419
    m <<- leaflet()
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
420 421
    x=1
    m <- addTiles(m)
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
422
    for(x in 1:length(coconut.df$gps.latitude)){
423
      m <- addCircleMarkers(m,lng=as.numeric(longitude[x]), lat=as.numeric(latitude[x]), radius = 1, color ="red") #addPolylines does not work
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
424 425
      x=x+1}
    m
426 427
  })
  
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
428
  
429
  
430
  
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
431 432
 
  
433
  #DownloadButton
434 435
  #TODO: MAKE IT WORK!
  observeEvent(input$screenshot,{
436 437
    #if(input$check_line|input$check_time|input$check_map|input$check_hist)
    #disable("screenshot")
438
    #webshot::install_phantomjs()
439
    
440
    cdat <<- session$clientData
441
    url <- paste0(cdat$url_hostname,":", cdat$url_port,"/")
442
    print(url)
443
    
444 445
    #URL <- "http://rstudio.github.io/leaflet/"
    #appshot("cocoVisR/", file = "dashboard.png", port = getOption("shiny.port"), envvars = NULL)
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
446
    #webshot(url,delay = 5.0)
447
    #knit("dashboard.png")
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
448 449 450
    #port <- cdat$url_port
    #mapshot(m, file="~/Rplot.png")
    
451
    #webshot(url, "dashboard.png", delay = 20.0) # does NOT WORK 
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
452 453 454 455 456
    #appdir <- system.file("examples", "01_hello", package="shiny")
    #print("appdir")
    #print(appdir)
    #appshot(appdir, "01_hello.png")
    
457
    #leaflet.print(m)
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
458 459 460 461 462 463
    
    
    
    
    
    
464 465
    
  })
466
  # url <- paste0(cdat$url_protocol,"//",cdat$url_hostname,":", cdat$url_port, cdat$url_pathname,cdat$url_search)
467 468 469 470 471 472 473 474 475
  #output$downButton <- downloadHandler(
   # filename="dashboard.png",
    #content=function(file){
     # observeEvent(input$downButton, {
      #appshot("cocoVisR/dashboard", file = "dashboard.png", port = getOption("shiny.port"), envvars = NULL)
 
      #}) 
    #}
  #)
476
 
477 478 479 480 481 482 483 484
  
  
  
  
  
#SOME STUFF  
  
  
485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501
  #histdata <- rnorm(500)
  
  #output$plot1 <- renderPlot({
  #data <- histdata[seq_len(input$slider)]
  #hist(data)
  #})
  
  ##MAP 
  
  #m <- leaflet()
  #m <- addTiles(m)
  #x=1
  #for(x in 1:2019){
  #m <- addMarkers(m,lng=longitude[x], lat=latitude[x]) #addPolylines does not work
  #x=x+1}
  #m
  #}
Stephanie's avatar
Stephanie committed
502
}