I am having issues with crosstalk and RShiny. I want to be able to use dynamic filtering and/or have the user select the data on a leaflet map to filter the data into a table that can be downloaded and used in other plots. My issue, is that when I filter the data and then use the select tool from crosstalk, the action button to save the data only takes the inputs from the sidebarpanel filters into consideration and completely ignores the crosstalk select that does properly show in the data table which is the data I want to export. I have also tried to use this (data <- SharedData$new(filter_by_all)) as the dataframe for my other plots, but it does not work. Right now I just want to focus on getting the data to properly export based on all filters AND the selection on the map. Here is my sample code:
library(crosstalk)
library(dplyr)
library(dygraphs)
library(ggExtra)
library(htmltools)
library(leaflet)
library(leafem)
library(plotly)
library(rgeos)
library(rgdal)
library(shiny)
library(shinyjs)
library(shinyWidgets)
library(shinythemes)
library(shinyBS)
library(wicket)
library(xts)
#Create a formatted timestamp for filename
humanTime <- function() format(Sys.time(), "%Y-%m-%d_%H-%M-%OS")
#Create a Dummy Dataset
get_data <- function(size){
longs <- seq(from=-20, to =160, by = 0.01)
lats <- seq(from = -10, to= 83, by = 0.01)
LONGITUDE <- sample(longs, size, rep = TRUE)
LATITUDE <- sample(lats, size, rep = TRUE)
df <- data.frame(cbind(LONGITUDE, LATITUDE))
df$DMS_LONGITUDE <- sapply(df$LONGITUDE, to_DMS, long_lat = "Longitude")
df$DMS_LATITUDE <- sapply(df$LATITUDE, to_DMS, long_lat = "Latitude")
df$LOCATION <- sample(c("A", "B", "C"), size, replace = T, prob = c(0.4, 0.4, 0.2))
df$EQUIPMENT <- sample(c("E1", "E2", "E3", "E4"), size, replace = TRUE)
startTime <- as.POSIXct("2016-01-01")
endTime <- as.POSIXct("2019-01-31")
df$DATE <- as.Date(sample(seq(startTime, endTime, 1), size)) #use as.Date to remove times
df$WEEKDAY <- weekdays(as.Date(df$DATE))
return(df)
}
df <-get_data(1000)
ui <- navbarPage(
id = "navBar",
title = "Data Exploration",
theme = shinytheme("cerulean"),
shinyjs::useShinyjs(),
selected = "Data",
tabPanel("Data",
fluidPage(
sidebarPanel(
div(id = "form",
dateRangeInput('timestamp', label = 'Date range input:', start = min(df$DATE), end = max(df$DATE)),
pickerInput('days_of_week', 'Choose Weekdays:', choices = unique(df$WEEKDAY), options = list(`actions-box` = TRUE), multiple = T),
pickerInput('location', "Select Location:", choices = unique(df$LOCATION), options = list(`actions-box` = TRUE), multiple = T),
pickerInput('equipment_type', "Choose Equipment:", choices = unique(df$EQUIPMENT), options = list(`actions-box` = TRUE), multiple = T),
actionButton("resetAll", "Reset Filters"),
selectInput("download_type", "Choose download formatt:", choices = c("CSV" = ".csv", "KML" = ".KML")),
downloadButton('downloadData', 'Download'))
),
mainPanel(
leafletOutput("datamap", width = "100%", height = 400),
DT::DTOutput("datatable")))
)
)#end the ui
server <- function(session, input, output){
filter_by_dates <- reactive({
filter(df, DATE >= input$timestamp[1] & DATE <= input$timestamp[2])
})
filter_by_all <- reactive({
fd <- filter_by_dates()
if (!is.null(input$days_of_week)) {
fd <- filter(fd, WEEKDAY %in% input$days_of_week)
}
if (!is.null(input$location)) {
fd <- filter(fd, LOCATION %in% input$location)
}
if (!is.null(input$equipment_type)) {
fd <- filter(fd, EQUIPMENT %in% input$equipment_type)
}
return(fd)
})
observe({
input$timestamp
updatePickerInput(session, 'days_of_week', 'Choose Weekdays:', choices = unique(filter_by_all()$WEEKDAY), selected = input$days_of_week)
updatePickerInput(session, 'location', "Select Location:", choices = unique(filter_by_all()$LOCATION), selected = input$location)
updatePickerInput(session, 'equipment_type', "Choose Equipment:", choices = unique(filter_by_all()$EQUIPMENT), selected = input$equipment_type)
})
data <- SharedData$new(filter_by_all)
output$datatable <- DT::datatable({
data
})
#Map is updated by User inputs
output$datamap <- renderLeaflet({
library(leaflet)
pal <- colorFactor(
palette = c('Yellow', 'Red'),
domain = data$EQUIPMENT
)
leaflet(data = data ) %>%
addCircleMarkers(
lng = ~LONGITUDE,
lat = ~LATITUDE,
radius = 3,
color = ~pal(data$EQUIPMENT),
label = paste("EQUIPMENT:", data$EQUIPMENT),
popup = paste(h4("Data:"),
"EQUIPMENT:", data$EQUIPMENT, "<br>",
"EQUIPMENT_COUNTS:", data$EQUIPMENT_COUNTS, "<br>",
"DATE:", data$DATE, "<br>",
"WEEKDAY:", data$WEEKDAY, "<br>",
"LONGITUDE:", data$LONGITUDE, "<br>",
"LATITUDE:", data$LATITUDE)) %>%
addTiles(group = "ESRI") %>%
addTiles(group = "OSM") %>%
addProviderTiles("Esri.WorldImagery", group = "ESRI") %>%
addProviderTiles("Stamen.Toner", group = "Stamen") %>%
#setView(mean(df$x), mean(df$y), zoom = 6) %>%
addMeasure(position = "bottomleft",
primaryLengthUnit = "meters",
primaryAreaUnit = "sqmeters",
activeColor = "#3D535D",
completedColor = "#7D4479") %>%
addMouseCoordinates() %>%
addLayersControl(baseGroup = c("ESRI", "OSM", "Stamen")) %>%
addMiniMap(toggleDisplay = TRUE)
})
#Download Data after Filtering as CSV
#Allow the user to reset all their inputs
observeEvent(input$resetAll, {
reset("form")
})
#Download Data after Filtering as CSV
output$downloadData <- downloadHandler(
filename = function() {
paste0("data_",humanTime(), input$download_type)
},
content = function(file) {
if (input$download_type == ".csv"){
write.csv(data, file, row.names = FALSE)
} else if (input$download_type == ".KML") {
features <- c("LOCATION","EQUIPMENT", "EQUIPMENT_COUNTS", "DATE", "WEEKDAY")
data[ ,features] <- sapply(data[ ,features], as.character)
coordinates(data) <- ~LONGITUDE + LATITUDE
proj4string(data) <- CRS("+proj=longlat +datum=WGS84")
writeOGR(data, dsn =file, layer= "Data", driver = "KML")
}
}
}#end server
shinyApp(ui, server)