Why is renderUI not working in custom modal? - r

I have a shiny app with a modal that is displayed when I click on a button. I couldn't use shiny::modalDialog() so I adapted this example from W3schools.
Here's what it looks like:
library(shiny)
library(shinyjs)
ui <- fluidPage(
tags$head(
tags$link(rel="stylesheet", href="https://www.w3schools.com/w3css/4/w3.css")
),
useShinyjs(),
actionButton("modal", "open modal"),
div(
id = "my_modal",
class = "w3-modal",
div(
class = "w3-modal-content w3-animate-zoom",
div(
class = "w3-container w3-padding",
actionButton("generate_ui", "generate UI"),
uiOutput("new_ui"),
div(
class="w3-container w3-padding",
tags$button(class="w3-button w3-right w3-white w3-border",
onclick="document.getElementById('my_modal').style.display='none'",
"Close")
)
)
)
),
tags$script(
HTML( '// Get the modal
var modal = document.getElementById("my_modal");
// When the user clicks anywhere outside of the modal, close it
window.onclick = function(event) {
if (event.target == modal) {
modal.style.display = "none";
}
}')
)
)
server <- function(input, output) {
shinyjs::onclick(
"modal",
shinyjs::runjs(
"document.getElementById('my_modal').style.display='block'"
)
)
observeEvent(input$generate_ui, {
print("hello from modal")
output$new_ui <- renderUI({
tagList(
p("This is the new UI")
)
})
})
}
shinyApp(ui = ui, server = server)
In the modal, I have a button that is supposed to render some text. However, when I click on the button, nothing is rendered. This is not a problem with observeEvent() because the statement in print() is correctly displayed in the RStudio console.
Why is renderUI() not working in this situation?
Also asked on RStudio Community

This is because render events are controlled by Javascripts in Shiny. By default, if the dynamic rendering UI is hidden, in your case is the uiOutput element, Shiny would not render it unless it is visible. The term visible here is more than just toggle the css display state to be block. It needs to hear instructions from javascript listeners. In this case, it explicitly listens to a "shown" type of listener. So the way to solve it is in addition to change the display, you also need to trigger the shown event.
Method 1, just use {shinyjs} package, the easiest way
shinyjs::onclick(
"modal",
shinyjs::show("my_modal")
)
Method 2, use jquery, which is what behind {shinyjs}
shinyjs::onclick(
"modal",
shinyjs::runjs("$('#my_modal').show(); $('#new_ui').trigger('shown');")
)
Full code
library(shiny)
library(shinyjs)
ui <- fluidPage(
tags$head(
tags$link(rel="stylesheet", href="https://www.w3schools.com/w3css/4/w3.css")
),
useShinyjs(),
actionButton("modal", "open modal"),
div(
id = "my_modal",
class = "w3-modal",
div(
class = "w3-modal-content w3-animate-zoom",
div(
class = "w3-container w3-padding",
actionButton("generate_ui", "generate UI"),
uiOutput("new_ui"),
div(
class="w3-container w3-padding",
tags$button(class="w3-button w3-right w3-white w3-border",
onclick="document.getElementById('my_modal').style.display='none'",
"Close")
)
)
)
),
tags$script(
HTML( '// Get the modal
var modal = document.getElementById("my_modal");
// When the user clicks anywhere outside of the modal, close it
window.onclick = function(event) {
if (event.target == modal) {
modal.style.display = "none";
}
}')
)
)
server <- function(input, output) {
shinyjs::onclick(
"modal",
# shinyjs::runjs("$('#my_modal').show(); $('#new_ui').trigger('shown');")
shinyjs::show("my_modal")
)
observeEvent(input$generate_ui, {
print("hello from modal")
output$new_ui <- renderUI({
tagList(
p("This is the new UI")
)
})
})
}
shinyApp(ui = ui, server = server)

Related

Remove/hide or update a Bootstrap panel from shinyWidget

In order to make an app where panels are created dynamically, I would like to remove, hide and/or update panels from the package shinyWidgets.
I didn't find any function to do so nor way to add IDs to these panel.
If you have the solution or a way around, I would be more than happy. Thank you in advance !
library(shiny)
library(shinyWidgets)
ui <- fluidPage(
panel(
heading = "Test panel",
actionButton("remove_panel", "Remove this panel")
)
)
server <- function(input, output) {
observeEvent(input$remove_panel,{
print("remove panel")
})
}
shinyApp(ui = ui, server = server)
There is no official method you can use to change the panel states, but we can do it with custom expressions.
library(shiny)
library(shinyWidgets)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
panel(
heading = "Test panel1",
id = "test_panel1",
actionButton("remove_panel", "Remove this panel")
),
panel(
heading = "Test panel2",
id = "test_panel2",
"some content"
),
actionButton("hide_panel", "Hide this panel")
)
server <- function(input, output) {
observeEvent(input$remove_panel,{
removeUI('.panel:has([id="test_panel1"])', immediate = TRUE)
})
observeEvent(input$hide_panel,{
toggle(selector = '.panel:has([id="test_panel2"])')
if(input$hide_panel %% 2 == 1) return(updateActionButton(inputId = "hide_panel", label = "Show this panel"))
updateActionButton(inputId = "hide_panel", label = "Hide this panel")
})
}
shinyApp(ui = ui, server = server)
To remove:
add an ID argument to your panel, and use removeUI to remove it. Remember to change the ID in you own case.
To hide/show:
We can use toggle from shinyjs to show or hide some elements we choose.
Use updateActionButton to also change it text when hidden.

How to selective change modal backdrop in R Shiny

I have two modals. When the first is opened, the background should be grayed out, as is default. But this should not happen with the second one. The code is:
library(shiny)
ui <- fluidPage(
tags$style(type = 'text/css', '.modal-backdrop { display: none }'),
actionButton('modal1', 'Modal1'),
actionButton('modal2', 'Modal2'),
)
server <- function(input, output) {
observeEvent(input$modal1,
showModal(modalDialog(title = "Modal1"))
)
observeEvent(input$modal2,
showModal(modalDialog(title = "Modal2"))
)
}
shinyApp(ui = ui, server = server)
The css code should be connected to the id of the second modal dialog, but it is not possible to include an id in the function 'modalDialog'.
Any ideas about how to apply the css code selectively to only the second modal?
You can add JS code to hide the backdrop after showing the second modal using tags$script just after modalDialog.
library(shiny)
ui <- fluidPage(
actionButton('modal1', 'Modal1'),
actionButton('modal2', 'Modal2'),
)
server <- function(input, output) {
observeEvent(input$modal1,
showModal(modalDialog(title = "Modal1"))
)
observeEvent(input$modal2, {
showModal(
list(
modalDialog(title = "Modal2"),
tags$script("$('.modal-backdrop').css('display', 'none');")
)
)
})
}
shinyApp(ui = ui, server = server)

How can I change the text size in Shiny modals?

I successfully changed the text sizes in shiny dashboard interface by editing css file.
Or I use following structure:
div(DTOutput(outputId = "table"), style = "font-size:85%"))
However, I couldn't find the node name of shiny modals. Is it possible to change the text size in shiny modals through .css?
Are you looking for something like this?
shinyApp(
ui = basicPage(
actionButton("show", "Show modal dialog")
),
server = function(input, output) {
observeEvent(input$show, {
showModal(modalDialog(
title = "Important message",
div("This is an important message!", style="font-size:160%")
))
})
}
)
ModalDialog takes as its first argument(s) UI elements. This appears to be the same kind of arguments accepted by other shiny elements. Compare for example: ?siderbarPanel and ?modalDialog. So if you can do it in the body of an app, you can probably do it in a modal.
For example, I stuck a sidebar layout inside a modal:
shinyApp(
ui = basicPage(
actionButton("show", "Show modal dialog")
),
server = function(input, output) {
observeEvent(input$show, {
showModal(modalDialog(
sidebarLayout(sidebarPanel("yeah"),mainPanel("cool"))
))
})
}
)

Putting a datatable in a shinyjs modal

I am using Shiny with the Shiny Semantic library to make the app look nice. The standard Shiny pop-up message using showModal(modalDialog()) doesn't work with Semantic UI, so I have resorted to shinyjs to use some javascript to allow modals. With a js modal defined globally, how do I integrate a datatable into the modal? Here is a minimal example:
library(shiny)
library(shinyjs)
library(shiny.semantic)
library(DT)
modal.js = "$('.ui.modal')
.modal('show')
;"
server <- function(input, output, session) {
output$my_table = DT::renderDataTable({
head(iris)
})
observeEvent(input$open_modal, {
runjs(modal.js)
})
}
ui <- semanticPage(
suppressDependencies("bootstrap"),
useShinyjs(),
div(class = "ui modal",
div(class="header", 'Modal header'),
p('Placing DT::dataTableOutput("my_table") here fails.
If it was displayed, I would select a row and return the value to a reactiveValue.')
),
div(class = "ui basic button action-button", id = "open_modal", "Open modal ui"),
div(class = "ui raised segment", DT::dataTableOutput("my_table"))
)
shinyApp(ui, server, options = list(launch.browser = TRUE))
I've had the same issue today and managed to find a way to resolve this. When the modal opens in shiny.semantic the datatable output is still classed as not visible. To fix this you just need to add in an extra line to the JavaScript:
$('#my_table').show().trigger('shown');
You'll need to add some more JS if you want to hide it again when closed, but that might be better in the UI using tags$script() instead of in the server.
Updated app:
library(shiny)
library(shinyjs)
library(shiny.semantic)
library(DT)
modal.js <- "$('.ui.modal').modal('show');
$('#my_table').show().trigger('shown');"
server <- function(input, output, session) {
output$my_table = DT::renderDataTable(head(iris))
observeEvent(input$open_modal, runjs(modal.js))
}
ui <- semanticPage(
suppressDependencies("bootstrap"),
useShinyjs(),
div(
class = "ui modal",
div(class = "header", "Modal header"),
div(class = "content", div(class = "ui raised segment", DT::dataTableOutput("my_table")))
),
div(class = "ui basic button action-button", id = "open_modal", "Open modal ui")
)
shinyApp(ui, server, options = list(launch.browser = TRUE))
Put in your dataTableOutput
output$my_table = DT::renderDataTable({
datatable(head(iris), class = "compact", escape = FALSE) })

R Shiny: Present a ShinyBS Modal Popup on page visit (no user action)

I used bsModal successfully in my code before. However, I can't seem to get a modal pop up to show just when the user visits an app's first page by default. I thought something like this would work, but not. Any idea how I can trigger a bsModal on page visit?
library(shiny)
library(shinyBS)
ui <- fluidPage(
mainPanel(
bsModal(id = 'startupModal', title = 'Dum Dum', trigger = '',
size = 'large', p("here is my mumbo jumbo")),
width = 12
)
)
server <- function(input, output, session) {
}
shinyApp(ui = ui, server = server)
I simply need to alert the user with a message when they visit the app and then allow them to close the modal pop up and navigate the rest of the app freely. I am using Shinydashboard. So, eventually, this has to work with that.
You can use toggleModal to manually trigger the popup from the server.
library(shiny)
library(shinyBS)
ui <- fluidPage(
mainPanel(
bsModal(id = 'startupModal', title = 'Dum Dum', trigger = '',
size = 'large', p("here is my mumbo jumbo")),
width = 12
)
)
server <- function(input, output, session) {
toggleModal(session, "startupModal", toggle = "open")
}
shinyApp(ui = ui, server = server)
Here is a solution using JS to trigger bsModal when page load "onload" from ui without waiting for the server. Along with a solution proposed here to prevent end users from accidentally closing the modal by clicking outside the modal or press Esc
library(shiny)
library(shinyBS)
bsModalNoClose <-function(...) {
b = bsModal(...)
b[[2]]$`data-backdrop` = "static"
b[[2]]$`data-keyboard` = "false"
return(b)
}
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
bsModalNoClose("window", "Window",
title="Enter Login Details",size='small',
textInput('username', 'Username'),
passwordInput('pwInp', 'Password'),
actionButton('butLogin', 'Login', class = 'btn action-button btn-success', icon = icon('sign-in')),
footer = h4(actionLink('create_account','Create an account'),align='right'),
tags$head(tags$style("#window .modal-footer{display:none}
.modal-header .close{display:none}"),
tags$script("$(document).ready(function(){
$('#window').modal();
});")
))
)
,mainPanel()
))
server <- function(input, output, session) {}
shinyApp(ui, server)
I hope it may be helpful for future readers.

Resources