Link selectInput with sliderInput in shiny

Guys, I would like to ask a question. Any answer is welcome. I linked my selectInput with my SliderInput, that is, from the moment I change my SliderInput (number of clusters), the corresponding number of clusters will appear in my selectInput. I managed to do it, but I would like, for example, 5 clusters to appear instead and show it as a list, like this:
1
2
3
4
5

and not just 5

It's possible?? My executable code is below

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

#database
df<-structure(list(Properties = c(1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35), Latitude = c(-23.8, -23.8, -23.9, -23.9, -23.9,  -23.9, -23.9, -23.9, -23.9, -23.9, -23.9, -23.9, -23.9, -23.9, 
                                                                                                                                                 + -23.9, -23.9, -23.9, -23.9, -23.9,-23.9,-23.9,-23.9,-23.9,-23.9,-23.9,-23.9,-23.9,-23.9,-23.9,-23.9,-23.9,-23.9,-23.9,-23.9,-23.9), Longitude = c(-49.6, -49.6, -49.6, -49.6, -49.6, -49.6, -49.6, -49.6, -49.6, -49.6, -49.7, 
                                                                                                                                                                                                                                                                                                     + -49.7, -49.7, -49.7, -49.7, -49.6, -49.6, -49.6, -49.6,-49.6,-49.6,-49.6,-49.6,-49.6,-49.6,-49.6,-49.6,-49.6,-49.6,-49.6,-49.6,-49.6,-49.6,-49.6,-49.6), Waste = c(526, 350, 526, 469, 285, 175, 175, 350, 350, 175, 350, 175, 175, 364, 
                                                                                                                                                                                                                                                                                                                                                                                                                                                                          + 175, 175, 350, 45.5, 54.6,350,350,350,350,350,350,350,350,350,350,350,350,350,350,350,350)), class = "data.frame", row.names = c(NA, -35L))

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

  if (Filter1==2){
    Q1<-matrix(quantile(df$Waste, probs = 0.25)) 
    Q3<-matrix(quantile(df$Waste, probs = 0.75))
    L<-Q1-1.5*(Q3-Q1)
    S<-Q3+1.5*(Q3-Q1)
    df_1<-subset(df,Waste>L[1]) 
    df<-subset(df_1,Waste<S[1])
  }

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


  #Number of clusters
  clusters<-cutree(fit.average, k) 
  nclusters<-matrix(table(clusters))  
  df$cluster <- clusters 

  #Localization
  center_mass<-matrix(nrow=k,ncol=2)
  for(i in 1:k){
    center_mass[i,]<-c(weighted.mean(subset(df,cluster==i)$Latitude,subset(df,cluster==i)$Waste),
                       weighted.mean(subset(df,cluster==i)$Longitude,subset(df,cluster==i)$Waste))}
  coordinates$cluster<-clusters 
  center_mass<-cbind(center_mass,matrix(c(1:k),ncol=1)) 

  #Coverage
  coverage<-matrix(nrow=k,ncol=1)
  for(i in 1:k){
    aux_dist<-distm(rbind(subset(coordinates,cluster==i),center_mass[i,])[,2:1])
    coverage[i,]<-max(aux_dist[nclusters[i,1]+1,])}
  coverage<-cbind(coverage,matrix(c(1:k),ncol=1))
  colnames(coverage)<-c("Coverage_meters","cluster")

  #Sum of Waste from clusters
  sum_waste<-matrix(nrow=k,ncol=1)
  for(i in 1:k){
    sum_waste[i,]<-sum(subset(df,cluster==i)["Waste"])
  }
  sum_waste<-cbind(sum_waste,matrix(c(1:k),ncol=1))
  colnames(sum_waste)<-c("Potential_Waste_m3","cluster")

  #Output table
  data_table <- Reduce(merge, list(df, coverage, sum_waste))
  data_table <- data_table[order(data_table$cluster, as.numeric(data_table$Properties)),]
  data_table_1 <- aggregate(. ~ cluster + Coverage_meters + Potential_Waste_m3, data_table[,c(1,7,6,2)], toString)

  #Scatter Plot
  suppressPackageStartupMessages(library(ggplot2))
  df1<-as.data.frame(center_mass)
  colnames(df1) <-c("Latitude", "Longitude", "cluster")
  g<-ggplot(data=df,  aes(x=Longitude, y=Latitude,  color=factor(clusters))) + geom_point(aes(x=Longitude, y=Latitude), size = 4)
  Centro_View<- g +  geom_text(data=df, mapping=aes(x=eval(Longitude), y=eval(Latitude), label=Waste), size=3, hjust=-0.1)+ geom_point(data=df1, mapping=aes(Longitude, Latitude), color= "green", size=4) + geom_text(data=df1, mapping = aes(x=Longitude, y=Latitude, label = 1:k), color = "black", size = 4)
  plotGD<-print(Centro_View + ggtitle("Scatter Plot") + theme(plot.title = element_text(hjust = 0.5)))

  return(list(
    "Data" = data_table_1,
    "Plot" = plotGD,
    "Coverage" = coverage
  ))
}

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

             tabPanel("General Solution",

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

                          radioButtons("filtro2", h3("Coverage"),
                                       choices = list("Limite coverage" = 1, 
                                                      "No limite coverage" = 2
                                       ),selected = 1),
                          radioButtons("gasoduto", h3("Preference for the location"),
                                       choices = list("big production" = 1, 
                                                      "small production"= 2
                                       ),selected = 1),

                          tags$hr(),
                          tags$b(h3("Satisfied?")),
                          radioButtons("satisfaction","", choices = list("Yes" = 1,"No " = 2),selected = 1),
                          tags$b(h5("(a) Choose other filters")),
                          tags$b(h5("(b) Choose clusters")),  
                          sliderInput("Slider", h5(""),
                                      min = 2, max = 8, value = 5),
                          tags$hr(),
                          actionButton("reset", "Clean")
                        ),

                        mainPanel(
                          tabsetPanel(      
                            tabPanel("Solution", DTOutput("tabela"))))

                      )),

             tabPanel("Route and distance",
                      sidebarLayout(
                        sidebarPanel(
                          selectInput("select", label = h3("Select the cluster"),"")
                        ),
                        mainPanel(
                          tabsetPanel(
                          tabPanel("Distance", plotOutput(""))))
                      ))))

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

  f1<-renderText({input$filter1})
  f2<-renderText({input$filter2})


  Modelclustering<-reactive(function.clustering(df,input$Slider,1,1))


  output$tabela <- renderDataTable({
    data_table_1 <- req(Modelclustering())[[1]]
    x <- datatable(data_table_1[order(data_table_1$cluster),c(1,4,2,3)],
                   options = list(columnDefs = list(list(className = 'dt-center', targets = 0:3)), 
                                  paging =TRUE,searching = FALSE,
                                  pageLength =  10,lenghtMenu=c(5,10,15,20),scrollx=T
                   ), rownames = FALSE)%>% formatRound(c(3:4), 2,mark = ",")%>%
      formatStyle(columns = c(3:4), 'text-align' = 'center')
    return(x)
  })

  output$ScatterPlot <- renderPlot({
    Modelclustering()[[2]]
  })

observeEvent(input$Slider,{
  updateSelectInput(session,'select',
                    choices=unique(df[df==input$Slider]))
}) 


}

shinyApp(ui = ui, server = server)

Thank you very much friends!

Could someone please help me?

Oh yes, I tell you what the ObservEvent would look like considering filter 1 and filter 2 too

I got it now! it looked like this:

observeEvent (c (input$filter1, input$filter2, input$Slider), {
     mcd <- req (Modelclustering () $ Data)
     updateSelectInput (session, 'select',
                       choices = sort (unique (mcd $ cluster)))
   })

Thank you so much!

This topic was automatically closed 7 days after the last reply. New replies are no longer allowed.

Thank you very much nigrahamuk. It worked. One more quick question, my observeEvent in the example above depends exclusively on my Slider. But if by chance it also depended on filter1, filter2, for example, how would the observeEvent be?

you were missing a library(shinythemes)
Here is the code I recommend you change

  observeEvent(input$Slider,{
    mcd <- req(Modelclustering()$Data)
    updateSelectInput(session,'select',
                      selected = input$Slider,
                      choices=sort(unique(mcd$cluster)))
  })

Thank you very much!! Please, if possible, could you give me an example if you also consider filter 1 and filter 2 in the example above, just to get a sense?

you would just use an observe if you wanted multiple hooks to retrigger calculations

  Modelclustering<-reactive(function.clustering(df,input$Slider,1,1))

?

  Modelclustering<-reactive(function.clustering(df,input$Slider,input$filtro1,1))