How to display a map only when a filter is selected

问题

Friends,

This code generates 2 maps. The first contains all clusters, while the second only displays the currently selected cluster. I would like this second map to appear only when a cluster is selected.

library(shiny)
library(ggplot2)
library(rdist)
library(geosphere)
library(shinythemes)
library(leaflet)

function.cl<-function(df,k,Filter1,Filter2){

  #database df
  df<-structure(list(Properties = c(1,2,3,4,5,6,7), 
                     Latitude = c(-23.8, -23.8, -23.9, -23.9, -23.9,-23.4,-23.5), 
                     Longitude = c(-49.6, -49.3, -49.4, -49.8, -49.6,-49.4,-49.2), 
                     Waste = c(526, 350, 526, 469, 285, 433, 456)), class = "data.frame", row.names = c(NA, -7L))


  #clusters
  coordinates<-df[c("Latitude","Longitude")]
  d<-as.dist(distm(coordinates[,2:1]))
  fit.average<-hclust(d,method="average") 
  clusters<-cutree(fit.average, k) 
  nclusters<-matrix(table(clusters))  
  df$cluster <- clusters 

  #specific cluster and specific propertie
  df1<-df[c("Latitude","Longitude")]
  df1$cluster<-as.factor(clusters)
  df_spec_clust <- df[df$cluster == Filter1,]
  df_spec_prop<-df1[df$Properties==Filter2,]

  #Table to join df and df1
  data_table <- Reduce(merge, list(df, df1))

  #Color and Icon for map
  ai_colors <-c("red","gray","blue","orange","green","beige","darkgreen","lightgreen", "lightred", "darkblue","lightblue",
                "purple","darkpurple","pink", "cadetblue","white","darkred", "lightgray","black")
  clust_colors <- ai_colors[df$cluster]
  icons <- awesomeIcons(
    icon = 'ios-close',
    iconColor = 'black',
    library = 'ion',
    markerColor =  clust_colors)

  leafIcons <- icons(
    iconUrl = ifelse(df1$Properties,
                     "https://image.flaticon.com/icons/svg/542/542461.svg"
    ),
    iconWidth = 45, iconHeight = 40,
    iconAnchorX = 25, iconAnchorY = 12)
  html_legend <- "<img src='https://image.flaticon.com/icons/svg/542/542461.svg'>"

  # Map for all clusters:
  m1<-leaflet(df1) %>% addTiles() %>%
    addMarkers(~Longitude, ~Latitude, icon = leafIcons) %>%
    addAwesomeMarkers(lat=~df$Latitude, lng = ~df$Longitude, icon=icons, label=~as.character(df$cluster)) %>% 
    addLegend( position = "topright", title="Cluster", colors = ai_colors[1:max(df$cluster)],labels = unique(df$cluster))
  plot1<-m1

  # Map for specific cluster and propertie
  m2<-leaflet(df_spec_clust) %>% addTiles() %>%
    addMarkers(~Longitude, ~Latitude, icon = leafIcons) %>%
    addAwesomeMarkers(lat=~df_spec_prop$Latitude, lng = ~df_spec_prop$Longitude, icon=icons, label=~as.character(df$cluster)) 
  plot2<-m2


  return(list(
    "Plot1" = plot1,
    "Plot2" = plot2,
    "Data" = data_table
  ))
}

ui <- bootstrapPage(
  navbarPage(theme = shinytheme("flatly"), collapsible = TRUE,
             "Cl", 
             tabPanel("Solution",
                      sidebarLayout(
                        sidebarPanel(
                          tags$b(h3("Choose the cluster number?")),
                          sliderInput("Slider", h5(""),
                                      min = 2, max = 5, value = 3),
                        ),
                        mainPanel(
                          tabsetPanel(      
                            tabPanel("Solution", (leafletOutput("Leaf1",width = "95%", height = "600")))))

                      ))),
  tabPanel("",
           sidebarLayout(
             sidebarPanel(
               selectInput("Filter1", label = h4("Select just one cluster to show"),""),
               selectInput("Filter2",label=h4("Select the cluster property designated above"),""),
             ),
             mainPanel(
               tabsetPanel(
                 tabPanel("Map", (leafletOutput("Leaf2",width = "95%", height = "600")))))
           )))

server <- function(input, output, session) {

  Modelcl<-reactive({
    function.cl(df,input$Slider,input$Filter1,input$Filter2)
  })

  output$Leaf1 <- renderLeaflet({
    Modelcl()[[1]]
  })

  output$Leaf2 <- renderLeaflet({
    Modelcl()[[2]]
  })

  observeEvent(input$Slider, {
    abc <- req(Modelcl()$Data)
    updateSelectInput(session,'Filter1',
                      choices=sort(unique(abc$cluster)))
  }) 

  observeEvent(input$Filter1,{
    abc <- req(Modelcl()$Data) %>% filter(cluster == as.numeric(input$Filter1))
    updateSelectInput(session,'Filter2',
                      choices=sort(unique(abc$Properties)))
  }) 


}

shinyApp(ui = ui, server = server)

I also have a little problem with the colors of the second map. Regardless of which cluster I choose, the color is always blue, however I would like the colors to be the same as the respective cluster shown on first map. If you could solve this problem at the same time it would be even greater.

Thank you!

回答1:

You can add an empty choice in the selectInput:

observeEvent(input$Slider, {
    abc <- req(Modelcl()$Data)
    updateSelectInput(session,'Filter1',
                      choices=c("No Filter" = "", sort(unique(abc$cluster)))) 
}) 

You can use renderUIto create the map if the filter is not empty:

output$myOptionalMap <- renderUI({ 
    if(input$Filter1!="") 
        leafletOutput("Leaf2",width = "95%", height = "600") })

And change UI to display this optional map:

mainPanel(
    tabsetPanel(
        tabPanel("Map", uiOutput("myOptionalMap"))))

来源：https://stackoverflow.com/questions/61741392/how-to-display-a-map-only-when-a-filter-is-selected