Is there a method to using removeUI in for loop? - r

Question

I'm dynamically generating inputs using a custom function render_panels that creates a wellPanel with a selectizeInput and actionButton contained within, the actionButton removes the entire wellPanel using removeUI by using the id of the div as the selector. I also have a global add button to add new wellPanel.
I have a method to remove the wellPanel by observing the remove button event for each panel, then using removeUI and specifying corresponding div id as selector, but I'm wondering if there is a more efficient method to do this with either for loop or vectorized approach.
Edit Note: Instead of insertUI, I'm specifically using this approach in order to provide the ability to initialize the app with panels already inserted. The shiny app will be executed as a function where users could provide a character vector of dropdown selection values, for example. I've added a character vector prevInputs inside server, a reactive value counter$n which has replaced input$add in order to create initial panels of length(prevInputs) if !is.null(prevInputs) and a method to initialize the selected values argument for selectizeInput with existing values inside make_panels to illustrate the point.
See reprex:
library(shiny)
render_panels <- function(n, removed_panels, inputs){
make_panels <- function(n, inputs){
panels <- tags$div(id = n,
wellPanel(
selectizeInput(inputId = paste0("dropdown", n), label = paste0("dropdown", n), choices = c("a", "b", "c"), selected = inputs[[paste0("dropdown", n)]]),
actionButton(paste0("remove", n), label = paste0("remove", n))
)
)
}
ui_out <- vector(mode = "list", length = n)
for(i in seq_along(ui_out)){
if(i %in% removed_panels) next
ui_out[[i]] <- tagList(
make_panels(n = i, inputs)
)
}
return(ui_out)
}
ui <- fluidPage(
fluidRow(
column(width = 6,
actionButton("add", label = "add"),
uiOutput("mypanels")
)
)
)
server <- function(input, output, session){
removed <- reactiveValues(
values = list()
)
prevInputs <- c("a", "b", "c")
reactiveInputs <- reactiveValues(values = list())
observe({
reactiveInputs$values$dropdown1 = prevInputs[[1]]
reactiveInputs$values$dropdown2 = prevInputs[[2]]
reactiveInputs$values$dropdown3 = prevInputs[[3]]
})
counter <- reactiveValues(n = ifelse(!is.null(prevInputs), length(prevInputs), 0))
observeEvent(input$add, {
counter$n <- counter$n + 1
})
observeEvent(input$remove1,{
removed$values <- c(removed$values, 1)
removeUI(
selector = "div#1", immediate = TRUE,
)
}, once = TRUE)
observeEvent(input$remove2,{
removed$values <- c(removed$values, 2)
removeUI(
selector = "div#2", immediate = TRUE,
)
}, once = TRUE)
observeEvent(input$remove3,{
removed$values <- c(removed$values, 3)
removeUI(
selector = "div#3", immediate = TRUE,
)
}, once = TRUE)
output$mypanels <- renderUI({
render_panels(n = counter$n, removed_panels = removed$values, inputs = reactiveInputs$values)
})
}
shinyApp(ui, server)
As you can see, if there are 100 wellPanels generated, I'd have to use 100 observeEvent, not what we want...here is my attempt at for loop:
I'd like to replace all observeEvent calls with something like below, but cannot seem to get things working.
observe({
req(input$remove1)
for(i in seq_len(input$add)){
if(input[[paste0("remove", i)]] == 1){
removeUI(selector = paste0("div#", i), immediate = TRUE)
}
}
})
Edit:
Here is an attempt from a provided answer using shinymaterial package for alternative UI. Note shinymaterial package requires you to wrap ui elements in render_material_from_server inside renderUI for any UI generated on the server side i.e.
output$dropdown <- renderUI({
render_material_from_server(
material_dropdown(input_id = paste0("dropdown", n), label = paste0("dropdown", n), choices = c("a", "b", "c"), selected = "a")
)
})
This function render_material_from_server is newly available and only exists in current development version of package on GH: shinymaterial
In any case, insertUI does not render UI elements as expected using material_page UI of from shinymaterial
library(shiny)
library(shinymaterial)
make_panels <- function(n, selected){
tags$div(
material_card(
material_dropdown(input_id = paste0("dropdown", n), label = paste0("dropdown", n), choices = c("a", "b", "c"), selected = selected),
actionButton(paste0("remove", n), label = paste0("remove", n), class = "mybtn")
)
)
}
ui <- material_page(
tags$script("
$(document).on('click', '.mybtn', function(){
$(this).parent().remove();
})
"),
material_row(
material_column(width = 6,
actionButton("add", label = "add"),
uiOutput("mypanels")
)
)
)
server <- function(input, output, session){
choices = c("a", "b", "c")
init_counter <- reactiveVal(3)
observe({
for(i in seq_len(isolate(init_counter()))){
insertUI(selector = "#mypanels", where = "beforeEnd", ui = make_panels(i, choices[i]))
}
})
observeEvent(input$add, {
panel_index <- init_counter() + input$add
insertUI(selector = "#mypanels", where = "beforeEnd", ui = make_panels(panel_index, choices[panel_index]))
})
}
shinyApp(ui, server)

Answer 1

I think that this situation is a good usecase for modules. Basically, you only write the code once how to generate a panel and then call this module every time you want a new panel. Inside the module, the observeEvent is automatically generated so you don't have to repeat code.
2 things to add:
if you want to access the data returned by the module, you need to store the output of the module call in the main server function
having a lot of modules generates a lot of observers. These observers also stay when a module ui is removed. See this blog post how to deal with this if it should get a problem.
library(shiny)
mod_panel_ui <- function(id) {
ns <- NS(id)
panel_number <- regmatches(id,
regexpr("[0-9]+", id))
tags$div(id = id,
wellPanel(
selectizeInput(inputId = ns("dropdown"),
label = paste0("dropdown ", panel_number),
choices = c("a", "b", "c"),
selected = NULL),
actionButton(ns("remove"), label = paste0("remove ", panel_number))
)
)
}
mod_panel <- function(id) {
moduleServer(id,
function(input, output, session) {
observeEvent(input$remove, {
removeUI(selector = paste0("div#", id))
})
})
return(list(
dropdown = reactive(input$dropdown)
))
}
ui <- fluidPage(
fluidRow(
column(width = 6,
actionButton("add", label = "add"),
div(id = "add_panels_here")
)
)
)
server <- function(input, output, session) {
counter_panels <- 1
observeEvent(input$add, {
current_id <- paste0("panel_", counter_panels)
mod_panel(current_id)
insertUI(selector = "#add_panels_here",
ui = mod_panel_ui(current_id))
# update counter
counter_panels <<- counter_panels + 1
})
}
shinyApp(ui, server)
Edit
Here is a solution that uses shinymaterial and already shows 2 panels on startup. The selected element can be specified by an additional argument to the module server function:
library(shiny)
library(shinymaterial)
mod_panel_ui <- function(id) {
ns <- NS(id)
uiOutput(ns("placeholder"))
}
mod_panel <- function(id, selection = NULL) {
moduleServer(id,
function(input, output, session) {
# generate the UI on the server side
ns <- session$ns
panel_number <- regmatches(id,
regexpr("[0-9]+", id))
output$placeholder <- renderUI({render_material_from_server(tags$div(id = id,
material_card(
material_dropdown(input_id = ns("dropdown"),
label = paste0("dropdown ", panel_number),
choices = c("a", "b", "c"),
selected = selection),
actionButton(ns("remove"), label = paste0("remove ", panel_number))
)
))
})
# remove the element
observeEvent(input$remove, {
removeUI(selector = paste0("div#", id))
})
})
return(list(
dropdown = reactive(input$dropdown)
))
}
ui <- material_page(
material_row(
material_column(width = 6,
actionButton("add", label = "add"),
div(id = "add_panels_here")
)
)
)
server <- function(input, output, session) {
counter_panels <- 1
panels_on_startup <- 2
selected_on_startup <- c("b", "c")
# add counters on startup
lapply(seq_len(panels_on_startup), function(i) {
current_id <- paste0("panel_", counter_panels)
mod_panel(current_id, selected_on_startup[i])
insertUI(selector = "#add_panels_here",
ui = mod_panel_ui(current_id))
# update counter
counter_panels <<- counter_panels + 1
})
observeEvent(input$add, {
current_id <- paste0("panel_", counter_panels)
mod_panel(current_id)
insertUI(selector = "#add_panels_here",
ui = mod_panel_ui(current_id))
# update counter
counter_panels <<- counter_panels + 1
})
}
shinyApp(ui, server)

Answer 2

There is a very simple way to do so if you know some javascript.
There is no need to use for loop
There is no need to save things in a list.
There is no need for renderUI
There is no need to observe every panel
All you need to do is add a js listener to the remove button and add a class in R class = "mybtn" for js to listen to.
$(document).on('click', '.mybtn', function(){
$(this).parent().remove();
})
In your server, you need to think the reverse way, using insertUI rather than removeUI. You only need one observer for the add button. When every time you click on add, add a panel to a div. In my case, I'm lazy, so I just directly select your uiOutput("mypanels")
library(shiny)
make_panels <- function(n){
tags$div(
wellPanel(
selectizeInput(inputId = paste0("dropdown", n), label = paste0("dropdown", n), choices = c("a", "b", "c"), selected = NULL),
actionButton(paste0("remove", n), label = paste0("remove", n), class = "mybtn")
)
)
}
ui <- fluidPage(
tags$script("
$(document).on('click', '.mybtn', function(){
$(this).parent().remove();
})
"),
fluidRow(
column(width = 6,
actionButton("add", label = "add"),
uiOutput("mypanels")
)
)
)
server <- function(input, output, session){
observeEvent(input$add, {
insertUI(selector = "#mypanels", where = "beforeEnd", ui = make_panels(input$add))
})
observe({
print(input$dropdown5)
})
}
shinyApp(ui, server)
To make sure this works, I add a test observer to watch the dropdown5 (the dropdown when you add the 5th panel). You will see the dropdown value in console once you add the 5th panel.
EDIT for your note:
You can still insert with preset panels. Add a reactive counter for how many panels you want to initiate. Just make sure you isolate the counter and the choice if that is reactive too. In my example choice is hard-coded so I didn't isolate. This is to prevent the panel initialization been run later. The observe I added will only run once.
I also use [] instead of [[]] which gives NA instead of error when out of boundary.
library(shiny)
make_panels <- function(n, selected){
tags$div(
wellPanel(
selectizeInput(inputId = paste0("dropdown", n), label = paste0("dropdown", n), choices = c("a", "b", "c"), selected = selected),
actionButton(paste0("remove", n), label = paste0("remove", n), class = "mybtn")
)
)
}
ui <- fluidPage(
tags$script("
$(document).on('click', '.mybtn', function(){
$(this).parent().remove();
})
"),
fluidRow(
column(width = 6,
actionButton("add", label = "add"),
uiOutput("mypanels")
)
)
)
server <- function(input, output, session){
choices = c("a", "b", "c")
init_counter <- reactiveVal(3)
observe({
for(i in seq_len(isolate(init_counter()))){
insertUI(selector = "#mypanels", where = "beforeEnd", ui = make_panels(i, choices[i]))
}
})
observeEvent(input$add, {
panel_index <- init_counter() + input$add
insertUI(selector = "#mypanels", where = "beforeEnd", ui = make_panels(panel_index, choices[panel_index]))
})
}
shinyApp(ui, server)
To work with materialUI:
change the tags$script() to this one
library(shiny)
library(shinymaterial)
make_panels <- function(n, selected){
tags$div(
material_card(
material_dropdown(input_id = paste0("dropdown", n), label = paste0("dropdown", n), choices = c("a", "b", "c"), selected = selected),
actionButton(paste0("remove", n), label = paste0("remove", n), class = "mybtn")
)
)
}
ui <- material_page(
HTML("<script>
$(document).on('click', '.mybtn', function(){
$(this).parent().remove();
})
var formatDropdown = function() {
function initShinyMaterialDropdown(callback) {
$('.shiny-material-dropdown').formSelect();
callback();
}
initShinyMaterialDropdown(function() {
var shinyMaterialDropdown = new Shiny.InputBinding();
$.extend(shinyMaterialDropdown, {
find: function(scope) {
return $(scope).find('select.shiny-material-dropdown');
},
getValue: function(el) {
var ans;
ans = $(el).val();
if (ans === null) {
return ans;
}
if (typeof(ans) == 'string') {
return ans.replace(new RegExp('_shinymaterialdropdownspace_', 'g'), ' ');
} else if (typeof(ans) == 'object') {
for (i = 0; i < ans.length; i++) {
if (typeof(ans[i]) == 'string') {
ans[i] = ans[i].replace(new RegExp('_shinymaterialdropdownspace_', 'g'), ' ');
}
}
return ans;
} else {
return ans;
}
},
subscribe: function(el, callback) {
$(el).on('change.shiny-material-dropdown', function(e) {
callback();
});
},
unsubscribe: function(el) {
$(el).off('.shiny-material-dropdown');
}
});
Shiny.inputBindings.register(shinyMaterialDropdown);
});
}
$(document).ready(function(){
setTimeout(formatDropdown, 500);
})
$(document).on('click', '#add', function(){
setTimeout(formatDropdown, 100);
})
</script>"),
material_row(
material_column(width = 6,
actionButton("add", label = "add"),
uiOutput("mypanels")
)
)
)
server <- function(input, output, session){
choices = c("a", "b", "c")
init_counter <- reactiveVal(3)
observe({
for(i in seq_len(isolate(init_counter()))){
insertUI(selector = "#mypanels", where = "beforeEnd", ui = make_panels(i, choices[i]))
}
})
observeEvent(input$add, {
panel_index <- init_counter() + input$add
insertUI(selector = "#mypanels", where = "beforeEnd", ui = make_panels(panel_index, choices[panel_index]))
})
}
shinyApp(ui, server)