library(shiny) library(jsonlite) library(DT) library(webshot) library(knitr) library(leaflet) library(mapview) library(ggplot2) library(timevis) library(plotly) server <- function(input, output, session) { set.seed(122) #Continue to data page observeEvent(input$dataSite, { updateTabItems(session, "tabs",selected = "data") }) #DATA PAGE #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:") #coconut.df$timestamp <- format(coconut.df$timestamp, format="%d-%B-%Y %H:%M:%S") #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 coconut_name output$lastLoadedNut<- renderText({ if (is.null(input$nut)) return(NULL) else lastCoConUT }) #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 totalST <<- c(anytime(as.numeric(json_data_quest$startTime)/1000)) print(json_data_quest) #unix parsed dat <- do.call(rbind, json_data_quest$tasks$data) endtimes <<- c(dat$endtime) parsedEndtimes <<- anytime(endtimes/1000) #endtimes <<- format(dat$endtime, format="%d-%B-%Y %H:%M:%S") print("endtime quest") print(parsedEndtimes) tasks <- rep(1:length(json_data_quest$tasks$data), sapply(json_data_quest$tasks$data, nrow)) #questions #print("Questions:", questions) together <<- c(tasks, endtimes) print("together") print(together) all <- rbind(together) #setting the table style datatable( cbind(tasks, endtimes), options = list( searching = FALSE, rownames = TRUE, class = 'cell-border stripe' ) ) }) #last cocoquest_name output$lastLoadedQuest <- renderText({ if (is.null(input$quest)) return(NULL) else lastCoCoQuest }) #cocoQuest Starttime output$totalStarttime <- renderText({ if (is.null(input$quest)) return(NULL) else { format(totalST, format="%d-%B-%Y %H:%M:%S") } }) #Continue to view page observeEvent(input$viewSite, { updateTabItems(session, "tabs",selected = "views") }) #View PAGE #Title Input output$title <- renderText({ input$title }) #barchart 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 <- 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) }) 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) }) #linechart 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) }) #Continue to dashboard page observeEvent(input$dashboardSite, { updateTabItems(session, "tabs",selected = "dashboard") }) plotCounter <<- 0 #ADD BARCHART BUTTON observeEvent(input$check_hist, { plotCounter<<-plotCounter+1 print(plotCounter) plotname <- paste("plot", plotCounter, sep="") print(plotname) xplotname<- paste("x",plotname,sep="") yplotname<-paste("y",plotname, sep="") insertUI( selector= "#viewpanel", #wo will ichs hinhaben ui= box( title="Barchart", status= "warning", solidHeader = TRUE, collapsible = TRUE, selectInput(xplotname, "x-axis", choices=colnames(coconut.df)), selectInput(yplotname, "y-axis", choices=colnames(coconut.df)), plotOutput(plotname, height = 250)) ) }) #DASHBOARD #BAR VIEW 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) }) }) ## 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) #TIMELINE output$time_box <- renderUI({ if(input$check_time) box( title="Timeline", status= "warning", solidHeader = TRUE, collapsible = TRUE, timevisOutput("time", height = 250) ) }) #TODO: Timelineview output$time <- renderTimevis({ print("TIME wird aufgerufen") 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) }) output$texttimeline <- renderText({ "Check Timeline for getting a Timeline about CoCoQuest Tasks and Questions." }) #linechart output$line_box <- renderUI({ if(input$check_line) box( title="Linechart", status= "warning", solidHeader = TRUE, collapsible = TRUE, selectInput("line_x", "x-axis", choices=colnames(coconut.df)), selectInput("line_y", "y-axis", choices=colnames(coconut.df)), #add_tooltip(data_tooltip, "hover"), plotOutput("line", height = 250)) }) #TODO: linechart View output$line <- renderPlot({ print("LINE wird aufgerufen") 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) }) # Scatterplot output$scat_box <- renderUI({ if(input$check_scat) box( title="Scatterplot", status= "warning", solidHeader = TRUE, collapsible = TRUE, selectInput("scat_x", "x-axis", choices=colnames(coconut.df)), selectInput("scat_y", "y-axis", choices=colnames(coconut.df)), plotOutput("scat", height = 250)) }) #TODO: Scatterplot View output$scat <- renderPlot({ data<- structure(list(V1=as.numeric(coconut.df[[input$scat_x]]), V2=as.numeric(coconut.df[[input$scat_y]])), .Names=c("V1","V2"), row.names=c(NA,6L), class = "data.frame") print("SCAT wird aufgerufen") plot(data$V1,data$V2, type="p", xlab=input$scat_x, ylab=input$scat_y ) }) # Boxplot output$box_box <- renderUI({ if(input$check_box) box( title="Boxplot", status= "warning", solidHeader = TRUE, collapsible = TRUE, selectInput("box_x", "x-axis", choices=colnames(coconut.df)), plotOutput("box", height = 250)) }) #TODO: Boxplot View output$box <- renderPlot({ print("BOX wird aufgerufen") data<- structure(list(V1=as.numeric(coconut.df[[input$box_x]])), .Names=c("V1"), row.names=c(NA,6L), class = "data.frame") boxplot(data$V1, type="box", xlab=input$box_x ) }) #MAP output$map_box <- renderUI({ if(input$check_map) box( title="Map", status= "warning", solidHeader = TRUE, collapsible = TRUE, selectInput("map_data", "data", choices=colnames(coconut.df)), leafletOutput("map", height = 250)) }) # MAP VIEW output$map <- renderLeaflet({ 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() x=1 m <- addTiles(m) 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) m }) # TOOLTIP data_tooltip <- function(x){ if(is.null(x)) return(NULL) if(is.null(x$ID)) return(NULL) paste0(coconut.df[[input$line_x]]) } #DownloadButton #TODO: MAKE IT WORK! observeEvent(input$screenshot,{ #if(input$check_line|input$check_time|input$check_map|input$check_hist) #disable("screenshot") #webshot::install_phantomjs() cdat <<- session$clientData url <- paste0(cdat$url_hostname,":", cdat$url_port,"/") print(url) #URL <- "http://rstudio.github.io/leaflet/" #appshot("cocoVisR/", file = "dashboard.png", port = getOption("shiny.port"), envvars = NULL) #webshot(url,delay = 5.0) #knit("dashboard.png") #port <- cdat$url_port #mapshot(m, file="~/Rplot.png") #webshot(url, "dashboard.png", delay = 20.0) # does NOT WORK #appdir <- system.file("examples", "01_hello", package="shiny") #print("appdir") #print(appdir) #appshot(appdir, "01_hello.png") #leaflet.print(m) }) # url <- paste0(cdat$url_protocol,"//",cdat$url_hostname,":", cdat$url_port, cdat$url_pathname,cdat$url_search) #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 #} }