【发布时间】：2020-09-18 11:19:33
【问题描述】：
我有下面的闪亮应用程序，用户在其中上传文件（这里我只是将 dt 放入反应函数中），然后他可以从那里通过pickerInput() 选择他想显示为selectInput() 的列。然后他应该可以点击Update2并查看地图。
用户还应该能够通过将所有numericInput() 乘以value1 来更新depth 值，并创建一个新的sliderInput()，从而更新表中显示的数据框。仅当用户单击Update2 操作按钮时才应应用这些更改。
当我单击特定点时，我会在地图下方看到一个包含相关数据的表格。问题是，当我执行其他操作时，例如更新地图或其他操作，此表仍然存在，而我希望它消失并在我再次单击某个点时重新出现。
library(shiny)
library(shinyWidgets)
library(DT)
library(leaflet)
library(leaflet.extras)
# ui object
ui <- fluidPage(
titlePanel(p("Spatial app", style = "color:#3474A7")),
sidebarLayout(
sidebarPanel(
uiOutput("inputp1"),
#Add the output for new pickers
uiOutput("pickers"),
numericInput("num", label = ("value"), value = 1),
actionButton("button2", "Update 2")
),
mainPanel(
leafletOutput("map"),
tableOutput("myTable")
)
)
)
# server()
server <- function(input, output, session) {
DF1 <- reactiveValues(data=NULL)
dt <- reactive({
dt<-data.frame(quakes)
dt$ID <- seq.int(nrow(dt))
dt
})
observe({
DF1$data <- dt()
})
output$inputp1 <- renderUI({
pickerInput(
inputId = "p1",
label = "Select Column headers",
choices = colnames( dt()),
multiple = TRUE,
options = list(`actions-box` = TRUE)
)
})
observeEvent(input$p1, {
#Create the new pickers
output$pickers<-renderUI({
dt1 <- DF1$data
div(lapply(input$p1, function(x){
if (is.numeric(dt1[[x]])) {
sliderInput(inputId=x, label=x, min=min(dt1[[x]]), max=max(dt1[[x]]), value=c(min(dt1[[x]]),max(dt1[[x]])))
}else { # if (is.factor(dt1[[x]])) {
selectInput(
inputId = x, # The col name of selected column
label = x, # The col label of selected column
choices = dt1[,x], # all rows of selected column
multiple = TRUE
)
}
}))
})
})
dt2 <- eventReactive(input$button2, {
req(input$num)
dt <- DF1$data ## here you can provide the user input data read inside this observeEvent or recently modified data DF1$data
dt$depth<-dt$depth*isolate(input$num)
dt
})
observe({DF1$data <- dt2()})
observeEvent(input$button2, {
req(input$p1, sapply(input$p1, function(x) input[[x]]))
dt_part <- dt2()
colname <- colnames(dt2())
for (colname in input$p1) {
if (!is.null(input[[colname]][[1]]) && is.numeric(input[[colname]][[1]])) {
dt_part <- subset(dt_part, (dt_part[[colname]] >= input[[colname]][[1]]) & dt_part[[colname]] <= input[[colname]][[2]])
}else {
if (!is.null(input[[colname]])) {
dt_part <- subset(dt_part, dt_part[[colname]] %in% input[[colname]])
}
}
}
output$map<-renderLeaflet({input$button2
if (input$button2){
leaflet(dt_part) %>%
addProviderTiles(providers$CartoDB.DarkMatter) %>%
setView( 178, -20, 5 ) %>%
addHeatmap(
lng = ~long, lat = ~lat, intensity = ~mag,
blur = 20, max = 0.05, radius = 15
) %>%
addCircleMarkers(lng = dt_part$long, lat = dt_part$lat, layerId = dt_part$depth,
fillOpacity = 0, weight = 0,
popup = paste("ID:", dt_part$ID, "<br>",
"Depth:", dt_part$depth, "<br>",
"Stations:", dt_part$stations),
labelOptions = labelOptions(noHide = TRUE))
}
else{
return(NULL)
}
})
})
data <- reactiveValues(clickedMarker=NULL)
# observe the marker click info and print to console when it is changed.
observeEvent(input$map_marker_click,{
dt_part <- dt2()
print("observed map_marker_click")
data$clickedMarker <- input$map_marker_click
print(data$clickedMarker)
output$myTable <- renderTable({
return(
subset(dt_part,depth == data$clickedMarker$id)
)
})
})
}
# shinyApp()
shinyApp(ui = ui, server = server)
【问题讨论】：