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

library(shiny)
3
library(jsonlite)
4
library(DT)
5
library(webshot)
Stephanie's avatar
Stephanie committed
6

7

8
server <- function(input, output, session) {
Stephanie's avatar
Stephanie committed
9
  set.seed(122)
10
11
12
13
14
15
16
17
18

#DATA PAGE
  
  #last coconut_name
  output$lastLoadedNut<- renderText({
    if (is.null(input$nut))
      return(NULL)
    else lastCoConUT
  })
19
  
20
  #CoConUT Data import 
21
22
  output$nut <- renderDataTable({
    inFile <- input$nut
23
24
    if (is.null(inFile))
      return(NULL)
25
    
26
    #loading CoConUT data
27
    json_data_coco <- fromJSON(paste(inFile$datapath, sep = ""), flatten = TRUE)
28
    coconut.df <<- json_data_coco[["data"]]
29
30
    
    lastCoConUT <<- inFile$name
31
32
    print("coconut:")
    print(coconut.df)
33
    
34
35
36
37
38
39
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
    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}

    
86
    # setting the table style
87
88
89
90
91
92
93
94
95
96
97
98
99
    datatable(
              cbind(coconut.df), 
              options = list(
                searching = TRUE,
                autoWidth = TRUE,
                rownames = FALSE,
                scroller = TRUE,
                scrollX = TRUE,
                scrollY = "500px",
                fixedHeader = TRUE,
                class = 'cell-border stripe'
              )
    )
100
  })
101
102
103
104

  #last cocoquest_name
  output$lastLoadedQuest <- renderText({
    if (is.null(input$quest))
105
      return(NULL)
106
    else lastCoCoQuest
107
108
    
  })
109
110
111
112
  
  
  #CoCoQuest Data import
  output$quest <- renderDataTable({
113
114
115
116
    inFile <- input$quest
    if (is.null(inFile))
      return(NULL)
    
117
118
    #loading CoCoQuest data
    json_data_quest <<- fromJSON(paste(inFile$datapath, sep = ""), flatten = TRUE)
119
    
120
    lastCoCoQuest <<- inFile$name
121
    
122
123
    json_data_quest$unix_starttime <- as.numeric(json_data_quest$startTime)/1000
    json_data_quest$unix_endtime <- as.numeric(json_data_quest$endTime)/1000
124
125
126
    totalStarttime <<- anytime(json_data_quest$unix_starttime)
    totalEndtime <<- anytime(json_data_quest$unix_endtime)
    
127
    
128
    #unix  parsed
129
130
131
132
    dat <- do.call(rbind, json_data_quest$tasks$data)
  
    endtimes <<- c(anytime(dat$endtime/1000))
    tasks <- rep(1:length(json_data_quest$tasks$data), sapply(json_data_quest$tasks$data, nrow))
133

134
135
    together <<- c(tasks, endtimes)
  
136
137
    all <- rbind(together)

138
    #setting the table style
139
    datatable(
140
      cbind(tasks, endtimes),
141
      options = list(
142
143
        searching = FALSE,
        rownames = TRUE,
144
        class = 'cell-border stripe'
145
     )
146
147
    )
  })
148
149

  #cocoQuest Starttime
150
151
152
153
154
155
  output$totalStarttime <- renderText({
    if (is.null(input$quest))
      return(NULL)
    else as.POSIXct(totalStarttime)
    print(totalStarttime)
  })
156
  
157
158
159
#CONTROLLS PAGE
  
  #Title Input
160
  output$text <- renderText({ input$title })
161
  
162
  #Histogram
163
  
164
  output$input_hist_x <- renderUI({
165
166
167
    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) 
168
169
170
  })
  
  output$input_hist_y <- renderUI({
171
172
    if (is.null(input$nut))
      return(NULL)
173
    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) 
174
175
  })
  
176
  
177
178
  #Timeline

179
  output$input_time_x <- renderUI({
180
181
    if (is.null(input$nut))
      return(NULL)
182
    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) 
183
  })
184
  
185
  output$input_time_y <- renderUI({
186
187
    if (is.null(input$nut))
      return(NULL)
188
    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) 
189
190
  })
  
191
  
192
193
  #Map

194
  output$input_map_x <- renderUI({
195
196
    if (is.null(input$nut))
      return(NULL)
197
    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) 
198
199
200
  })
  
  output$input_map_y <- renderUI({
201
202
    if (is.null(input$nut))
      return(NULL)
203
    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) 
204
205
  })
  
206
  
207
208
  #Linegraph
 
209
  output$input_line_x <- renderUI({
210
211
    if (is.null(input$nut))
      return(NULL)
212
    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) 
213
214
215
  })
  
  output$input_line_y <- renderUI({
216
217
    if (is.null(input$nut))
      return(NULL)
218
    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) 
219
  })
220
  
221
  
222
  
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
  
#DASHBOARD PAGE  
  
  #HISTOGRAM
  output$hist_box <- renderUI({
    if(input$check_hist)
      box(  title="Histogram",
           status= "warning",
          solidHeader = TRUE,
          collapsible = TRUE,
          plotOutput("plot1", height = 250))
  })
  
  
  #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,
            plotOutput("plot1", height = 250))
  })
  
  #LINEGRAPH
  output$line_box <- renderUI({
    if(input$check_line)
      box(  title="Linegraph",
            status= "warning",
            solidHeader = TRUE,
            collapsible = TRUE,
            plotOutput("plot1", height = 250))
  })
  
  #DownloadButton
268
269
  #TODO: MAKE IT WORK!
  observeEvent(input$screenshot,{
270
    webshot::install_phantomjs()
271
272
273
274
275
    cdat <<- session$clientData
    #print(cdat)
    url <- paste0(cdat$url_protocol,"//",cdat$url_hostname,":", cdat$url_port, cdat$url_pathname,cdat$url_search)
    print(url)
    webshot::webshot(url, "webshot.png")
276
277
278
279
280
281
282
283
284
285
286
287
    
  })
  
  #output$downButton <- downloadHandler(
   # filename="dashboard.png",
    #content=function(file){
     # observeEvent(input$downButton, {
      #appshot("cocoVisR/dashboard", file = "dashboard.png", port = getOption("shiny.port"), envvars = NULL)
 
      #}) 
    #}
  #)
288
 
289
290
291
292
293
294
295
296
  
  
  
  
  
#SOME STUFF  
  
  
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
  #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
314
}