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)
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
  
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
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
    
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
  })
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
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 {
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
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
           
466
            leafletOutput("map", height = 250))
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
467 468
  })
  
469
  # MAP VIEW 
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)
527
    #webshot(url,delay = 5.0)
528
    #knit("dashboard.png")
529 530 531
    #port <- cdat$url_port
    #mapshot(m, file="~/Rplot.png")
    
532
    #webshot(url, "dashboard.png", delay = 20.0) # does NOT WORK 
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)
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
}