I have a shiny app containing a server-side selectize input with a long list (>10k) of choices.
I would like to update the selection upon clicking a button. Here is a reproducible example
library(shiny)
ui <- fluidPage(
actionButton('buttonid','Button'),
selectizeInput("listid", "A long list", choices = NULL)
)
server <- function(input, output, session)
{
updateSelectizeInput(session, "listid", choices = paste("Item", 1:10000), server = T)
observeEvent(input$buttonid,
{
updateSelectizeInput(session, "listid", selected = "Item 1234")
})
}
shinyApp(ui = ui, server = server)
The above code results in a blank selection when I press the button.
However, if I search for "Item 1234", then change selection, and press the button, now the item gets selected.
Also, trying to select an item between Item 1 and 1000 does not give problems, presumably because 1000 items get loaded at the beginning.
This seems akin to this old bug, but I am not sure if there is a workaround https://github.com/rstudio/shiny/issues/1018
The short answer is explicitly re-specify your choices and server in your update.
server <- function(input, output, session)
{
myChoices <- paste("Item", 1:10000)
updateSelectizeInput(session, "listid", choices = myChoices, server = T)
observeEvent(input$buttonid,
{
updateSelectizeInput(session, "listid",
server = TRUE,
choices = myChoices,
selected = "Item 1234")
})
}
The default for server in updateSelectizeInput is FALSE. This causes the code to drop into a control statement which uses updateSelectInput instead. From the function code
function (session, inputId, label = NULL, choices = NULL, selected = NULL,
options = list(), server = FALSE)
{
...
if (!server) {
return(updateSelectInput(session, inputId, label, choices,
selected))
}
...
This sends a message to the client assuming all the choices are present (but as you mentioned, only the first 1000 are present).
Just setting server = TRUE results in an error when you click the button.
Warning: Error in [.data.frame: undefined columns selected
[No stack trace available]
I didn't fully trace the reason, but it ultimately creates an empty choices data.frame with an attribute denoting the selected value. I'm guessing somewhere else in function calls to the session object, this attribute is being used to try to select a column created from the empty data.frame.
The update function doesn't seem to change the choices stored on the server, so that's presumably why it's there when you search for it. During the changing the selected value, it seems to be trying to select from a NULL list of choices instead of the list of choices on the server.
It seems like you essentially have to recreate your selectizeInput when updating with a selected value beyond your initial list.
You can use maxOptions to render all values, might be enough depending on the size of your choices:
selectizeInput("listid", "A long list", choices = NULL, options = list(maxOptions = 10000))
Related
It appears that DT::dataTableProxy is not possible with SearchPanes extension because:
SearchPanes requires Select extension.
Select extension requires DT::renderDT(server = FALSE) option.
DT::dataTableProxy does not work on the client side and throws DT error.
library(shiny)
library(shinydashboard)
library(tidyverse)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
shiny::selectInput("rows", label = "Rows", choices = 1:nrow(mtcars)),
shiny::actionButton("new", label = "New Data")
),
dashboardBody(DT::dataTableOutput("cars"))
)
server <- function(input, output) {
rows <- reactive({ input$rows })
output$cars <- DT::renderDataTable(server = FALSE, {
expr = DT::datatable(
data = mtcars |> head(rows())
#,
#extensions = c("SearchPanes", "Select", "Buttons"),
#options = list(
# dom = "Btip",
# buttons = list("searchPanes")
#)
)
})
dtProxy <- DT::dataTableProxy("cars")
observeEvent(input$new, label = "Observe button proxy update", {
doubledata <- bind_rows(mtcars, mtcars)
DT::replaceData(proxy = dtProxy,
data = doubledata,
resetPaging = FALSE)
})
}
shinyApp(ui, server)
Try this code using server = FALSE, click New Data, you will receive DT Warning:
DataTables warning: table id=DataTables_Table_0 - Invalid JSON response. For more information about this error, please see http://datatables.net/tn/1
Remove server = FALSE and proxy runs.
Remove the commented section, and search panes appear, but with no actual filters represented, and message stating that if we really want to use select extension then set select = 'none'.
Here are some reference materials:
RStudio DT Extensions
Matt Herman Tutorial
What I ended up doing was use only the DT::datatableProxy feature, then use a custom button for the search panes. Custom button was found here How to add custom button in R Shiny datatable. This required making a new reactive which was invalidated by the first, and checking if the inputs had any new values. Then the proxy received the filtered data.
Maybe someday they will add support for search panes.
Add server-side support for SearchPanes extension #877
Question
In R Shiny, when using
renderUI
uiOutput
to dynamically generate sets of controls, such as:
checkboxes
radiobuttons
text boxes
how can I harvest those values or populate input by causing events?
As-is, those generated controls appear to be "display only". Making a selection, marking a checkbox, or entering data only updates the display, but no Event is created and the values are not populated into the "input" variable ( ReactiveValues ); thus, nothing is received by the Shiny server process.
If these control inputs are in-fact isolated, it completely undermines the point of dynamically creating controls.
Obviously, I'm hoping that this issue has been addressed, but my searches haven't turned it up.
In my specific case, the UI allows the user to:
Select and upload a CSV file.
The logic identifies numerical, date, and grouping columns, and produces 3 sets of radiobutton control sets. The idea is that you pick which columns you are interested in.
Picking a grouping column SHOULD return that columnID back to the server, where it will display a discrete list of groups from which to select. This fails, as the selections do not generate an Event, and the input variable (provided to server.R) only contains the ReactiveValues from the static controls.
That said, the display of the controls looks fine.
Step#0 screenshot:
Step#1 screenshot:
On the server.R side, I'm using code as below to create the radioButtons.
output$radioChoices <- reactive({
...
inputGroup <- renderUI({
input_list <- tagList(
radioButtons(inputId = "choiceGrp", label = "Available Grouping Columns", choices = grpColumnNames, inline = TRUE, selected = selectedGrp),
radioButtons(inputId = "choiceNumb",label = "Available Numerical Columns",choices = numColumnNames, inline = TRUE, selected = selectedNum),
radioButtons(inputId = "choiceDate",label = "Available Date Columns", choices = dateColumnNames, inline = TRUE, selected = selectedDate),
hr()
)
do.call(tagList, input_list)
})
print(inputGroup)
output$radioChoices <- inputGroup
})
I have played around with a Submit button and ActionButtons to try and force an Event, but no dice. My skull-storming is now going to places like "do I need to somehow use Javascript here?"
Many thanks to all of you who are lending me your cycles on this matter.
I'm not sure I understand your problem. Here's a MWE that accesses the value of a widget created by uiOutput/renderUI. The values of widgets created by uiOutput/renderUIcan be accessed just like those of any other widget.
If this doesn't give you what you want, please provide more details.
library(shiny)
ui <-
fluidPage(
uiOutput("dataInput"),
textOutput("result")
)
server <- function(input, output, session) {
output$dataInput <- renderUI({
selectInput("beatles", "Who's your favourite Beatle?", choices=c("- Select one -"="", "John", "Paul", "George", "Ringo"))
})
output$result <- renderText({
req(input$beatles)
paste0("You chose ", input$beatles)
})
}
shinyApp(ui, server)
I have a datatable, in which I have embedded selectizeInputs. I have used jquery to enable some options in the selectizeInputs (like creation options).
Now, due to a business use case I would like to disable some selectizeInputs (dynamically selected, through some condition). These inputs could be on the 2nd, 3rd,.. nth page of the datatable as well.
However, I am only able to disable the inputs on the 1st page and not on the subsequent pages. I am attaching a minimal and reproducible example, it would be great if someone could help me out.
library(shiny)
library(DT)
ui <- fluidPage(
shinyjs::useShinyjs(),
selectizeInput(
inputId = "input",
label = "",
choices = letters[1:26],
selected = letters[1]
),
fluidRow(
DTOutput(outputId = "table"),
tags$script(HTML("Shiny.addCustomMessageHandler('unbind-DT', function(id) {
Shiny.unbindAll($('#'+id).find('table').DataTable().table().node());
})"))
)
)
df <- data.frame('a' = c(1,2), 'sel_input' = NA)
df[1,'sel_input'] <- as.character(
selectizeInput(inputId = 'mselect', choices=c('car','cars','dog'),
label=NULL, selected=NULL))
df[2,'sel_input'] <- as.character(
selectizeInput(inputId = 'nselect', choices=c('lambo','audi','merc'),
label=NULL, selected=NULL))
js <- c(
"function(){Shiny.bindAll(this.api().table().node());",
" $('#mselect').selectize({
delimiter: \',\',
persist: false,
create: function(input) {
return {
value: input,
text: input
}
}
});",
"$('#nselect').selectize({
delimiter: \',\',
persist: false,
create: function(input) {
return {
value: input,
text: input
}
}
});",
"$('#mselect')[0].selectize.enable()",
"$('#nselect')[0].selectize.disable()",
"}"
)
server <- function(input, output, session) {
observe({
print(input$mselect)
})
session$sendCustomMessage('unbind-DT', 'table')
output$table <- renderDT({
datatable(
data = df,
escape = FALSE,
options = list(
dom='tp',
pageLength=1,
processing=F,
preDrawCallback = JS('function(){Shiny.unbindAll(this.api().table().node());}'),
drawCallback = JS(js)
)
)
})
}
shinyApp(ui = ui, server = server)
So, I was able to resolve it on my own. Basically the problem here is not R/Rshiny based. It is actually a javascript bug in the code that I was overlooking.
When you do pagination, the elements only in current (selected) page are a part of the DOM. All others are removed/not created. In the code above, in the drawCallback (this is the piece of code that runs every time the datatable needs to be re-rendered) I am issuing commands for all the elements, irrespective if they are present in the DOM or not. Because of this the javascript code fails and the disabling/enabling does not happen.
The solution here is to first check if an element is active in the DOM or not and only then issue enabling/disabling command.
So, in essence, enclose the above commands in a if else statement
if ($('#mselect').length > 0){
$('#mselect').selectize()[0].selectize.enable();
}
if ($('#nselect').length > 0){
$('#nselect').selectize()[0].selectize.disable();
}
This way the javascript code will only run when that specific element exists in the DOM and then you would be able to implement disabling selectInput in second page of paginated datatable.
With Shiny when you use SelectizeInput with multiple = TRUE:
a dropdown menu with all the element appears as soon as you are in
that box.
Then, when you start typing, the result in the dropdown
menu are filtered depending on what you type.
When the list is very long, sometimes the point 1 is pointless. Is it possible to see the dropdown only when you start typing (only from point 2)?
Reproducible example:
ui <- fluidPage(
selectizeInput(
inputId = "TEST", label = NULL, choices = c("aa","ab","ac","dd","de","zzz"),
multiple = TRUE)
)
server <- function(input, output, session) {
}
shinyApp(ui, server)
selectizeInput has an options argument, which is a list of parameters to initialize the selectize input. One of these options is openOnFocus which is
Show the dropdown immediately when the control receives focus.
Turning off openOnFocus solves the issue.
selectizeInput(
inputId = "TEST", label = NULL, choices = c("aa","ab","ac","dd","de","zzz"),
multiple = TRUE,
options = list(openOnFocus = FALSE,
#If the user write aa then delete it all, the complete list will show up again,
#use maxOptions to solve this issue
maxOptions = 3))
See the full list here selectize
/
selectize.js.
The following minimal example demonstrates a problem with updating nested outputs followed by updating the inputs with the content they had before the update of the outputs. This minimal example comes from a much larger project, so solutions to the problem like "don't nest the outputs" aren't viable unless Shiny doesn't actually allow nested outputs.
When you run the example, you'll see two radio buttons and a text input. Enter some text and change the radio button. You will see that after the radio button event is handled, the text input has indeed been updated. But if you change the radio button a second time, the text input at the observeEvent() will be blank.
It's like the updateTextInput() function works fine for updating what you see in the browser, but not at all for what Shiny gets back from the browser for that input on the next event.
To add a bit of strange, also note that if you change the updated text input in any way (e.g., add or remove one character to/from it), then it works as expected. Is the problem here my code, my expectations, or a bug in Shiny?
ui <- fluidPage(fluidRow(column(12, tagList(
uiOutput("outer_div")
))))
server <-function(input, output, session) {
updateScreen = function() {
output$outer_div = renderUI(uiOutput("inner_div"))
output$inner_div = renderUI(tagList(
radioButtons(inputId = "button", label="", choices = c("A", "B")),
textInput("text", label="", value="")
))
}
updateScreen() #initialize screen
observeEvent(input$button, {
print(paste0("Text input is ", input$text))
updateTextInput(session, inputId = "text" , value=input$text)
updateRadioButtons(session, inputId="button", selected=input$button)
updateScreen()
})
}
shinyApp(ui = ui, server = server)
Does this work for you?
ui <- fluidPage(fluidRow(column(12, tagList(
uiOutput("outer_div")
))))
server <-function(input, output, session) {
updateScreen = function() {
output$outer_div = renderUI(uiOutput("inner_div"))
output$inner_div = renderUI(tagList(
radioButtons(inputId = "button", label="", choices = c("A", "B")),
textInput("text", label="", value="")
))
}
updateScreen() #initialize screen
data <- isolate(input$text)
observeEvent(input$button, {
updateTextInput(session, inputId = "text" , value=data)
updateRadioButtons(session, inputId="button", selected=input$button)
print(paste0("Text input is ", input$text))
#updateScreen()
})
}
shinyApp(ui = ui, server = server)