串扰和 RShiny 将数据写入 csv 和 kml

编程问答 2022-05-27

问题描述

我遇到串扰和 RShiny 的问题。我希望能够使用动态过滤和/或让用户选择传单地图上的数据以将数据过滤到可以下载并在其他图中使用的表格中。我的问题是，当我过滤数据然后使用串扰中的选择工具时，保存数据的操作按钮只考虑来自侧边栏过滤器的输入，并完全忽略正确显示在数据表中的串扰选择这是我要导出的数据。我也尝试使用这个 (data 

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,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,long_lat = "Latitude")
  df$LOCATION <- sample(c("A","B","C"),replace = T,prob = c(0.4,0.4,0.2))
  df$EQUIPMENT <- sample(c("E1","E2","E3","E4"),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),pickerInput('equipment_type',"Choose Equipment:",choices = unique(df$EQUIPMENT),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',choices = unique(filter_by_all()$WEEKDAY),selected = input$days_of_week)
    updatePickerInput(session,'location',choices = unique(filter_by_all()$LOCATION),selected = input$location)
    updatePickerInput(session,'equipment_type',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,"DATE:",data$DATE,"WEEKDAY:",data$WEEKDAY,"LONGITUDE:",data$LONGITUDE,"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)

解决方法

暂无找到可以解决该程序问题的有效方法，小编努力寻找整理中！

如果你已经找到好的解决方法，欢迎将解决方案带上本链接一起发送给小编。

小编邮箱:dio#foxmail.com (将#修改为@）

crosstalkexport-to-csvrrshiny