server.R 14.3 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)
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
11
#library(plotly)
Stephanie's avatar
Stephanie committed
12

13

14

15
server <- function(input, output, session) {
Stephanie's avatar
Stephanie committed
16
  set.seed(122)
17
  
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
18
19
  
  #Continue to data page  
20
21
22
  observeEvent(input$dataSite, {
    
    updateTabItems(session, "tabs",selected = "data")
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
23
    
24
  })
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
25
  #DATA PAGE
26
  
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
27
  
28
  
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
    print("1")
38
    coconut.df <<- json_data_coco[["data"]]
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
39
    
40
    lastCoConUT <<- inFile$name
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
41
    #print("coconut:")
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
42
    
43
    #coconut.df$timestamp <- format(coconut.df$timestamp, format="%d-%B-%Y %H:%M:%S")
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
44
    
45
    
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
46
    #print(coconut.df)
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
96
97
    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
98
99
    
    
100
    # setting the table style
101
    datatable(
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
102
103
104
105
106
107
108
109
110
111
112
      cbind(coconut.df), 
      options = list(
        searching = TRUE,
        autoWidth = TRUE,
        rownames = FALSE,
        scroller = TRUE,
        scrollX = TRUE,
        scrollY = "500px",
        fixedHeader = TRUE,
        class = 'cell-border stripe'
      )
113
    )
114
  })
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
115
116
117
118
119
120
121
  #last coconut_name
  output$lastLoadedNut<- renderText({
    if (is.null(input$nut))
      return(NULL)
    else lastCoConUT
  })
  
122
123
  #CoCoQuest Data import
  output$quest <- renderDataTable({
124
125
126
127
    inFile <- input$quest
    if (is.null(inFile))
      return(NULL)
    
128
129
    #loading CoCoQuest data
    json_data_quest <<- fromJSON(paste(inFile$datapath, sep = ""), flatten = TRUE)
130
    
131
    lastCoCoQuest <<- inFile$name
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
132
    totalST <<- c(anytime(as.numeric(json_data_quest$startTime)/1000))
133
134
    print(json_data_quest)
    
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
135
    
136
    #unix  parsed
137
    dat <- do.call(rbind, json_data_quest$tasks$data)
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
138
    
139
    endtimes <<- c(dat$endtime)
140
    
141
    parsedEndtimes <<- anytime(endtimes/1000)
142
143
    #endtimes <<- format(dat$endtime, format="%d-%B-%Y %H:%M:%S")
    print("endtime quest")
144
    print(parsedEndtimes)
145
    tasks <- rep(1:length(json_data_quest$tasks$data), sapply(json_data_quest$tasks$data, nrow))
146
147
    #questions 
    #print("Questions:", questions)
148
    together <<- c(tasks, endtimes)
149
150
    print("together")
    print(together)
151
    all <- rbind(together)
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
152
    
153
    #setting the table style
154
    datatable(
155
      cbind(tasks, endtimes),
156
      options = list(
157
158
        searching = FALSE,
        rownames = TRUE,
159
        class = 'cell-border stripe'
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
160
      )
161
162
    )
  })
163
164
165
166
167
168
169
  
  #last cocoquest_name
  output$lastLoadedQuest <- renderText({
    if (is.null(input$quest))
      return(NULL)
    else lastCoCoQuest
  })
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
170
  
171
  #cocoQuest Starttime
172
173
174
  output$totalStarttime <- renderText({
    if (is.null(input$quest))
      return(NULL)
175
    else {
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
176
      format(totalST, format="%d-%B-%Y %H:%M:%S")
177
178
      
    }
179
  })
180
  
181
182
  #Continue to view page  
  observeEvent(input$viewSite, {
183
    
184
    updateTabItems(session, "tabs",selected = "views")
185
186
187
    
  })
  
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
188
  #View PAGE
189
190
  
  #Title Input
191
  output$title <- renderText({ input$title })
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
192
  
193
  #barchart
194
195
  
  #selectInput("time_data", "data", choices=colnames(coconut.df))
196
  output$input_hist_x <- renderUI({
197
    if (is.null(input$nut))
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
198
      return(NULL)
199
200
    selectInput("bar_x", "x-axis:", choices = colnames(coconut.df)) 
    })
201
202
  
  output$input_hist_y <- renderUI({
203
204
    if (is.null(input$nut))
      return(NULL)
205
206
    selectInput("bar_y", "y-axis:", choices = colnames(coconut.df)) 
    })
207
  
208
  
209
  #Timeline
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
210
  
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
  # output$input_time_data <- renderUI({
  #   if (is.null(input$nut))
  #     return(NULL)
  #   selectInput("input_time_data", "x-axis:", choices = colnames(coconut.df))
  # })
  # 
  # output$input_time_y <- renderUI({
  #   if (is.null(input$nut))
  #     return(NULL)
  #   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) 
  # })
  
  
  #Map
  output$input_map <- renderUI({
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
226
227
    if (is.null(input$nut))
      return(NULL)
228
    selectInput("map_data", "data", choices=colnames(coconut.df))  
229
  })
230
  
231
232
233
234
235
236
 
  
  
  #linechart
  
  output$input_line_x <- renderUI({
237
238
    if (is.null(input$nut))
      return(NULL)
239
    selectInput("line_x", "x-axis", choices=colnames(coconut.df))  
240
241
  })
  
242
  output$input_line_y <- renderUI({
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
243
244
    if (is.null(input$nut))
      return(NULL)
245
246
    selectInput("line_y", "y-axis", choices=colnames(coconut.df))  })
  
247
  
248
249
  #scatterplot
  output$input_scat_x <- renderUI({
250
    if (is.null(input$nut))
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
251
      return(NULL)
252
    selectInput("scat_x", "x-axis", choices=colnames(coconut.df))  
253
254
  })
  
255
  output$input_scat_y <- renderUI({
256
257
    if (is.null(input$nut))
      return(NULL)
258
    selectInput("scat_y", "y-axis", choices=colnames(coconut.df))  
259
  })
260
  
261
  #boxplot
262
  
263
  output$input_box_x <- renderUI({
264
265
    if (is.null(input$nut))
      return(NULL)
266
    selectInput("box_x", "data", choices=colnames(coconut.df))  
267
268
  })
  
269
  output$input_box_y <- renderUI({
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
270
    if (is.null(input$nut))
271
      return(NULL)
272
    selectInput("box_y", "y-axis", choices=colnames(coconut.df))  
273
  })
274
  
275
  
276
277
  
  
278
279
  #Continue to dashboard page  
  observeEvent(input$dashboardSite, {
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
280
    
281
    updateTabItems(session, "tabs",selected = "dashboard")
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
282
    
283
  })
284
  plotCounter <<- 0
285
  #ADD BARCHART BUTTON
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
286
287
288
289
  observeEvent(input$check_hist, {
    
    plotCounter<<-plotCounter+1
    print(plotCounter)
290
    plotname <<- paste("plot", plotCounter, sep="")
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
291
    print(plotname)
292
293
    xplotname<<- paste("x",plotname,sep="")
    yplotname<<-paste("y",plotname, sep="")
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
294
295
296
    insertUI(
      
      selector= "#viewpanel", #wo will ichs hinhaben
297
298
      ui= box(  width = 12,
                title="Barchart",
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
299
300
301
                status= "warning",
                solidHeader = TRUE,
                collapsible = TRUE,
302
303
                # selectInput(xplotname, "x-axis", choices=colnames(coconut.df)),
                # selectInput(yplotname, "y-axis", choices=colnames(coconut.df)),
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
304
                print(plotname),
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
305
306
307
308
309
310
311
312
                plotOutput(plotname, height = 250))
    )
    
    
  })
  
  #DASHBOARD  
  #BAR VIEW
313
  
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
  # #local({     
  #   
  #   
  #   # 
  #   # output[[plotname]] <- renderPlot({
  #   #   print(plotname)
  #   # 
  #   #   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,6L), class = "data.frame")
  #   #   #Neues Plot
  #   #   barplot(data$V1,data$V2,
  #   #           ylab= input$yplotname,
  #   #           xlab=input$xplotname)
  #   # 
  #   # })
  # #})
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
  
  ## ALTES PLOT
  #a=1
  
  #for(a in 1:length(coconut.df$bluetooth.numOfBTDevices)){
  
  #g <-geom_bar(mapping = NULL, data = , stat = "count",
  #             position = "stack", width = NULL, binwidth = NULL, na.rm = FALSE,
  #             show.legend = NA, inherit.aes = TRUE)
  
  #g <- ggplot(coconut.df, aes("timestamp","bluetooth"))
  #g + geom_bar()
  # a=a+1}
  
  #g
  #hist(bluetooth)
  
  
349
350
351
352
353
  
  
  #TIMELINE
  output$time_box <- renderUI({
    if(input$check_time)
354
355
      box(  width = 12,
            title="Timeline",
356
357
358
            status= "warning",
            solidHeader = TRUE,
            collapsible = TRUE,
359
            timevisOutput("time", height = 175)
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
360
      )
361
362
  })
  
363
364
  #TODO: Timelineview
  output$time <- renderTimevis({
365
    print("TIME wird aufgerufen")
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
366
    
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
    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)
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
382
    
383
  })
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
384
  
385
386
387
  output$texttimeline <- renderText({
    "Check Timeline for getting a Timeline about CoCoQuest Tasks and Questions."
  })
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
388
389
  
  
390
391
392
393
  
  #linechart
  output$line_box <- renderUI({
    if(input$check_line)
394
395
      box(  width = 12,
            title="Linechart",
396
397
398
            status= "warning",
            solidHeader = TRUE,
            collapsible = TRUE,
399
            
400
            #add_tooltip(data_tooltip, "hover"),
401
402
403
404
405
406
            plotOutput("line", height = 250))
  })
  
  #TODO: linechart View
  output$line <- renderPlot({
    print("LINE wird aufgerufen")
407
408
409
410
    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)
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
411
    
412
413
  })
  
414
  # Scatterplot
415
416
  output$scat_box <- renderUI({
    if(input$check_scat)
417
418
      box(  width = 12,
            title="Scatterplot",
419
420
421
            status= "warning",
            solidHeader = TRUE,
            collapsible = TRUE,
422
           
423
            plotOutput("scat", height = 250))
424
425
  })
  
426
427
  #TODO: Scatterplot View
  output$scat <- renderPlot({
428
429
    data<- structure(list(V1=as.numeric(coconut.df[[input$scat_x]]), 
                          V2=as.numeric(coconut.df[[input$scat_y]])),
430
431
432
                     .Names=c("V1","V2"), row.names=c(NA,6L), class = "data.frame")
    print("SCAT wird aufgerufen")
    
433
    plot(data$V1,data$V2, type="p", xlab=input$scat_x, ylab=input$scat_y )
434
435
436
  })
  
  # Boxplot
437
438
  output$box_box <- renderUI({
    if(input$check_box)
439
440
      box(  width = 12,
            title="Boxplot",
441
442
443
            status= "warning",
            solidHeader = TRUE,
            collapsible = TRUE,
444
            
445
446
447
448
449
450
            plotOutput("box", height = 250))
  })
  
  #TODO: Boxplot View
  output$box <- renderPlot({
    print("BOX wird aufgerufen")
Stephanie Wegscheidl's avatar
boxplot    
Stephanie Wegscheidl committed
451
452
453
    data<- structure(list(V1=as.numeric(coconut.df[[input$box_x]])),
                     .Names=c("V1"), row.names=c(NA,6L), class = "data.frame")
    
454
    boxplot(data$V1, type="box", xlab=input$box_x )
455
456
457
458
459
  })
  
  #MAP
  output$map_box <- renderUI({
    if(input$check_map)
460
461
      box(  width = 12,
            title="Map",
462
463
464
            status= "warning",
            solidHeader = TRUE,
            collapsible = TRUE,
465
           
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
466
            leafletOutput("map", height = 250))
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
467
468
  })
  
469
  # MAP VIEW 
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
470
  output$map <- renderLeaflet({
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
    print("MAP wird aufgerufen")
    data <- as.numeric(coconut.df[[input$map_data]])
    max_data<<- max(data)
    
    c<-1
    for(c in 1:length(data)){
      data[c]<-(data[c]/max_data)*10
    }
    
    colorData <-
      cut(
        data,
        c(0, 2, 5, 7, 10),
        include.lowest = T,
        lables = c('<2', '<5', '<7', '<10')
      )
    print("colorData")
    print(colorData)
    
    colorGrad <- colorFactor('RdYlGn', colorData) 
    
    print("colorGrad")
    print(colorGrad(colorData))
    
    
    m <- leaflet()
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
497
498
    x=1
    m <- addTiles(m)
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
499
500
501

    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)
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
502
    m
503
504
  })
  
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
505
  
506
  
507
508
509
510
511
512
  # TOOLTIP
  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
513
  
514
  #DownloadButton
515
516
  #TODO: MAKE IT WORK!
  observeEvent(input$screenshot,{
517
518
    #if(input$check_line|input$check_time|input$check_map|input$check_hist)
    #disable("screenshot")
519
    #webshot::install_phantomjs()
520
    
521
    cdat <<- session$clientData
522
    url <- paste0(cdat$url_hostname,":", cdat$url_port,"/")
523
    print(url)
524
    
525
526
    #URL <- "http://rstudio.github.io/leaflet/"
    #appshot("cocoVisR/", file = "dashboard.png", port = getOption("shiny.port"), envvars = NULL)
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
527
    #webshot(url,delay = 5.0)
528
    #knit("dashboard.png")
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
529
530
531
    #port <- cdat$url_port
    #mapshot(m, file="~/Rplot.png")
    
532
    #webshot(url, "dashboard.png", delay = 20.0) # does NOT WORK 
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
533
534
535
536
537
    #appdir <- system.file("examples", "01_hello", package="shiny")
    #print("appdir")
    #print(appdir)
    #appshot(appdir, "01_hello.png")
    
538
    #leaflet.print(m)
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
539
540
541
542
543
544
    
    
    
    
    
    
545
546
    
  })
547
  # url <- paste0(cdat$url_protocol,"//",cdat$url_hostname,":", cdat$url_port, cdat$url_pathname,cdat$url_search)
548
  #output$downButton <- downloadHandler(
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
549
550
551
552
553
554
555
  # filename="dashboard.png",
  #content=function(file){
  # observeEvent(input$downButton, {
  #appshot("cocoVisR/dashboard", file = "dashboard.png", port = getOption("shiny.port"), envvars = NULL)
  
  #}) 
  #}
556
  #)
557
558
559
560
561
  
  
  
  
  
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
562
563
  
  #SOME STUFF  
564
565
  
  
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
  #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
583
}