Insert new features from a selectInput in shiny

Question

Friends could help me with my shiny code below. It is executable code for manipulation. I am managing to generate the scatter plot normally, it varies according to my SliderInput. In my case, I am generating clusters. If sliderinput is selected as 5, the scatterplot will generate 5 clusters and so on. Everything is fine here. I also did a selectInput below the sliderinput to show the map for a specific cluster. However, I was unable to generate the scatterplot for a specific cluster, that is, if it selected 2 in my selectInput, I would like it to show only the map for cluster 2. Could you help me with this?

library(shiny)
library(ggplot2)
library(rdist)
library(geosphere)
library(kableExtra)
library(readxl)
library(tidyverse)
library(DT)
library(shinythemes)



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

  #database df
  df<-structure(list(Properties = c(1,2,3,4,5), 
                     Latitude = c(-23.8, -23.8, -23.9, -23.9, -23.9), 
                     Longitude = c(-49.6, -49.6, -49.6, -49.6, -49.6), 
                     Waste = c(526, 350, 526, 469, 285)), class = "data.frame", row.names = c(NA, -5L))

  #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 

  #database df1  
  df1<-df[c("Latitude","Longitude")]
  df1$cluster<-clusters

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


  #Scatter Plot for all
  suppressPackageStartupMessages(library(ggplot2))
  g<-ggplot(data=df1,  aes(x=Longitude, y=Latitude,  color=factor(clusters))) + geom_point(aes(x=Longitude, y=Latitude), size = 4)
  plotGD<-g

  #Scatter Plot for specific cluster
  suppressPackageStartupMessages(library(ggplot2))
  g<-ggplot(data=df1[df1$cluster == Filter3,],  aes(x=Longitude, y=Latitude,  color=factor(clusters))) + geom_point(aes(x=Longitude, y=Latitude), size = 4)
  plotGD1<-g

  return(list(
    "Plot" = plotGD,
    "Plot1" = plotGD1,
    "Data"=data_table
  ))
}

ui <- bootstrapPage(
  navbarPage(theme = shinytheme("flatly"), collapsible = TRUE,
             "Cl", 

             tabPanel("Solution",
                      sidebarLayout(
                        sidebarPanel(
                          radioButtons("filter1", h3("Select properties"),
                                       choices = list("All properties" = 1, 
                                                      "Exclude properties" = 2),
                                       selected = 1),

                          radioButtons("filter2", h3("Select properties"),
                                       choices = list("All properties" = 1, 
                                                      "Exclude properties" = 2),
                                       selected = 1),
                          tags$hr(),
                          tags$b(h3("Satisfied?")),
                          tags$b(h5("(a) Choose other filters")),
                          tags$b(h5("(b) Choose clusters")),  
                          sliderInput("Slider", h5(""),
                                      min = 2, max = 5, value = 3),

                        ),

                        mainPanel(
                          tabsetPanel(      
                            tabPanel("Solution", plotOutput("ScatterPlot"))))

                      ))),


  tabPanel("",
           sidebarLayout(
             sidebarPanel(
               selectInput("Filter3", label = h4("Select just one cluster to show"),""),
             ),

             mainPanel(
               tabsetPanel(
                 tabPanel("Map", plotOutput("ScatterPlot1"))))

           )))



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


  Modelcl<-reactive(function.cl(df,input$Slider,1,1,input$Filter3))


  output$ScatterPlot <- renderPlot({
    Modelcl()[[1]]
  })

  output$ScatterPlot1 <- renderPlot({
    Modelcl()[[2]]
  })

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


}

shinyApp(ui = ui, server = server)

Thank you very much!

Answer 1

A few thoughts:

• Your observeEvent can be dependent on just input$Slider - I was not sure what was intended with other numbers and data frame there

• Pass inputFilter3 to your function.cl - again keep in mind, as that function is involving reactive inputs, you might want to have as a reactive expression in server

• You will want to filter your data for the specific cluster plot, something like: df1[df1$cluster == Filter3,]

• To have the same color scheme between the two plots, you can make a color vector (using whatever palette you wish), and then reference it with scale_color_manual

This seems to work at my end. For your next example, try to simplify to "minimum" working example if possible to demonstrate what the problem is. Good luck!

library(shiny)
library(ggplot2)
library(rdist)
library(geosphere)
library(kableExtra)
library(readxl)
library(tidyverse)
library(DT)
library(shinythemes)

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

  #database df
  df<-structure(list(Properties = c(1,2,3,4,5), 
                     Latitude = c(-23.8, -23.8, -23.9, -23.9, -23.9), 
                     Longitude = c(-49.6, -49.6, -49.6, -49.6, -49.6), 
                     Waste = c(526, 350, 526, 469, 285)), class = "data.frame", row.names = c(NA, -5L))

  #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 

  #all cluster data df1 and specific cluster df_spec_clust
  df1<-df[c("Latitude","Longitude")]
  df1$cluster<-as.factor(clusters)
  df_spec_clust <- df1[df1$cluster == Filter3,]

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

  #Setup colors to share between both plots
  my_colors <- rainbow(length(df1$cluster))
  names(my_colors) <- df1$cluster

  #Scatter Plot for all clusters
  g <- ggplot(data = df1,  aes(x=Longitude, y=Latitude, color=cluster)) + 
    geom_point(aes(x=Longitude, y=Latitude), size = 4) +
    scale_color_manual("Legend", values = my_colors)
  plotGD <- g

  #Scatter Plot for specific cluster
  g <- ggplot(data = df_spec_clust,  aes(x=Longitude, y=Latitude, color=cluster)) + 
    geom_point(aes(x=Longitude, y=Latitude), size = 4) +
    scale_color_manual("Legend", values = my_colors)
  plotGD1 <- g

  return(list(
    "Plot" = plotGD,
    "Plot1" = plotGD1,
    "Data" = data_table
  ))
}

ui <- bootstrapPage(
  navbarPage(theme = shinytheme("flatly"), collapsible = TRUE,
             "Cl", 
             tabPanel("Solution",
                      sidebarLayout(
                        sidebarPanel(
                          radioButtons("filter1", h3("Select properties"),
                                       choices = list("All properties" = 1, 
                                                      "Exclude properties" = 2),
                                       selected = 1),

                          radioButtons("filter2", h3("Select properties"),
                                       choices = list("All properties" = 1, 
                                                      "Exclude properties" = 2),
                                       selected = 1),
                          tags$hr(),
                          tags$b(h3("Satisfied?")),
                          tags$b(h5("(a) Choose other filters")),
                          tags$b(h5("(b) Choose clusters")),  
                          sliderInput("Slider", h5(""),
                                      min = 2, max = 5, value = 3),
                        ),
                        mainPanel(
                          tabsetPanel(      
                            tabPanel("Solution", plotOutput("ScatterPlot"))))

                      ))),
  tabPanel("",
           sidebarLayout(
             sidebarPanel(
               selectInput("Filter3", label = h4("Select just one cluster to show"),""),
             ),
             mainPanel(
               tabsetPanel(
                 tabPanel("Map", plotOutput("ScatterPlot1"))))
           )))

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

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

  output$ScatterPlot <- renderPlot({
    Modelcl()[[1]]
  })

  output$ScatterPlot1 <- renderPlot({
    Modelcl()[[2]]
  })

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

}

shinyApp(ui = ui, server = server)