如何解决串扰和 RShiny 将数据写入 csv 和 kml
我遇到串扰和 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 举报,一经查实,本站将立刻删除。