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) })
Related
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.
when I click the selection everytime, the drop download box close automaticlly.
Please how to keep the drop box open ?
Great Thanks
library(shiny)
library(shinyWidgets)
ui <- fluidPage(
dropdownButton(
label="Close after click",
style = "unite",
icon = icon("gear"),
multiInput('test','test',choices = letters)
)
)
server <- function(input, output, session) {}
shinyApp(ui, server)
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)
I am trying to create an interactive UI, which asks for more details as the user interacts with it.
I have added a bsButton, which is supposed to insert more input options to collect more details, but the button is not inserting the UI when it is clicked. Any help or recommendations for the code? Thanks in advance.
ui <- shinyUI( #UI
dashboardPage(
fluidPage(
fluidRow(
introBox(
bsButton("pricing_request", #button to insert UI to collect more details
label = "Pricing Request",
icon = icon("car-battery"),
style = "success")
)))))
#serverpart
server <- function(input, output, session) {
observeEvent(input$pricing_request,{
insertUI(
selector = "#add",
where = "afterEnd",
ui = box( #UI to be inserted
bootstrapPage(
div(style="float:right", actionButton("add_request",
label = "add option",
icon = icon("plus"),
style = "arial")),
div(style="display:inline-block",
textInput(
inputId = "option_1",
label = "Option",
width = '350px',
value = "insert option"))))
)})}
By writing
insertUI(
selector = "#add",
where = "afterEnd",
......
you request to add an UI after the HTML element whose id is add. But there's no such element in your app. If you add div(id = "add") somewhere in your app, that should work.
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"))
))
})
}
)