server.R 11.4 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)
Stephanie's avatar
Stephanie committed
10

11

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

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

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

    
94
    # setting the table style
95 96 97 98 99 100 101 102 103 104 105 106 107
    datatable(
              cbind(coconut.df), 
              options = list(
                searching = TRUE,
                autoWidth = TRUE,
                rownames = FALSE,
                scroller = TRUE,
                scrollX = TRUE,
                scrollY = "500px",
                fixedHeader = TRUE,
                class = 'cell-border stripe'
              )
    )
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
    
125
    lastCoCoQuest <<- inFile$name
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
126 127
    totalST <<- c(anytime(as.numeric(json_data_quest$startTime)/1000))
   
128
    #unix  parsed
129 130
    dat <- do.call(rbind, json_data_quest$tasks$data)
  
131 132 133 134 135
    endtimes <<- c(anytime(dat$endtime))
    
    #endtimes <<- format(dat$endtime, format="%d-%B-%Y %H:%M:%S")
    print("endtime quest")
    print(endtimes)
136
    tasks <- rep(1:length(json_data_quest$tasks$data), sapply(json_data_quest$tasks$data, nrow))
137

138
    together <<- c(tasks, endtimes)
139 140
    print("together")
    print(together)
141 142
    all <- rbind(together)

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

  #cocoQuest Starttime
162 163 164
  output$totalStarttime <- renderText({
    if (is.null(input$quest))
      return(NULL)
165
    else {
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
166
      format(totalST, format="%d-%B-%Y %H:%M:%S")
167 168
      
    }
169
  })
170
  
171 172
  #Continue to view page  
  observeEvent(input$viewSite, {
173
    
174
    updateTabItems(session, "tabs",selected = "views")
175 176 177
    
  })
  
178 179 180
#CONTROLLS PAGE
  
  #Title Input
181
  output$text <- renderText({ input$title })
182
  
183
  #barchart
184
  
185
  output$input_hist_x <- renderUI({
186 187 188
    if (is.null(input$nut))
      return(NULL)
    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) 
189 190 191
  })
  
  output$input_hist_y <- renderUI({
192 193
    if (is.null(input$nut))
      return(NULL)
194
    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) 
195 196
  })
  
197
  
198 199
  #Timeline

200
  output$input_time_x <- renderUI({
201 202
    if (is.null(input$nut))
      return(NULL)
203
    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) 
204
  })
205
  
206
  output$input_time_y <- renderUI({
207 208
    if (is.null(input$nut))
      return(NULL)
209
    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) 
210 211
  })
  
212
  
213
  #Map
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
214 215 216 217 218 219 220 221 222 223
  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) 
    })
  #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) 
  #})
224
  
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
225 226 227 228 229
 # 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) 
  #})
230
  
231
  
232
  #linechart
233
 
234
  output$input_line_x <- renderUI({
235 236
    if (is.null(input$nut))
      return(NULL)
237
    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) 
238 239 240
  })
  
  output$input_line_y <- renderUI({
241 242
    if (is.null(input$nut))
      return(NULL)
243
    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) 
244
  })
245
  
246
  
247 248 249 250 251 252
  #Continue to dashboard page  
  observeEvent(input$dashboardSite, {
    
    updateTabItems(session, "tabs",selected = "dashboard")
    
  })
253 254 255
  
#DASHBOARD PAGE  
  
256
  #barchart
257 258
  output$hist_box <- renderUI({
    if(input$check_hist)
259
      box(  title="Barchart",
260 261 262
           status= "warning",
          solidHeader = TRUE,
          collapsible = TRUE,
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 289
          plotOutput("hist", height = 250))
  })
  
  #HIS VIEW
  output$hist <- renderPlot({
    print("hist wird aufgerufen")
    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)
    
    
    
    
    
    
290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309
  })
  
  
  #TIMELINE
  output$time_box <- renderUI({
    if(input$check_time)
      box(  title="Timeline",
            status= "warning",
            solidHeader = TRUE,
            collapsible = TRUE,
            plotOutput("plot1", height = 250))
  })
  
  #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
310
            leafletOutput("map", height = 250))
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
311 312
  })
  
313
  # MAP VIEW 
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
314
  output$map <- renderLeaflet({
315
    print("map wird aufgerufen")
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
316
    m <<- leaflet()
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
317 318
    x=1
    m <- addTiles(m)
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
319
    for(x in 1:length(coconut.df$gps.latitude)){
320
      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
321 322
      x=x+1}
    m
323 324
  })
  
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
325
  
326
  #linechart
327 328
  output$line_box <- renderUI({
    if(input$check_line)
329
      box(  title="Linechart",
330 331 332 333 334 335
            status= "warning",
            solidHeader = TRUE,
            collapsible = TRUE,
            plotOutput("plot1", height = 250))
  })
  
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
336 337
 
  
338
  #DownloadButton
339 340
  #TODO: MAKE IT WORK!
  observeEvent(input$screenshot,{
341
    #webshot::install_phantomjs()
342
    cdat <<- session$clientData
343
    url <- paste0(cdat$url_hostname,":", cdat$url_port,"/")
344
    print(url)
345 346
    #URL <- "http://rstudio.github.io/leaflet/"
    #appshot("cocoVisR/", file = "dashboard.png", port = getOption("shiny.port"), envvars = NULL)
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
347
    #webshot(url,delay = 5.0)
348
    #knit("dashboard.png")
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
349 350 351
    #port <- cdat$url_port
    #mapshot(m, file="~/Rplot.png")
    
352
    #webshot(url, "dashboard.png", delay = 20.0) # does NOT WORK 
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
353 354 355 356 357
    #appdir <- system.file("examples", "01_hello", package="shiny")
    #print("appdir")
    #print(appdir)
    #appshot(appdir, "01_hello.png")
    
358
    #leaflet.print(m)
Stephanie Wegscheidl's avatar
Stephanie Wegscheidl committed
359 360 361 362 363 364
    
    
    
    
    
    
365 366
    
  })
367
  # url <- paste0(cdat$url_protocol,"//",cdat$url_hostname,":", cdat$url_port, cdat$url_pathname,cdat$url_search)
368 369 370 371 372 373 374 375 376
  #output$downButton <- downloadHandler(
   # filename="dashboard.png",
    #content=function(file){
     # observeEvent(input$downButton, {
      #appshot("cocoVisR/dashboard", file = "dashboard.png", port = getOption("shiny.port"), envvars = NULL)
 
      #}) 
    #}
  #)
377
 
378 379 380 381 382 383 384 385
  
  
  
  
  
#SOME STUFF  
  
  
386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402
  #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
403
}