1

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!

HubertL
  • 19,246
  • 3
  • 32
  • 51

1 Answers1

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"))))
HubertL
  • 19,246
  • 3
  • 32
  • 51
  • Thank you very much friend. Would you know how to resolve the second issue as well? –  May 12 '20 at 00:28
  • Please ask a single question per question, and name it accordingly. There is more chance others will find it that way. I will edit your question as an example. – HubertL May 12 '20 at 17:52
  • Perfect, I will do this soon, anyway I will post the question link here, in case you know, thanks HubertL! –  May 12 '20 at 17:57
  • HubertL, I asked the question I mentioned earlier (https://stackoverflow.com/questions/61759818/color-problem-in-a-map-made-by-leaflet-in-shiny). In addition to this question, I did another one (https://stackoverflow.com/questions/61759818/color-problem-in-a-map-made-by-leaflet-in-shiny) to insert a new feature on the map. Sorry to send these questions, but if you can take a look at these two questions I would appreciate it. Thank you very much friend! –  May 12 '20 at 19:01
  • Sorry, I sent the same question twice, the other one is this: https://stackoverflow.com/questions/61758233/how-to-adjust-the-addpolylines-function-in-shiny –  May 12 '20 at 19:42