Related
In my Shiny application, I have the functionality to insert a new line of information, this is done via InsertUI. Then for every added line, the source of that line can be updated via an actionButton. The actionButton leads to a modalDialog, allowing the user to insert the text for the source there.
To prevent multiple lines getting the same source after updating, a moduleServer is used for the part around the modalDialog. That works well, with the only exception that after the first time the modalDialog is used (with inside an action button that updates the text after insertion), the modalDialog closes directly after clicking. Reclicking does give the pop-up again, but is somewhat annoying.
Any suggestions to prevent this?
Example UI and server with this behaviour:
UI.R
library(shiny)
shinyUI(fluidPage(
div(id = "input_add_div_block"),
br(),
# Input for the new line
div(style="display:inline-block", # div inline-block is used to get two input boxes on the same line
textInput(inputId = "input_new_line",
label = "Give description of new line")
),
# Adding a new line
div(style="display:inline-block", # div inline-block is used to get two input boxes on the same line
id = "input_add_div",
actionButton("input_add", "Add new line")
)
))
Server.R
library(shiny)
shinyServer(function(input, output, session) {
data <- reactiveValues(
lines = list()
)
observeEvent(input$input_add, {
current_lines <- length(data$lines)
n <- current_lines + 1
insertUI(selector = "#input_add_div_block",
where = "beforeEnd", # insert after last element
ui = fluidPage(
div(style="display:inline-block"), # div inline-block is used to get two input boxes on the same line
# Adding input field
numericInput(inputId = paste0("input_", n),
label = paste0(input$input_new_line, " - % of previous line"),
value = 10,
min = 0,
max = 100
),
actionButton(inputId = paste0("input_", n,"_source"),
label = "No source")
)
)
observeEvent(input[[paste0("input_", current_lines+1,"_source")]],{
update_source_UI(id = paste0("source",n), data = data, n = n)
update_source_Server(id = paste0("source",n), data = data, n = n, original_session = session)
})
})
})
update_source_UI <- function(id, data, label = "Update UI", n){
ns <- NS(id)
showModal(
modalDialog(
title = "Update source",
textInput(inputId = ns("new_source"), label = "Update the source",
value = "Assumption"),
actionButton(inputId = ns("add_source"),
label = "Update the source"),
"\n",
actionButton(inputId = ns("cancel"),
label = "Cancel"),
easyClose = TRUE,
footer = NULL
)
)
}
# Pop-up to change the source of the funnel line input
update_source_Server <- function(id, data, n, original_session){
moduleServer(
id,
function(input, output, session) {
ns <- session$ns
# When the user clicks "Update the source", the source is updated
observeEvent(input$add_source,{
updateActionButton(session = original_session,
inputId = paste0("input_", n,"_source"),
label = paste0("Source: ", input$new_source))
removeModal()
data$button_status[[1]] <- FALSE
})
# When the user clicks "Cancel", the modal is removed without changes
observeEvent(input$cancel,{
removeModal()
})
}
)
}
A few points:
I've never seen showModule in the UI part, normally you use it in the server; it's interesting that it works nevertheless
at least in your example, n is always 1, therefore you don't have unique ids which leads to problems
I find passing session objects to modules to refer to something defined in the main server quite complicated
I propose to pack everything for one line into a module and then handle the logic there. I think it's easier and you already work with modules.
My take:
library(shiny)
one_line_UI <- function(id, input_new_line){
ns <- NS(id)
tagList(
div(style="display:inline-block"), # div inline-block is used to get two input boxes on the same line
# Adding input field
numericInput(inputId = ns("input_number"),
label = paste0(input_new_line(), " - % of previous line"),
value = 10,
min = 0,
max = 100
),
actionButton(inputId = ns("input_source"),
label = "No source")
)
}
# Pop-up to change the source of the funnel line input
one_line_Server <- function(id, data){
moduleServer(
id,
function(input, output, session) {
ns <- session$ns
observeEvent(input$input_source, {
showModal(
modalDialog(
title = "Update source",
textInput(inputId = ns("new_source"), label = "Update the source",
value = "Assumption"),
actionButton(inputId = ns("add_source"),
label = "Update the source"),
"\n",
actionButton(inputId = ns("cancel"),
label = "Cancel"),
easyClose = TRUE,
footer = NULL
)
)
})
# When the user clicks "Update the source", the source is updated
observeEvent(input$add_source,{
updateActionButton(inputId = "input_source",
label = paste0("Source: ", input$new_source))
removeModal()
data$button_status[[1]] <- FALSE
})
# When the user clicks "Cancel", the modal is removed without changes
observeEvent(input$cancel,{
removeModal()
})
}
)
}
ui <- fluidPage(
div(id = "input_add_div_block"),
br(),
# Input for the new line
div(style="display:inline-block", # div inline-block is used to get two input boxes on the same line
textInput(inputId = "input_new_line",
label = "Give description of new line")
),
# Adding a new line
div(style="display:inline-block", # div inline-block is used to get two input boxes on the same line
id = "input_add_div",
actionButton("input_add", "Add new line")
)
)
server <- function(input, output, session) {
data <- reactiveValues(
lines = list(),
n = 0
)
observeEvent(input$input_add, {
n <- data$n + 1
insertUI(selector = "#input_add_div_block",
where = "beforeEnd", # insert after last element
ui = one_line_UI(id = n,
input_new_line = reactive({input$input_new_line}))
)
one_line_Server(id = n, data = data)
data$n <- n
})
}
shinyApp(ui, server)
If you want more information, you can also check out my tutorial how to dynamically add modules.
I am trying to design a search feature where you can search via a text input and through check boxes (I am using shinyWidgets), except for some reason, when you hit enter inside the text input it is activating my "ALL/NONE" button.
The goal is that when the ALL/NONE button is hit that it alternates between selecting all of the check boxes and selecting none of them. The issue is that hitting enter in the text box also seems to activate the observe, even when it should only be activating by the button.
library(shiny)
library(shinyWidgets)
Habitat <- c("grass", "water", "stone")
ID <- c(1, 2, 3)
data <- data.frame(ID, Habitat)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
width = 2,
textInput("keyword_search", label = "Search by Keyword"),
uiOutput("h_button"),
uiOutput("habitat_filter")
),
mainPanel(width = 10
))
)
server <- function(input, output, session) {
output$habitat_filter <- renderUI({
habitat_choices <- checkboxGroupInput(inputId = "habitat", label = "",
choices = unique(data$Habitat[!is.na(data$Habitat)]),
selected = unique(data$Habitat[!is.na(data$Habitat)]))
})
output$h_button <- renderUI({
habitat_button <- checkboxGroupButtons(
inputId = "habitat_switch",
choices = "ALL / NONE",
size = "sm",
selected = "ALL / NONE")
})
observe({ #all/none button for habitats
x <- input$habitat_switch
if (!is.null(x)) {
x <- unique(data$Habitat[!is.na(data$Habitat)])
}
else {
x <- character(0)
}
updateCheckboxGroupInput(
session,
"habitat",
label = NULL,
choices = unique(data$Habitat[!is.na(data$Habitat)]),
selected = x
)
})
}
shinyApp(ui = ui, server = server)
Weirdly, this problem seems to go away if it is coded outside of the sidebarLayout. i.e. if the ui side looks like this:
ui <- fluidPage(
textInput("keyword_search", label = "Search by Keyword", width = '100%', placeholder = "Type here to search the archive..."),
uiOutput("h_button"),
uiOutput("habitat_filter")
)
Unfortunately, I need the sidebar so removing it isn't an option for fixing the problem. Does anyone have a solution to prevent these features from being connected? Or an explanation for why this happening?
Replacing my observe for the button with this seems to avoid the problem as suggested here: Select/Deselect All Button for shiny variable selection
observe({ #all/none button for habitats
x <- unique(data$Habitat[!is.na(data$Habitat)])
if (!is.null(input$habitat_switch) && input$habitat_switch >= 0) {
if (input$habitat_switch %% 2 == 0) {
x <- unique(data$Habitat[!is.na(data$Habitat)])
}
else {
x <- character(0)
}
}
updateCheckboxGroupInput(
session,
"habitat",
label = NULL,
choices = sort(unique(data$Habitat[!is.na(data$Habitat)])),
selected = x
)
})
Still no idea what caused this issue initially, but this work around seems good enough
I want to make an app with 2 actionButtons: 1) to submit the changes before loading a selectizeInput and 2) to draw the plot.
I know how to add a spinner after clicking a actionButton but the majority of the cases is added when you want to show the plot.
However, is it possible to add a spinner without showing any plot?
In this particular case, I want to show a spinner after clicking "Submit" until the selectizeInput from the 'Selection tab' is loaded. As you can see the example that I attach, it takes a bit to load all the choices (since the file has 25000 rows).
I already have one spinner after clicking the second actionButton (Show the plot) but I need one more.
I have created an example, but for some reason the plot is not shown in the shiny app and it appears in the window from R (I don't know why but I added the plot just to show you how I put the second spinner. I want a similar one but with the first actionButton.).
library(shiny)
library(shinycssloaders)
ui <- fluidPage(
titlePanel("My app"),
sidebarLayout(
sidebarPanel(
tabsetPanel(
tabPanel("Submit",
checkboxInput("log2", "Log2 transformation", value = FALSE),
actionButton("submit", "Submit")
),
tabPanel("Selection",
br(),
selectizeInput(inputId = "numbers", label = "Choose one number:", choices=character(0)),
actionButton("show_plot", "Show the plot")
))
),
mainPanel(
conditionalPanel(
condition = "input.show_plot > 0",
style = "display: none;",
withSpinner( plotOutput("hist"),
type = 5, color = "#0dc5c1", size = 1))
)
)
)
server <- function(input, output, session) {
data <- reactive({
data = read.csv("https://people.sc.fsu.edu/~jburkardt/data/csv/hw_25000.csv")
data[,1] <- as.character(data[,1])
if(input$log2 == TRUE){
cols <- sapply(data, is.numeric)
data[cols] <- lapply(data[cols], function(x) log2(x+1))
}
return(data)
})
mylist <- reactive({
req(data())
data <- data()
data <- data[,1]
return(data)
})
# This is to generate the choices (gene list) depending on the user's input.
observeEvent(input$submit, {
updateSelectizeInput(
session = session,
inputId = "numbers",
choices = mylist(), options=list(maxOptions = length(mylist()))
)
})
v <- reactiveValues()
observeEvent(input$show_plot, {
data <- data()
v$plot <- plot(x=data[,1], y=data[,2])
})
# If the user didn't choose to see the plot, it won't appear.
output$hist <- renderPlot({
req(data())
if (is.null(v$plot)) return()
if(input$show_plot > 0){
v$plot
}
})
}
Does anyone know how to help me, please?
Thanks very much
It's a little tricky.
First of all I'd update the selectizeInput on the server side as the warning suggests:
Warning: The select input "numbers" contains a large number of
options; consider using server-side selectize for massively improved
performance. See the Details section of the ?selectizeInput help
topic.
Furthermore I switched to ggplot2 regarding the plotOutput - Please see this related post.
To show the spinner while the selectizeInput is updating choices we'll need to know how long the update takes. This information can be gathered via shiny's JS events - please also see this article.
Finally, we can show the spinner for a non-existent output, so we are able to control for how long the spinner is shown (see uiOutput("dummyid")):
library(shiny)
library(shinycssloaders)
library(ggplot2)
ui <- fluidPage(
titlePanel("My app"),
tags$script(HTML(
"
$(document).on('shiny:inputchanged', function(event) {
if (event.target.id === 'numbers') {
Shiny.setInputValue('selectizeupdate', true, {priority: 'event'});
}
});
$(document).on('shiny:updateinput', function(event) {
if (event.target.id === 'numbers') {
Shiny.setInputValue('selectizeupdate', false, {priority: 'event'});
}
});
"
)),
sidebarLayout(
sidebarPanel(
tabsetPanel(
tabPanel("Submit",
checkboxInput("log2", "Log2 transformation", value = FALSE),
actionButton("submit", "Submit")
),
tabPanel("Selection",
br(),
selectizeInput(inputId = "numbers", label = "Choose one number:", choices=NULL),
actionButton("show_plot", "Show the plot")
))
),
mainPanel(
uiOutput("plotProxy")
)
)
)
server <- function(input, output, session) {
previousEvent <- reactiveVal(FALSE)
choicesReady <- reactiveVal(FALSE)
submittingData <- reactiveVal(FALSE)
observeEvent(input$selectizeupdate, {
if(previousEvent() && input$selectizeupdate){
choicesReady(TRUE)
submittingData(FALSE)
} else {
choicesReady(FALSE)
}
previousEvent(input$selectizeupdate)
})
data <- reactive({
data = read.csv("https://people.sc.fsu.edu/~jburkardt/data/csv/hw_25000.csv")
if(input$log2 == TRUE){
cols <- sapply(data, is.numeric)
data[cols] <- lapply(data[cols], function(x) log2(x+1))
}
return(data)
})
mylist <- reactive({
req(data()[,1])
})
observeEvent(input$submit, {
submittingData(TRUE)
reactivePlotObject(NULL) # reset
updateSelectizeInput(
session = session,
inputId = "numbers",
choices = mylist(), options=list(maxOptions = length(mylist())),
server = TRUE
)
})
reactivePlotObject <- reactiveVal(NULL)
observeEvent(input$show_plot, {
reactivePlotObject(ggplot(data(), aes_string(x = names(data())[1], y = names(data())[2])) + geom_point())
})
output$hist <- renderPlot({
reactivePlotObject()
})
output$plotProxy <- renderUI({
if(submittingData() && !choicesReady()){
withSpinner(uiOutput("dummyid"), type = 5, color = "#0dc5c1", size = 1)
} else {
conditionalPanel(condition = "input.show_plot > 0", withSpinner(plotOutput("hist"), type = 5, color = "#0dc5c1", size = 1), style = "display: none;")
}
})
}
shinyApp(ui, server)
First 100 rows of your example data (dput(head(data, 100)) - your link might be offline some day):
structure(list(Index = 1:100, Height.Inches. = c(65.78331, 71.51521,
69.39874, 68.2166, 67.78781, 68.69784, 69.80204, 70.01472, 67.90265,
66.78236, 66.48769, 67.62333, 68.30248, 67.11656, 68.27967, 71.0916,
66.461, 68.64927, 71.23033, 67.13118, 67.83379, 68.87881, 63.48115,
68.42187, 67.62804, 67.20864, 70.84235, 67.49434, 66.53401, 65.44098,
69.5233, 65.8132, 67.8163, 70.59505, 71.80484, 69.20613, 66.80368,
67.65893, 67.80701, 64.04535, 68.57463, 65.18357, 69.65814, 67.96731,
65.98088, 68.67249, 66.88088, 67.69868, 69.82117, 69.08817, 69.91479,
67.33182, 70.26939, 69.10344, 65.38356, 70.18447, 70.40617, 66.54376,
66.36418, 67.537, 66.50418, 68.99958, 68.30355, 67.01255, 70.80592,
68.21951, 69.05914, 67.73103, 67.21568, 67.36763, 65.27033, 70.84278,
69.92442, 64.28508, 68.2452, 66.35708, 68.36275, 65.4769, 69.71947,
67.72554, 68.63941, 66.78405, 70.05147, 66.27848, 69.20198, 69.13481,
67.36436, 70.09297, 70.1766, 68.22556, 68.12932, 70.24256, 71.48752,
69.20477, 70.06306, 70.55703, 66.28644, 63.42577, 66.76711, 68.88741
), Weight.Pounds. = c(112.9925, 136.4873, 153.0269, 142.3354,
144.2971, 123.3024, 141.4947, 136.4623, 112.3723, 120.6672, 127.4516,
114.143, 125.6107, 122.4618, 116.0866, 139.9975, 129.5023, 142.9733,
137.9025, 124.0449, 141.2807, 143.5392, 97.90191, 129.5027, 141.8501,
129.7244, 142.4235, 131.5502, 108.3324, 113.8922, 103.3016, 120.7536,
125.7886, 136.2225, 140.1015, 128.7487, 141.7994, 121.2319, 131.3478,
106.7115, 124.3598, 124.8591, 139.6711, 137.3696, 106.4499, 128.7639,
145.6837, 116.819, 143.6215, 134.9325, 147.0219, 126.3285, 125.4839,
115.7084, 123.4892, 147.8926, 155.8987, 128.0742, 119.3701, 133.8148,
128.7325, 137.5453, 129.7604, 128.824, 135.3165, 109.6113, 142.4684,
132.749, 103.5275, 124.7299, 129.3137, 134.0175, 140.3969, 102.8351,
128.5214, 120.2991, 138.6036, 132.9574, 115.6233, 122.524, 134.6254,
121.8986, 155.3767, 128.9418, 129.1013, 139.4733, 140.8901, 131.5916,
121.1232, 131.5127, 136.5479, 141.4896, 140.6104, 112.1413, 133.457,
131.8001, 120.0285, 123.0972, 128.1432, 115.4759)), row.names = c(NA,
100L), class = "data.frame")
I have an app which creates boxes. Each box has a button that triggers a modal. The modal has inputs which the user changes and then a button which triggers an action based on those inputs (basically just uploading to a database). Because each box has a different specification, I wrote a module and then loop thru a list, creating a box for each element. This works fine.
However, the flow in the modal and observeEvent has a flaw: the first run thru I get the desired results, but on the second occasion in the same box (same id module), after pressing the modal button to update, it will not use the new inputs, but rather what happened in the first run. I am guessing it has something to do with the namespace/observeEvent combination as I might be triggering the event with a "stored" namespace? Would I need to somehow "flush" the namespace after every update? Anyway, any help appreciated as it gets confusing fast with all the namespace/modules combinations.
library(shiny)
library(shinyWidgets)
ui <- navbarPage(
'page', collapsible = TRUE,
tabPanel("test",
useSweetAlert(),
sidebarLayout(
sidebarPanel(),
mainPanel(
uiOutput('all_products_ui')
)
)
)) # end navbar
server <- shinyServer(function(input, output) {
list_products <- c(1,2,3,4,5)
# Now, I will create a UI for all the products
output$all_products_ui <- renderUI({
r <- tagList()
progress_move <- 0
for(k in 1:length( list_products )){
r[[k]] <- ExistingProductUI(id = k, product = list_products[[k]] )
}
r
})
# handlers duplicate a call to module depending on the id of ExistingProductUI
handlers <- list()
observe(
handlers <<- lapply(seq.int(length( list_products )),
function(i) {
callModule(ExistingProductUpdate,
id = i,
product = list_products[[i]] )
})
)
handlers
}) # end of server ----
# UI module ------------------------------------------------------
ExistingProductUI <- function(id, product){
ns <- NS(id)
box(title = as.character(p$title),
product["title"],
footer = tagList(
actionBttn(
inputId = ns("change_selected"), label = "change"),
)
)
}
# server module ------------------------------------------------------
ExistingProductUpdate <- function(input, output, session, product){
ns <- session$ns
observeEvent(input$change_selected, {
# when box button is clicked for this product (id)
# FIRST: show a modal
showModal(
modalDialog(
title = "what do you want to change?",
tagList(
radioGroupButtons(inputId = ns("change_selected_choice"), labels = "change x", choices = c(1,2,3,4)),
sliderInput(ns("change_selected_pct"), "change y:", min = -50, max = 100, value = 0, step = 5)
),
easyClose = TRUE,
footer = tagList(
actionButton(ns("change_selected_submit"), "submit!", icon = icon("check")),
modalButton("never mind")
)
)
)
# SECOND: when change_selected_submit is clicked,
observeEvent(input$change_selected_submit, {
# do some calculations with product using what I inputed in modal ---
# then, update a table ----
functionToUploadThings(product, input$change_selected_choice)
# THIRD: Close with a confirmation
sendSweetAlert(
session,
title = "Success!",
type = "success",
btn_labels = "Ok",
closeOnClickOutside = TRUE,
width = NULL
)
})
})
}
Below is a solution that works. The problem was that you nested your observeEvent in the module. I'm not entirely sure why this led to problems, some values weren't processed correctly. However, you don't need to nest the observeEvent, the second one gets also triggered by the actionButton in the modal when it is by its own. Additionally, I included a removeModal before the success notification is shown:
library(shiny)
library(shinyWidgets)
library(shinydashboard)
ui <- navbarPage(
'page', collapsible = TRUE,
tabPanel("test",
useSweetAlert(),
sidebarLayout(
sidebarPanel(),
mainPanel(
uiOutput('all_products_ui')
)
)
)) # end navbar
server <- shinyServer(function(input, output) {
list_products <- c(1,2,3,4,5)
# Now, I will create a UI for all the products
output$all_products_ui <- renderUI({
r <- tagList()
progress_move <- 0
for(k in 1:length( list_products )){
r[[k]] <- ExistingProductUI(id = k, product = list_products[[k]] )
}
r
})
# handlers duplicate a call to module depending on the id of ExistingProductUI
handlers <- list()
observe(
handlers <<- lapply(seq.int(length( list_products )),
function(i) {
callModule(ExistingProductUpdate,
id = i,
product = list_products[[i]] )
})
)
handlers
}) # end of server ----
# UI module ------------------------------------------------------
ExistingProductUI <- function(id, product){
ns <- NS(id)
box(title = as.character(product),
product,
footer = tagList(
actionBttn(
inputId = ns("change_selected"), label = "change"),
)
)
}
# server module ------------------------------------------------------
ExistingProductUpdate <- function(input, output, session, product){
ns <- session$ns
observeEvent(input$change_selected, {
# when box button is clicked for this product (id)
# FIRST: show a modal
showModal(
modalDialog(
title = "what do you want to change?",
tagList(
radioGroupButtons(inputId = ns("change_selected_choice"), label = "change x", choices = c(1,2,3,4)),
sliderInput(ns("change_selected_pct"), "change y:", min = -50, max = 100, value = 0, step = 5)
),
easyClose = TRUE,
footer = tagList(
actionButton(ns("change_selected_submit"), "submit!", icon = icon("check")),
modalButton("never mind")
)
)
)
})
# SECOND: when change_selected_submit is clicked,
observeEvent(input$change_selected_submit, {
# do some calculations with product using what I inputed in modal ---
# then, update a table ----
# functionToUploadThings(product, input$change_selected_choice)
# THIRD: Close with a confirmation
removeModal()
sendSweetAlert(
session,
title = "Success!",
type = "success",
btn_labels = "Ok",
closeOnClickOutside = TRUE,
width = NULL
)
})
}
shinyApp(ui, server)
Please note: I made some modifications to make your MWE work:
include library(shinydashboard)
p$title and product["title"] to product
change labels to label in radioGroupButtons
comment out functionToUploadThings(product, input$change_selected_choice)
Edit
I'm still not super sure what happens when nesting the observeEvents. I made a small toy example and played around with the reactlog. It seems that nesting the observers generates a new observer for button2 every time button1 is clicked. These observers are not removed and lead to unwanted behaviour. In contrast, when using separate observeEvents, the observer for button2 is only created once.
library(shiny)
library(reactlog)
ui <- fluidPage(
actionButton("button1", "click")
)
server <- function(input, output, session) {
observeEvent(input$button1, {
print("from first observer")
print(input$button2)
showModal(
modalDialog(
title = "what do you want to change?",
"some text",
easyClose = TRUE,
footer = tagList(
actionButton("button2", "submit!", icon = icon("check")),
modalButton("never mind")
)
)
)
# nested observer -> leads to remaining observers
observeEvent(input$button2, {
print("from second observer")
print(input$button2)
removeModal()
})
})
# independent observer -> generates only one observer
# observeEvent(input$button2, {
# print("from second observer")
# print(input$button2)
# removeModal()
# })
}
shinyApp(ui, server)
My shiny app begins with a checkboxGroupInput which contains the names of three companies: A, B and C. It also has 3 hidden numeric inputs, each corresponding to a company. Potential investors may select the name of the company they wish to invest in and specifiy the amount they are willing to invest. When the name of a company is checked, the corresponding numeric input shows up. Also, when the company name is unchecked, the numeric input disappears.
The checkboxGroupInput is called company. The 3 numericInput fields are respectively called amountA, amountB and amountC and are all generated inside a uiOutput. They are hidden with the hidden function of shinyjs.
library(shiny)
library(shinyjs)
library(magrittr)
ui <- fluidPage(
useShinyjs(),
checkboxGroupInput(inputId = "company", label = "Select a company", choices = LETTERS[1:3]),
uiOutput(outputId = "amounts")
)
server <- function(input, output){
company_names <- LETTERS[1:3]
num_ids <- paste0("amount", LETTERS[1:3])
output$amounts <- renderUI({
num_inputs <- lapply(1:3, function(i){
numericInput(inputId = num_ids[i], label = paste0("Investment in ", company_names[i]), value = 0, min = 0, max = 5000)
}) %>% tagList
shinyjs::hidden(num_inputs)
})
observeEvent(eventExpr = input$company, handlerExpr = {
if(length(input$company) == 0){
for(i in num_ids){
shinyjs::hide(id = i)
}
} else {
for(i in input$company){
shinyjs::toggle(id = paste0("amount", i), condition = input$company)
}
}
})
}
shinyApp(ui = ui, server = server)
The problem with my app is that the intended dynamics between the checkboxGroupInput and the numericInput fields are not working as intended. For instance, once a numericInput is shown, it cannot be hidden anymore by unchecking the boxes. How can I handle this?
The code pasted above is fully functional. Thank you very much.
I fixed your code by explicitly show/hide the numericInput when the corresponding check box is selected/unselected. Also I change the observeEvent with observe to make sure that the observer reacts when none of the check boxes are selected.
library(shiny)
library(shinyjs)
library(magrittr)
ui <- fluidPage(
useShinyjs(),
checkboxGroupInput(inputId = "company", label = "Select a company", choices = LETTERS[1:3]),
uiOutput(outputId = "amounts")
)
server <- function(input, output){
company_names <- LETTERS[1:3]
num_ids <- paste0("amount", LETTERS[1:3])
output$amounts <- renderUI({
num_inputs <- lapply(1:3, function(i){
numericInput(inputId = num_ids[i], label = paste0("Investment in ", company_names[i]), value = 0, min = 0, max = 5000)
}) %>% tagList
shinyjs::hidden(num_inputs)
})
observe({
for(i in company_names){
if (i %in% input$company) {
shinyjs::show(id = paste0("amount", i))
} else {
shinyjs::hide(id = paste0("amount", i))
}
}
})
}
shinyApp(ui = ui, server = server)