library(shiny) library(jsonlite) library(DT) library(webshot) server <- function(input, output, session) { set.seed(122) #DATA PAGE #last coconut_name output$lastLoadedNut<- renderText({ if (is.null(input$nut)) return(NULL) else lastCoConUT }) #CoConUT Data import output$nut <- renderDataTable({ inFile <- input$nut if (is.null(inFile)) return(NULL) #loading CoConUT data json_data_coco <- fromJSON(paste(inFile$datapath, sep = ""), flatten = TRUE) coconut.df <<- json_data_coco[["data"]] lastCoConUT <<- inFile$name print("coconut:") print(coconut.df) 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} # setting the table style datatable( cbind(coconut.df), options = list( searching = TRUE, autoWidth = TRUE, rownames = FALSE, scroller = TRUE, scrollX = TRUE, scrollY = "500px", fixedHeader = TRUE, class = 'cell-border stripe' ) ) }) #last cocoquest_name output$lastLoadedQuest <- renderText({ if (is.null(input$quest)) return(NULL) else lastCoCoQuest }) #CoCoQuest Data import output$quest <- renderDataTable({ inFile <- input$quest if (is.null(inFile)) return(NULL) #loading CoCoQuest data json_data_quest <<- fromJSON(paste(inFile$datapath, sep = ""), flatten = TRUE) lastCoCoQuest <<- inFile$name json_data_quest$unix_starttime <- as.numeric(json_data_quest$startTime)/1000 json_data_quest$unix_endtime <- as.numeric(json_data_quest$endTime)/1000 totalStarttime <<- anytime(json_data_quest$unix_starttime) totalEndtime <<- anytime(json_data_quest$unix_endtime) #unix parsed 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)) together <<- c(tasks, endtimes) all <- rbind(together) #setting the table style datatable( cbind(tasks, endtimes), options = list( searching = FALSE, rownames = TRUE, class = 'cell-border stripe' ) ) }) #cocoQuest Starttime output$totalStarttime <- renderText({ if (is.null(input$quest)) return(NULL) else as.POSIXct(totalStarttime) print(totalStarttime) }) #CONTROLLS PAGE #Title Input output$text <- renderText({ input$title }) #Histogram output$input_hist_x <- renderUI({ 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) }) output$input_hist_y <- renderUI({ if (is.null(input$nut)) return(NULL) 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) }) #Timeline output$input_time_x <- renderUI({ if (is.null(input$nut)) return(NULL) 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) }) 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_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) }) #Linegraph output$input_line_x <- renderUI({ if (is.null(input$nut)) return(NULL) 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) }) output$input_line_y <- renderUI({ if (is.null(input$nut)) return(NULL) 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) }) #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 #TODO: MAKE IT WORK! observeEvent(input$screenshot,{ webshot::install_phantomjs() 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") }) #output$downButton <- downloadHandler( # filename="dashboard.png", #content=function(file){ # observeEvent(input$downButton, { #appshot("cocoVisR/dashboard", file = "dashboard.png", port = getOption("shiny.port"), envvars = NULL) #}) #} #) #SOME STUFF #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 #} }