R Shiny Passing Reactive to Selectinput Choices

R shiny passing reactive to selectInput choices

You need to use renderUI on the server side for dynamic UIs. Here is a minimal example. Note that the second drop-down menu is reactive and adjusts to the dataset you choose in the first one. The code should be self-explanatory if you have dealt with shiny before.

runApp(list(
  ui = bootstrapPage(
    selectInput('dataset', 'Choose Dataset', c('mtcars', 'iris')),
    uiOutput('columns')
  ),
  server = function(input, output){
    output$columns = renderUI({
      mydata = get(input$dataset)
      selectInput('columns2', 'Columns', names(mydata))
    })
  }
))

EDIT. Another Solution using updateSelectInput

runApp(list(
  ui = bootstrapPage(
    selectInput('dataset', 'Choose Dataset', c('mtcars', 'iris')),
    selectInput('columns', 'Columns', "")
  ),
  server = function(input, output, session){
    outVar = reactive({
      mydata = get(input$dataset)
      names(mydata)
    })
    observe({
      updateSelectInput(session, "columns",
      choices = outVar()
    )})
  }
))

EDIT2: Modified Example using parse. In this app, the text formula entered is used to dynamically populate the dropdown menu below with the list of variables.

library(shiny)
runApp(list(
  ui = bootstrapPage(
    textInput("text", "Enter Formula", "a=b+c"),
    uiOutput('variables')
  ),
  server = function(input, output){
    outVar <- reactive({
      vars <- all.vars(parse(text = input$text))
      vars <- as.list(vars)
      return(vars)
    })

    output$variables = renderUI({
      selectInput('variables2', 'Variables', outVar())
    })
  }
))

r - Output from Shiny server to reactive selectInput(choices = ) in ui

Hi I think your first solution was closer but you should split the APIData in to two functions at least like this

APIdata <- reactive({

    # Initial fetch of data from eBird API, with conditionals to reject errant input
    a <- try(api2(regionCode = as.character(input$region_in), 
                  back = as.numeric(input$slider_in)))
    if(class(a) == "try-error" ||length(a) == 0){return(NULL)}
    a
  })
  filteredData <- reactive({
    a <- APIdata()
    ## resrt of your code here
  })

at the moment you are collecting the data from the api everytime some input changes and that is quite redundant.

After that you can use something like this to set the selectInput

observeEvent({APIdata()},{
    updateSelectInput(session, "species_in",
                      choices = unique(APIdata()[["comName"]]), # fixed
                      selected = input$species_in
    ))})

hope this helps!

Shiny - Changing the number of choices in selectInput()

Instead of case_when, try to use switch. Also, renderUI might be useful. Try this

library(shiny)
ui <- fluidPage(
  tabPanel("tbls",
           selectInput("tab1",label="Pick a table:",choices=c("a","b","c")),
           uiOutput("myselect")
           #selectInput("cht1",label="Pick a time series:",choices=c("d","e","f"))
  )
)
server <- function(input,output,session) {
  
  Nchoices <- reactive({
    switch(input$tab1, 
           "a" = c("d","e","f"),
           "b" = c("g","h"),
           "c" = c("j","k","l","m") # adding one more choice breaks the code
    )
  })
  
  output$myselect <- renderUI({
    req(input$tab1)
    selectInput("cht1",label="Pick a time series:",choices=Nchoices())
  })
 
  observe(print(Nchoices()))
  
}
shinyApp(ui, server)

Please note that in case_when All RHS values need to be of the same type. Inconsistent types will throw an error.

R Shiny - How to update a dependent reactive selectInput before updating dependent reactive plot

You can try using the freezReactiveValue() function, as Hadley Wickham recommend in mastering shiny. link: Freezing reactive inputs

library(shiny)
library(ggplot2)
library(dplyr)

# Define UI for application that draws a histogram
ui <- fluidPage(
  titlePanel("Reactivity Test"),
  
  # Sidebar with two input widgets
  sidebarLayout(
    sidebarPanel(
      
      selectInput(inputId = "dataset",
                  label = "Input #1 - Dataset",
                  choices = c("mtcars", "iris")),
      
      selectInput(inputId = "variable",
                  label = "Input #2 - Variable",
                  choices = NULL)
    ),
    
    # Show a plot of the generated distribution
    mainPanel(
      plotOutput("distPlot")
    )
  )
)

# Define server logic required to draw a histogram
server <- function(input, output, session) {
  
  input_dataset <- reactive({
    if(input$dataset == "mtcars") {
      return(mtcars)
    } else {
      return(iris)
    }
  })
  
  observeEvent(input$dataset, {
    freezeReactiveValue(input, "variable")
    updateSelectInput(session = session, inputId = "variable", choices = names(input_dataset()))
  })
  
  output$distPlot <- renderPlot({
    ggplot(input_dataset(), aes(x = .data[[input$variable]])) +
      geom_histogram()
  })
  
}

# Run the application 
shinyApp(ui = ui, server = server)

Shiny reactive selectInput in R

Here is a way. It uses the selectize plugin disable_options.

Download the plugin here. Save it under the name selectize-disable-options.js in the www subfolder of the app folder.

Then here is the app:

library(shiny)
library(ggplot2)

CSS <- "
.selectize-dropdown [data-selectable].option-disabled {
  color: #aaa;
  cursor: default;
}"

type <- as.character(c('summer','summer','summer','summer','winter','winter','winter','winter'))
country <- as.character(c('A','A','B','B','A','A','B','B'))
year <- c(2011,2012,2013,2014,2011,2012,2013,2014)
col1 <- c(33,7,NA,NA,5,11,NA,NA)
col2 <- c(10,3,NA,NA,8,15,NA,NA)
col3 <- c(NA,NA,10,15,NA,NA,20,25)
col4 <- c(NA,NA,8,5,NA,NA,22,16)

TD <- data.frame(type,country,year,col1,col2,col3,col4,stringsAsFactors=FALSE)


ui <- fluidPage(
  tags$head(
    tags$script(src = "selectize-disable-options.js"),
    tags$style(HTML(CSS))
  ),
  titlePanel("Test App"),
  sidebarLayout(
    sidebarPanel(
      selectInput("type","Choose a type", choices = c("All",unique(TD$type))),
      selectInput("country","Choose an country", choices = c("All",unique(TD$country))),
      selectizeInput("yaxis", "Choose a y variable", choices = colnames(TD[,3:7])),
      selectInput("xaxis", "Choose a x variable", choices = colnames(TD[,3:7])),
      actionButton("goButton", "Update")
    ),
    mainPanel(
      tabsetPanel(
        tabPanel('Plot', plotOutput("plot1"))
      )
    )
  )
)


server <- function(input, output, session){
  
  data1 <- reactive({
    if(input$type == "All"){
      TD
    }else{
      TD[TD$type == input$type,]
    }
  })
  
  data2 <- reactive({
    if(input$country == "All"){
      TD
    }else{
      TD[TD$country == input$country,]
    }
  })
  
  observe({
    if(input$type != "All"){
      selected_country <- isolate(input$country)
      countries <- unique(data1()$country)
      updateSelectInput(
        session, "country", 
        choices = c("All", countries),
        selected = ifelse(selected_country %in% countries, selected_country, "All")
      )
    }else if(input$country != 'All'){
      selected_type <- isolate(input$type)
      types <- unique(data2()$type)
      updateSelectInput(
        session, "type", 
        choices = c('All', types),
        selected = ifelse(selected_type %in% types, selected_type, "All")
      )
    }else if(input$type == "All" && input$country == "All"){
      updateSelectInput(
        session, "country", 
        choices = c('All', unique(TD$country))
      )
      updateSelectInput(
        session, "type", 
        choices = c('All', unique(TD$type))
      )
    }
  })
  
  data3 <- reactive({
    if(input$country == "All"){
      data1()
    }else if(input$type == "All"){
      data2()
    }else if(input$country == "All" && input$type == "All"){
      TD
    }else{
      TD[which(TD$country== input$country & TD$type == input$type),]
    }
  })
  
  observeEvent(data3(), {
    emptyColumns <- sapply(data3()[,3:7], function(x){
      all(is.na(x))
    })
    choices <- colnames(TD[,3:7])
    choices[emptyColumns] <- paste(choices[emptyColumns], "(no data)")
    updateSelectizeInput(
      session, "yaxis", choices = choices,
      options = list(
        plugins = list(
          disable_options = list(
            disableOptions = as.list(choices[emptyColumns])
          )
        )
      )
    )
  })
  
  data4 <- eventReactive(input$goButton, {
    data3()
  })
  
  x_var<- eventReactive(input$goButton, {
    input$xaxis
  })
  y_var <- eventReactive(input$goButton,{
    input$yaxis
  })
  
  output$plot1 <- renderPlot({
    x <- x_var()
    y <- y_var()
    p <- ggplot(data4(), aes_string(x=x, y=y)) + geom_line() + geom_point()
    p + labs(x = x, y = y) + theme(plot.title = element_text(hjust = 0.5, size=20))
  })
  
}

shinyApp(ui,server)

The empty columns are disabled in the select input:

How to make selectInput choices reactive?

You should avoid renderUI where possible and use update* functions instead - updating is faster than re-rendering:

library(shiny)
library(data.table)

DT <- data.table(
  ID = c(1, 1, 1, 2, 2, 2, 3, 3, 3),
  Period = c(1, 2, 3, 1, 2, 3, 1, 2, 3),
  Values = c(5, 10, 15, 0, 2, 4, 3, 6, 9)
)

all_choices <- unique(DT$Period)

ui <- fluidPage(
  tableOutput("data"),
  selectizeInput(
    inputId = "fromPeriod",
    label = "From period:",
    choices = setdiff(all_choices, last(all_choices)),
    selected = 1
  ),
  selectizeInput(
    inputId = "toPeriod",
    label = "To period:",
    choices = setdiff(all_choices, first(all_choices)),
    selected = 2
  ),
  tableOutput("dataSelect")
)

server <- function(input, output, session) {
  output$data <- renderTable({
    DT
  })
  
  observeEvent(input$fromPeriod, {
    freezeReactiveValue(input, "toPeriod")
    updateSelectizeInput(
      session,
      inputId = "toPeriod",
      choices = all_choices[all_choices > input$fromPeriod],
      selected = max(all_choices[all_choices > input$fromPeriod])
    )
  }, ignoreInit = TRUE)
  
  output$dataSelect <- renderTable({
    # in one line, however you seem to need part1 / part2 for your custom function
    # setorder(DT[Period %in% c(input$fromPeriod, input$toPeriod)], Period)
    part1 <- DT[Period == input$fromPeriod]
    part2 <- DT[Period == input$toPeriod]
    rbindlist(list(part1, part2))
  }, rownames = TRUE)
}

shinyApp(ui, server)

To avoid triggering reactives or outputs unnecessarily you should almost alway use freezeReactiveValue when using a update* function in shiny. Please see this related chapter from Mastering Shiny.

Shiny: selectInput based on previous selectInput resetting the selected value

That's because your observer is inside the renderPlot. It has nothing to do here.

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

  # Make drop-down choice of sel_2 dependent upon user input of sel_1
  observeEvent(input$sel_1, {
    updateSelectInput(session,
                      "sel_2",
                      choices = sort(unique(mtcars[[input$sel_1]]))
    )
  })
  
  output$plot_out <- renderPlot({
    
    # Assign inputs
    sel_1 <- input$sel_1
    sel_2 <- input$sel_2
    
    # Data to plot
    my_data <- mtcars %>% 
      filter(.data[[sel_1]] == sel_2)
    
    # Plot
    ggplot(my_data, aes(x = factor(.data[[sel_1]]), y = hp)) + geom_point()

  })
}

Here the observeEvent instead of observe is not necessary, since input$sel_1 is the only reactive value inside the observer, but I find that observeEvent is more readable.

Also, avoid to load tidyverse. That loads a ton of packages you don't need. Here dplyr and ggplot2 are enough

Could I get the choices of a SelectInput in the ui from a reactive function in server? (RShiny)

Generate the selectInput on the server side.

library(shiny)

ui <- fluidPage(
  titlePanel("Old Faithful Geyser Data"),
  sidebarLayout(
    sidebarPanel(
      uiOutput('selectUI')
    ),
    mainPanel(
      verbatimTextOutput("print")
    )
  )
)

server <- function(input, output) {
  
  cars <- reactive({
    data("mtcars")
    cars <- rownames(mtcars)
    return(cars)
  })
  
  output$selectUI <- renderUI({
    selectInput(inputId = 'options', "Select one", choices = cars())  
  })
  
  output$print <- renderPrint(cars())
  
}

# Run the application 
shinyApp(ui = ui, server = server)

---

Related Topics