Link Selectinput with Sliderinput in Shiny

Link selectInput with sliderInput in shiny

You were really close with the update expression. All you need there is:

  observeEvent(input$Slider,{
updateSelectInput(session,'select',
choices=unique(1:input$Slider))
})

Another approach is to use uiOutput/renderUI. In the ui, instead of creating an empty selectInput, we can put a placeholder:

uiOutput("select_clusters")

Then in the server, we populate this placeholder:

output$select_clusters <- renderUI({
selectInput("select", label = h3("Select the cluster"), choices = 1:input$Slider)
})

Edit

To make an observeEvent (or eventReactive) react to multiple inputs, wrap the inputs or reactives in c():

observeEvent(c(input$SLIDER, input$FILTER),{
updateSelectInput(session,'select',
choices=unique(1:input$Slider))
})

But if you need to do that, I think it makes more sense, and gives flexibility, to go with the renderUI approach. This might look something like:

output$select_clusters <- renderUI({
req(input$slider)
req(input$filter)

df2 <- df[df$something %in% input$filter, ]

selectInput("select",
label = h3("Select the cluster"),
choices = df2$something)

})

In general, with the update*Input function, you can only update an existing widget, you can't remove it. But if the number of clusters = 1, then you do not need a select input at all. With renderUI you can use an empty HTML container (div()) to 'hide' the selectInput if the conditions require it:

what_to_do <- reactive({
req(input$Slider)
if (input$Slider == 1) {
x <- div()
} else {
x <- selectInput("select",
label = h3("Select the cluster"),
choices = 1:input$Slider)
}

return(x)
})

output$select_clusters <- renderUI({
what_to_do()
})

How to multiply a sliderinput with a selectinput where result is shown as a text output

you need to replace the last part of your code:

values <- reactiveValues()

observe({values$complete <- Data1$costpermile * input$num})

output$total <- renderText({ values$complete})

With only the output$total as follow:

output$total <- renderText({as.numeric(input$Select6) * input$num})

So the full code should be:

library(openxlsx)
library(tidyr)
library(plyr)
library(dplyr)

library(shiny)

Data1 = data.frame(Manu = c("ABARTH", "ABARTH", "ALFA", "ALFA"),
Model = c(1,2,3,4),
Des= c("a", "b", "c", "d"),
Trans = c("SAT5", "6AT", "M6", "M6"),
Fuel = c("Diesel", "Petrol", "Petrol", "Petrol"),
costpermile = c(0.12, 0.14, 0.13, 0.11))

ui <- fluidPage(
selectInput("Select1", "Manu", unique(Data1$Manu)),
selectInput("Select2", "Model", choices = NULL),
selectInput("Select3", "Des", choices= NULL),
selectInput("Select4", "Trans", choices= NULL),
selectInput("Select5", "Feul", choices= NULL),
selectInput("Select6", "costpermile", choices= NULL),
sliderInput("num", "Choose miles", value = 100, min = 0, max = 200, step= 50),
textOutput( "total")

)

server <- function(input, output,session) {
observeEvent(input$Select1,{
updateSelectInput(session,'Select2',
choices=unique(Data1$Model[Data1$Manu==input$Select1]))
})

observeEvent(input$Select2,{
updateSelectInput(session,'Select3',
choices=unique(Data1$Des[Data1$Manu==input$Select1 &
Data1$Model==input$Select2]))
})

observeEvent(input$Select3,{
updateSelectInput(session,'Select4',
choices=unique(Data1$Trans[Data1$Manu==input$Select1 &
Data1$Model==input$Select2 &
Data1$Des==input$Select3]))
})

observeEvent(input$Select4,{
updateSelectInput(session,'Select5',
choices=unique(Data1$Fuel[Data1$Manu==input$Select1 &
Data1$Model==input$Select2 &
Data1$Des==input$Select3 &
Data1$Trans==input$Select4]))
})

observeEvent(input$Select5,{
updateSelectInput(session,'Select6',
choices=unique(Data1$costpermile[Data1$Manu==input$Select1 &
Data1$Model==input$Select2 &
Data1$Des==input$Select3 &
Data1$Trans==input$Select4 &
Data1$Fuel == input$Select5
]))
})

output$out <- renderUI({
if (input$Select6 == TRUE){
sliderInput("num", "Choose miles", value = 100, min = 0, max = 200, step= 50)
}})

output$total <- renderText({as.numeric(input$Select6) * input$num})

}

shinyApp( ui= ui, server= server)

Display selectInput and sliderInput values on action button click

Instead of observe, you can make your output values as eventReactive.

Here is the server side codes (as nothing in ui side has to be changed).

shinyServer(function(input, output) {

val = eventReactive(input$act, {
paste("You selected the value" ,input$tm)
})

sam = eventReactive(input$act, {
input$samples
})

output$val = renderText(
val()
)
output$sam = renderText(
sam()
)
})

SliderInput and SelectInput in Shiny App not working

library(shiny);
library(DT)

ui <- fluidPage(titlePanel("mtcars table"), sidebarLayout( sidebarPanel(

column(width = 5,
selectInput(inputId = "gear",
label = "gear:",
choices = c("All" = 0,
unique(as.character(mtcars$gear))))),

column(width = 10,
selectInput(inputId = "am",
label = "am:",
choices = unique(as.character(mtcars$am)))),

column(width = 10,
sliderInput(inputId = "hp",
label = "hp:",
min = 52,
max = 335,
value = c(52,335),
step = 1)

)),

mainPanel (
DT::dataTableOutput("table"))))

server<-function(input, output) {

output$table <- DT::renderDataTable(DT::datatable({

data <- mtcars

if(input$gear != 0){
data<-data[data$gear == input$gear, ]
}
data<-data[data$am %in% input$am,]
data<-data[data$hp >= input$hp[[1]] & data$hp <= input$hp[[2]],]

data
}))

}

shinyApp(ui = ui, server = server)

Adjacent selectInput in Shiny and ShinySemantic

If you are using {shiny.semantic} then I'd recommend using Semantic UI classes for consistency:

shiny.semantic::form(
shiny.semantic::fields(
class = "two",
shiny.semantic::field(
selectInput(
inputId = ns("this_type"),
label = "Select this type",
choices = all_types
)
),
shiny.semantic::field(
selectInput(
inputId = ns("this_name"),
label = "Select this name",
choices = list()
)
)
)
)

Two Semantic UI dropdowns side by side

There's more about structuring input forms here.

Filter dataset for sliderInput after selectInput in Shiny?

Try this, which has the advantage that because Shiny is smart, will cache the output of data() so that even if you call it many times, is only evaluated once.

library(DT)
library(data.table)

ui <- bootstrapPage(
sidebarLayout(
sidebarPanel(
selectInput(inputId = "conf",
label = "Choose a conference",
choices = unique(as.character(colleges$conf)),
multiple = FALSE),
uiOutput("slider")
),
mainPanel(dataTableOutput("display"))
)
)

server = function(input, output){

data <- reactive({
validate(
need(input$conf, "Please select a conference.")
)
colleges[conf == input$conf]
})

output$slider = renderUI({
income <- data()$incomeMillions

minZ <- round(min(income), 2)
maxZ <- round(max(income), 2)

sliderInput("slider", h3("Z-score range"),
min = minZ, max = maxZ, value = minZ)
})

output$display <- renderDataTable({
data()
})
}

shinyApp(ui = ui, server = server)


Related Topics



Leave a reply



Submit