I want to update a selectInput item on a Shiny app with more than 1,000 items but it obviously don't accept more than 1,000.
Is there a method to add more values or load it from server, as user start typing? server parameter also doesn't work.
library(shiny)
# Define UI for application that draws a histogram
ui <- fluidPage(
tags$head(tags$script(src = "message-handler.js")),
# Application title
titlePanel("Large selectInput"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
selectInput("Names",
"List of Names",
choices = c("A")
)
),
mainPanel("Empty")
)
)
# Define server logic required to draw a histogram
server <- function(input, output, session) {
names <- 1:5000
observe({
updateSelectInput(session, "Names", label = "Updated", choices = names, server = TRUE)
})
}
# Run the application
shinyApp(ui = ui, server = server)
selectizeInput() can handle more than 1,000 records.
Related
I have an app with one SelectizeInput which shows you a huge list of numbers.
I realised that I cannot remove a specific part of the choice that I have selected. Example:
Imagine that you have 5000, 5001, 5002, 5003... and you are in the choice 5003, but you want to select 5002 (so, you just have to remove the last number -3- and introduce the new one -2-). It will be the same if I want to delete a number from the middle.
At the moment, you have to delete the complete number, it doesn't allow you to remove parts of the number.
Here you have the code (note that you have to click on Submit before see the list)
library(shiny)
ui <- fluidPage(
titlePanel("Numbers"),
sidebarLayout(
sidebarPanel(
actionButton(inputId = "submit", label = "submit"),
hr(),
selectizeInput(inputId = "num_list", label = "Choose a number:", choices=character(0))
),
mainPanel(
)
)
)
server <- function(input, output, session) {
num <- reactive({
data = c(1:66000)
return(data)
})
# This function gives us the list of genes.
numbers_list <- reactive({
num()
})
# This is to generate the choices (gene list) depending on the user's input.
observeEvent(input$submit,{
updateSelectizeInput(
session = session,
inputId = "num_list",
choices = numbers_list(), options=list(maxOptions = length(numbers_list())),
server = TRUE
)
})
}
# Run the application
shinyApp(ui = ui, server = server)
Does anyone know if this issue can be fixed?
Thanks very much in advance!
I am not sure if what I am missing anything here, it seemed that event is not caught by observeEvent when an selectInput (multi-select on) is cleared. However, it is caught using reactive().
See example below, the goal is that with any changes in the selectInput, the program will pick up the change and display on screen. I used 2 examples:
Reactive to display on html_component2
ReactiveValues using observeEvent to display on html_component
For reactive function, it works perfectly. For the later, it works for all combinations, except when if user unselect everything. I am really confused on why, has anyone seen this issue before and if there are any workarounds for it? I'd prefer to use reactive values in this case for my application.
library(shiny)
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("Old Faithful Geyser Data"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
selectInput("sinput", "select here", c(1,2,3,4,5), multiple = T),
),
# Show a plot of the generated distribution
mainPanel(
htmlOutput("html_component"),
htmlOutput("html_component2"),
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
rv <- reactiveValues()
sel <- reactive({
input$sinput
})
observeEvent(input$sinput, {
rv$selected = input$sinput
})
output$html_component <- renderUI({
HTML(paste(c("1:", rv$selected)))
})
output$html_component2 <- renderUI({
HTML(paste(c("2:", sel())))
})
}
# Run the application
shinyApp(ui = ui, server = server)
By default observeEvent will ignore NULL in it's eventExpr, you need to set ignoreNULL = FALSE:
library(shiny)
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("Old Faithful Geyser Data"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
selectInput("sinput", "select here", c(1,2,3,4,5), multiple = T),
),
# Show a plot of the generated distribution
mainPanel(
htmlOutput("html_component"),
htmlOutput("html_component2"),
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
rv <- reactiveValues()
sel <- reactive({
input$sinput
})
observeEvent(input$sinput, {
rv$selected = input$sinput
}, ignoreNULL = FALSE)
output$html_component <- renderUI({
HTML(paste(c("1:", rv$selected)))
})
output$html_component2 <- renderUI({
HTML(paste(c("2:", sel())))
})
}
# Run the application
shinyApp(ui = ui, server = server)
I have written a simple example of what I am doing. I have 3000 numbers that I want to show in a selectInput. The numbers have to be in a reactive function, since in my original work, the data is from a file.
My problem is that when I run the app it only appears 1000 numbers, not the entire data (3000 numbers).
I have seen this post Updating selection of server-side selectize input with >1000 choices fails but I don't know how can I do it using uiOutput and renderUI.
Can anyone help me?
Thanks very much in advance
The code:
library(shiny)
ui <- fluidPage(
titlePanel("Numbers"),
sidebarLayout(
sidebarPanel(
uiOutput('selectUI')
),
mainPanel(
)
)
)
server <- function(input, output) {
num <- reactive({
data = c(1:3000)
return(data)
})
output$selectUI <- renderUI({
selectInput(inputId = 'options', "Select one", choices = num())
})
}
# Run the application
shinyApp(ui = ui, server = server)
Use selectizeInput instead of selectInput with the argument options = list(maxOptions = 3000).
Thanks to Stéphane Laurent's answer, the example will be solved like this:
library(shiny)
ui <- fluidPage(
titlePanel("Numbers"),
sidebarLayout(
sidebarPanel(
selectizeInput(inputId = "options", label = "Select one", choices=character(0)),
),
mainPanel(
)
)
)
server <- function(input, output, session) {
num <- reactive({
data = c(1:3000)
return(data)
})
observe({
updateSelectizeInput(
session = session,
inputId = "options",
label = "Select one",
choices= num(), options=list(maxOptions = length(num())),
server = TRUE)
})
}
# Run the application
shinyApp(ui = ui, server = server)
This code will work if you have more than 3000 entries. It will show you ALL the choices that you have. However, if you have a long list of choices (e.g. 60000) it will decrease the speed of your app.
When I filter a list of states in Shiny for: "New" I can choose only one state. After that the list is restarting and I have to put: "New" again in order to find a state contains "New" in name. I would like to filter states and choose more states at one time.
Below I added a picture and a code which present my goal.
Picture
library(shiny)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectizeInput(
'e2', '2. Multi-select', choices = state.name, multiple = TRUE
)
),
mainPanel(
verbatimTextOutput('ex_out')
)
)
)
server <- function(input, output) {
output$ex_out <- renderPrint({
sapply(sprintf('e%d', 2), function(id) {
input[[id]]
})
})
}
shinyApp(ui = ui, server = server)
In the attached MWE Shiny example, I have a nested tabsetPanel within a tabPanel for a navbar. If you run the MWE with only one tabPanel within the tabSet you will see that Shiny behaves exactly as it is expected. However, if you run the MWE with two tabPanels, the result is not printed to the main panel of each tab.
Why does this behaviour occur? And how do I resolve this conundrum?
library(shiny)
ui <- shinyUI(navbarPage("tabalicious",
tabPanel("Nav1", value = "nav1",
mainPanel(h2("Hello"),
br(),
p("This is my app.")
)
)
,
tabPanel("Nav2", value = "nav2",
tabsetPanel(
tabPanel("tabsettab1",
sidebarLayout(
sidebarPanel(
helpText("Choose your settings"),
selectInput("zone_type",
label = "Choose a zone type to display",
choices = list("Industrial", "Residential"),
selected = "Industrial")
),
mainPanel(h2("A tab for a tabSet"),
textOutput('zone_type')
)
)
)
# Uncomment this to see the issue
# ,
# tabPanel("tabsettab2",
# sidebarLayout(
# sidebarPanel(
# helpText("Choose your settings"),
# selectInput("zone_type",
# label = "Choose a zone type to display",
# choices = list("Industrial", "Residential"),
# selected = "Industrial")
# ),
# mainPanel(h2("A tab for a tabSet"),
# textOutput('zone_type')
# )
# )
# )
)
)
)
)
server <- shinyServer(function(input, output) {
output$zone_type <- renderText({
paste("You have selected", input$zone_type)
})
})
# Run the application
shinyApp(ui = ui, server = server)
It doesn't have to do with tabs, but multiple calls to output the results of the same render* function. For example, a simplified page (with no tabs) will work fine, but if you uncomment the duplicated call, will fail to display zone_type:
library(shiny)
server <- shinyServer(function(input, output) {
output$zone_type <- renderText({paste("You have selected", input$zone_type)})
})
ui <- shinyUI(fluidPage(
selectInput("zone_type",
label = "Choose a zone type to display",
choices = list("Industrial", "Residential")),
# textOutput('zone_type'),
textOutput('zone_type')
))
runApp(shinyApp(server = server, ui = ui))
While your shinyUI function can only call each output of shinyServer once, within shinyServer you can call the inputs as many times as you like, so it's easy to duplicate outputs:
library(shiny)
server <- shinyServer(function(input, output) {
output$zone_type <- renderText({paste("You have selected", input$zone_type)})
output$zone_type2 <- renderText({paste("You have selected", input$zone_type)})
})
ui <- shinyUI(fluidPage(
selectInput("zone_type",
label = "Choose a zone type to display",
choices = list("Industrial", "Residential")),
textOutput('zone_type'),
textOutput('zone_type2')
))
runApp(shinyApp(server = server, ui = ui))
If you don't want to duplicate work for the server, you can't pass one output to another, but you can just save the render* results to a local variable which you can pass to both outputs:
server <- shinyServer(function(input, output) {
zone <- renderText({paste("You have selected", input$zone_type)})
output$zone_type <- zone
output$zone_type2 <- zone
})