R shiny: Remove render UI created checkboxGroupInput upon deselection - r

I am trying to create a set of checkboxGroupInput choices that when deselected disappear. I am able to do this for selected choices of 2 or more. However, upon deselection of the final choice, it persists unselected rather than disappearing.
Please see the following, selecting options from the selectizeInput function.
In the server, it is important that the original UI selected and choices remain separate from the updateCheckboxGroupInput selected and choices functions as these are initially retrieved from persistent data storage that can then be manipulated.
library(shiny)
ui <- fluidPage(
column(width = 4, align = "left", uiOutput("choose_Number")),
br(),
column(width = 4, align = "left", div(
align = "left",
actionButton('add', 'Confirm Number(s)', style="color: #fff; background-color: #53C1BE"))
),
column(width = 4, uiOutput("my_checkboxGroupInput"))
)
server <- function(input, output, session) {
output$choose_Number <- renderUI({
selectizeInput("choose_Number", "Choose Number(s)", as.list(c(1:4)), options=list(create=TRUE,'plugins' = list('remove_button'),
persist = FALSE), multiple = TRUE)
})
lvl<-reactive(unlist(input$selected_Numbers))
observe({
if(input$add==0) return()
isolate({
current_selection<-paste(input$choose_Number,sep=", ")
updateCheckboxGroupInput(session, "selected_Numbers", choices = c(current_selection,lvl())
,selected=c(current_selection,lvl()))
})
})
observeEvent(input$selected_Numbers,({
updateCheckboxGroupInput(session, "selected_Numbers", choices = unique(as.list(lvl()))
,selected=c(lvl()))
})
)
observeEvent(input$add, {
updateSelectizeInput(session, "choose_Number", choices = as.list(1:4),
selected = character(0),
options = list(create=TRUE, 'plugins' = list('remove_button'), persist = FALSE))
})
output$my_checkboxGroupInput <- renderUI(
checkboxGroupInput("selected_Numbers", 'Chosen Number(s)',
choices = c(1,2,3),selected= c(1,2,3)))
}
shinyApp(ui, server)
Help appreciated in helping clear all unselected choices. Thank you

If your choices is a list it works as desired. Try this
observe({
updateCheckboxGroupInput(session, "selected_Numbers", choices = unique(as.list(lvl()))
,selected=c(lvl()))
})

Related

How do I use input from `selectizeInput` to filter a list of options and then `updateSelectizeInput`?

BACKGROUND:
I have a large list of stock symbols, 27,000 rows, that I would like to be choices in a selectizeInput() on a shinyApp. Since the list is large I am using server = T in updateSelectizeInput().
AIM:
I would like the options list to not load/render until a user starts typing a string into selectizeInput(), so that I can return all symbols that start with that letter, to reduce loading all 27,000 rows in the input. I would like input$ticker to be what is observed and then what triggers the filtering code logic. How can i achieve this without using a specific button?
Shown below is
intended output, but with a button to produce the behavior instead of the user being in the text box. This is along the lines of what I would like, but does not automatically start searchign when I type in the box and has bad code smell to me.
current logic, using input$ticker in an observer to trigger selection of df and populate updateSelectize() with new choices, but is failing and the app is evaluating too soon?\
trying to load choices once, using upload button only doesn't work
REPREX:
1.
library(shiny)
tickers <- rep(rownames(mtcars), 850)
ui <- {
renderUI(
shiny::fluidRow(
bs4Dash::box(
title = shiny::selectizeInput(
inputId = "ticker",
label = "Ticker:",
choices = NULL,
selected = "AAPL",
options = list(
placeholder = "e.g AAPL",
create = TRUE,
maxOptions = 50L
)
),
actionButton(
inputId = "update",
label = "UPDATE NOW"
),
id = "tickerBox",
closable = F,
maximizable = F,
width = 12,
height = "250px",
solidHeader = FALSE,
collapsible = F
)
)
)
}
server <- function(input, output, session){
choice <- reactive(
tickers[startsWith(tickers$symbol, input$ticker), ]
)
observeEvent(input$update, {
updateSelectizeInput(
session = session,
label = "Ticker:",
inputId ="ticker",
choices = choice(),
server = TRUE
)
})
}
shiny::shinyApp(ui = ui, server = server)
# REPREX for selectize, glitches and `input$ticker` observer causes loop gltich?
library(shiny)
tickers <- rep(rownames(mtcars), 850)
ui <- {
renderUI(
shiny::fluidRow(
bs4Dash::box(
title = shiny::selectizeInput(
inputId = "ticker",
label = "Ticker:",
choices = NULL,
selected = "AAPL",
options = list(
placeholder = "e.g AAPL",
create = TRUE,
maxOptions = 50L
)
),
actionButton(
inputId = "update",
label = "UPDATE NOW"
),
id = "tickerBox",
closable = F,
maximizable = F,
width = 12,
height = "250px",
solidHeader = FALSE,
collapsible = F
)
)
)
}
server <- function(input, output, session){
# updateSelectizeInput(
# session = session,
# label = "Ticker:",
# inputId ="ticker",
# choices = tickers,
# server = TRUE
# )
observeEvent(input$ticker, {
choices <- tickers[startsWith(tickers$symbol, input$ticker), ]
updateSelectizeInput(
session = session,
label = "Ticker:",
inputId ="ticker",
choices = choices,
server = TRUE
)
})
}
shiny::shinyApp(ui = ui, server = server)
# REPREX for selectize
library(shiny)
tickers <- rep(rownames(mtcars), 850)
ui <- {
renderUI(
shiny::fluidRow(
bs4Dash::box(
title = shiny::selectizeInput(
inputId = "ticker",
label = "Ticker:",
choices = NULL,
selected = "AAPL",
options = list(
placeholder = "e.g AAPL",
create = TRUE,
maxOptions = 50L
)
),
actionButton(
inputId = "update",
label = "UPDATE NOW"
),
id = "tickerBox",
closable = F,
maximizable = F,
width = 12,
height = "250px",
solidHeader = FALSE,
collapsible = F
)
)
)
}
server <- function(input, output, session){
# One call to try and load ticker df
observeEvent(input$update, {
updateSelectizeInput(
session = session,
label = "Ticker:",
inputId ="ticker",
choices = ticker,
server = TRUE
)
})
}
shiny::shinyApp(ui = ui, server = server)
SEE SIMILAR POSTS:
SO POST 1, SO POST 2, SO POST 3
What do you think about something like this?
library(shiny)
tickers <- rep(rownames(mtcars), 850)
ui <- fluidPage(
tags$head(
tags$script(
HTML(
'document.addEventListener("keydown", function(e) {
Shiny.setInputValue("key_pressed", e.key);
})'
)
)
),
fluidRow(
column(2, selectizeInput("select", "Select", choices = "")),
column(1, actionButton("btn", "Search"))
)
)
server <- function(input, output, session) {
observeEvent(input$btn, {
req(input$key_pressed)
updateSelectizeInput(session, "select", choices = tickers[startsWith(tickers, input$key_pressed)], server = TRUE)
})
}
shinyApp(ui, server)
Basically I think it is not possible to just use the words which are putted to the selectInput and we need separate input. I think that selectInput is truthy (isTruthy()) only after some option was chosen (and it can't be "" of course), so we can't use anything which is putted as a word to the selectInput box before some option is actually chosen. I'm not sure, but if I'm right, it is necessary to have separate input for what you want.
However, if we could assume that:
User will use only one letter to get the options to choose
Then we can use "keydown" event (keydown). Now the user doesn't need to put anything to the selectInput box, she/he can just use a key in the keyboards, like C (letter size does matter here, because we are using startsWith()) and then push "Search" button (but of course this letter can still be put to the selectInput box to mimic what you tried to achieve). We could even imagine solution without the button, but I'm afraid in most use-cases it will be not recommended, I mean if user can interact with the app using keyboard not only to choose the options, but also for other purposes, then we would recompute new options everytime user uses key in the keyboard for - well - nothing.
Turns out that selectizeInput doesn't accept a df and must be an atomic vector. When I used tickers[[1]], the issue seemed to be solved, and the list would no longer flash.

selectizeInput paramter 'multiple' unchangeable when updated server-side

I have a selectizeInput (with parameter multiple = FALSE) in a shiny app. I´m not able to change the multiple-parameter afterwards by using the server-side updateSelectizeInput() and setting the option there.
Here is an example:
library(shiny)
ui <- fluidPage(
selectizeInput(
inputId = "name",
label = "Select Name:",
choices = NULL
)
)
server <- function(input, output, session) {
updateSelectizeInput(
inputId = "name",
choices = c("Markus", "Lisa", "Peter"),
options = list(maxItems = 10),
server = TRUE # set consciously, I have a big list to handle
)
}
shinyApp(ui, server)
If I don´t set the server parameter to TRUE, everything works just fine. Is this a bug or do I miss something?
To select multiple items, you can set multiple=TRUE in the selectizeInput as shown below.
library(shiny)
ui <- fluidPage(
selectizeInput(
inputId = "name",
label = "Select Name:",
choices = NULL, multiple=T
)
)
server <- function(input, output, session) {
updateSelectizeInput(
inputId = "name",
choices = c("Markus", "Lisa", "Peter"),
options = list(maxItems = 10),
server = TRUE # set consciously, I have a big list to handle
)
}
shinyApp(ui, server)

How to disable multiple selections in checkboxGroupInput in shiny app

I have a checkboxGroupInput in my shiny app. It seems that the multiple selection is always enabled. What I need is to disable the multiple selection and only allow one selection at a time.
Does anyone know how to do that? Shiny app example below:
ui <- fluidPage(
checkboxGroupInput("icons", "Choose icons:",
choiceNames =
list(icon("calendar"), icon("bed"),
icon("cog"), icon("bug")),
choiceValues =
list("calendar", "bed", "cog", "bug")
),
textOutput("txt")
)
server <- function(input, output, session) {
output$txt <- renderText({
icons <- paste(input$icons, collapse = ", ")
paste("You chose", icons)
})
}
shinyApp(ui, server)
Here is the checkboxGroupInput function. I'm surprised there is no argument like multiple. Should I use other widget to serve that purpose? What should I use?
checkboxGroupInput(inputId, label, choices = NULL, selected = NULL,
inline = FALSE, width = NULL, choiceNames = NULL,
choiceValues = NULL)

Unable to clear the displayed output in ShinyApp using actionButton

I'm building a shinyApp on mtcars data. I got 2 actionButtons (Go & Clear).
The Go button is for displaying the output on mainPanel whereas the Clear button is for clearing that output.
My Clear button isn't working due to some unforeseen reason. Can somebody please have a look at my codes. I shall be extremely grateful.
library(shiny)
library(DT)
library(dplyr)
library(shinythemes)
library(htmlwidgets)
library(shinyWidgets)
library(shinydashboard)
data_table<-mtcars
#ui
ui = fluidPage(
sidebarLayout(
sidebarPanel (
uiOutput("cyl_selector"),
uiOutput("disp_selector"),
actionButton(inputId = "go", label = "Go"),
actionButton(inputId = "reset", label = "Clear")),
mainPanel(
DT::dataTableOutput('mytable') )))
#server
server = function(input, output, session) {
output$cyl_selector <- renderUI({
selectInput(inputId = "cyl",
label = "cyl:", multiple = TRUE,
choices = c( unique(as.character(data_table$cyl))),
selected = c('4')) })
output$disp_selector <- renderUI({
available <- data_table[c(data_table$cyl %in% input$cyl ), "disp"]
selectInput(
inputId = "disp",
label = "disp:",
multiple = TRUE,
choices = c('All',as.character(unique(available))),
selected = 'All') })
thedata <- eventReactive(input$go,{
data_table<-data_table[data_table$cyl %in% input$cyl,]
if(input$disp != 'All'){
data_table<-data_table[data_table$disp %in% input$disp,]
}
data_table
})
# thedata <- eventReactive(input$reset,{
# data_table<-NULL
# })
output$mytable = DT::renderDataTable({
DT::datatable( filter = "top", rownames = FALSE, escape = FALSE,
options = list(pageLength = 50, autowidth=FALSE,
dom = 'Brtip' ),
{
thedata() # Call reactive thedata()
})
})}
shinyApp(ui = ui, server = server)
I didn't analyze your script completly, but i can see that it doesn't call the second button at all (Clear). You made an eventReactive() using input$go for the first button to make the plot, but you need to call input$reset too if you want to make it work.

Add items to the list of the selectInput by using button (RShiny)

I have the following code:
library(shiny)
vec <- seq(1,10)
ui <- fluidPage(
titlePanel(""),
sidebarLayout(
sidebarPanel(
fluidRow(
selectInput("selection", "Select number", vec, multiple = TRUE),
actionButton("First_fives", "First Fives" ),
actionButton("Last_fives", "Last Fives"),
actionButton("ok", "OK"))
),
mainPanel(
fluidRow(
h5("Selected numbers:")),
textOutput('num')
)
)
)
server <- function(input, output, session) {
observeEvent(input$First_fives,{
updateSelectInput(session, inputId = "selection", choices = vec[1:5])
})
observeEvent(input$Last_fives,{
updateSelectInput(session, inputId = "selection", choices = vec[6:10])
})
data <- reactiveValues()
observeEvent(input$ok,{
data$selected <- input$city
})
output$num <- renderText({data$selected})
}
shinyApp(ui = ui, server = server)
I almost managed to do what I want but not quite.
My selectInput box is empty when running the code and you can select amongst 10 items (from 1 to 10). This is fine.
Now I would like, when clicking on the button "First fives", the numbers 1 to 5 to be added to this empty box. In others words I would like to get the same as on the picture below in one click.
Please add selected on the updateSelectInput. The code will be like this:
observeEvent(input$First_fives,{
updateSelectInput(session, inputId = "selection", choices = vec[1:5],selected = vec[1:5])
})
observeEvent(input$Last_fives,{
updateSelectInput(session, inputId = "selection", choices = vec[6:10],selected = vec[6:10])
})
Please not I have only checked this function,not others.
Pls check if this meet your requirements.

Resources