问题
I have the shiny app below in which the user uploads a file (here I just put the dt in a reactive function) and from there he can choose which columns he wants to display as selectInput() via a pickerInput(). Then he should be able to click on Update2 and see the map.
The user should also be able to update the depth values by multiplying all of them with the numericInput() value1 and create a new sliderInput() and therefore update the dataframe that is displayed in the table as well. These changes should be applied only when the user clicks on Update2 actionbutton.
When I click on a specific point I get a table below the map with relative data. The issue is that when I do another action,for example update the map or something, this table remains there while I want it to be disappeared and re-appeared when I click on a point again.
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)
回答1:
Hi I think the easiest way to do this is to use the package shinyjs there you can use the jQuery functions to hide and show objects you want. Please note that you have to activate shinyjs with the function useShinyjs() inthe UI part aswell
ui <- fluidPage(
shinyjs::useShinyjs(),# Set up shinyjs
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())
shinyjs::runjs("console.log('hiding table')")
shinyjs::runjs("$('#myTable').hide()")
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({
shinyjs::runjs("console.log('showing table')")
shinyjs::runjs("$('#myTable').show()")
return(
subset(dt_part,depth == data$clickedMarker$id)
)
})
})
}
# shinyApp()
shinyApp(ui = ui, server = server)
来源：https://stackoverflow.com/questions/63954760/hide-table-that-is-created-by-click-event-on-leaflet-map-after-data-is-updated-i