Remove/hide or update a Bootstrap panel from shinyWidget - r

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.

Related

Shiny - Clear inside the text when clicked on it

I am trying to make an Shiny app which takes input from user in textInput. I want text inside the textbox to be clear when it is clicked on. I could find solutions only for clicked on button. I need a mouse event for clicking on text box.
Do you have any idea about it?
This can be achieved through the shinyjs onclick function like so:
library(shiny)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
fluidRow(
textInput(inputId = "text_input", label = "Example Text Input", value = "Click me to clear")
)
)
server <- function(input, output) {
shinyjs::onclick(id = "text_input", expr = updateTextInput(inputId = "text_input", value = ""))
}
# Run the application
shinyApp(ui = ui, server = server)

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) })

Insert a new line in shiny's modalDialog

In my shiny app I would like to have a popup window with some text. To make the text more readable I would like to include some linebreaks, but so far I have failed. Any idea how would I do that? I am currently using modalDialog()
ui = basicPage(
actionButton("show", "Show modal dialog")
),
server = function(input, output) {
observeEvent(input$show, {
showModal(modalDialog(
title = "My text",
"This is the first line.
This should be the second."
))
})
}
I have tried: br(), \n and several variations of those. Nothing worked.
Help!!!
You can wrap it in HTML() and then use <br>, similar to your attempt mentioned above. So you could use instead: HTML("This is the first line.<br>
This should be the second.")
For the full app, see below:
ui = basicPage(
actionButton("show", "Show modal dialog")
)
server = function(input, output) {
observeEvent(input$show, {
showModal(modalDialog(
title = "My text",
HTML("This is the first line.<br>
This should be the second.")
))
})
}
shinyApp(ui, server)

Clear the main Panel to display the other reactive output in shiny r studio

I have a dataTableOutput in my main panel. Then I have an action button "Go". Once I click "Go" I want rHandsOutput to appear in the main panel but not beneath dataTableOutput. How can I remove dataTableOutput in the main panel and display rHandsOutput. In my current code both tables appearing together. Once I click "Go", the second table comes under the first table where I want to appear only second table (rHandsOutput) removing 1st table from the main panel.
Please help me!1
You can use a combination of insertUI and removeUI to make UI components dynamic. For example:
library(shiny)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
actionButton(inputId = "go", label = "Go")
),
mainPanel(
fluidRow(
tags$div(id = "firstOutput",
dataTableOutput("myDataTable"))
),
fluidRow(
tags$div(id = "placeholder") # the dynamic UI will be inserted relative to this placeholder
)
))
)
server <- function(input, output) {
output$myDataTable <- renderDataTable(iris)
observeEvent(input$go, {
removeUI("div:has(>#firstOutput)")
insertUI(
selector = "#placeholder",
where = "afterEnd", # inserts UI after the end of the placeholder element
ui = fluidRow(
actionButton(inputId = "newButton", label = "A new button")))
})
}
shinyApp(ui = ui, server = server)
You can use showElement() and hideElement() from shinyjs:
observeEvent(input$go, {
shinyjs::hideElement(“firsttable”)
shinyjs::showElement(“rHandsOutput”)
})
Assuming the ID of the first table is “firsttable” and the ID of the second table is “rHandsOutput”, and the ID of the “Go” button is “go”.
Generate the ui dynamically.
Use uiOutput("someidentifier") in the ui.r and then fill it with your datatable with the following in server.r
output$someidentifier <-
renderUI({
dataTableOutput("datatableidentifier")
})
output$datatableidentifier <- renderDataTable(iris)
uiOutput takes the place (in ui.r) of whatever ui element you want to add dynamically. The necessary code for that ui then moves to renderUI in server.r.

opening a new empty shiny ui through actionbutton

My objective is to create a ShinyApp that opens a new empty UI whenever user clicks on submitButton.
Currently this is my code below. If the user types something in the text box and press Submit. The app shows what the user typed in the main panel. However I dont want to see the text, instead when the user clicks on the submit button , it should open a new empty UI.
ui = shinyUI(fluidPage(
titlePanel("submitButton example"),
fluidRow(
column(3, wellPanel(
textInput("text", "Text:", "text here"),
submitButton("Submit")
)),
verbatimTextOutput("text")
)
)
)
server = function(input, output) {
output$plot1 <- renderPlot({
hist(rnorm(input$n))
})
output$text <- renderText({
paste("Input text is:", input$text)
})
}
shinyApp(ui=ui, server=server)
Is this possible ? Any tips or pointers are appreciated.
Well, this is not yet very functional, but does what you asked for.
ui = shinyUI(fluidPage(
titlePanel("submitButton example"),
fluidRow(
uiOutput("newWindowContent", style = "display: none;"),
tags$script(HTML("
$(document).ready(function() {
if(window.location.hash != '') {
$('div:not(#newWindowContent)').hide();
$('#newWindowContent').show();
$('#newWindowContent').appendTo('body');
}
})
")),
a(href = "#NEW", target = "_blank",
actionButton("Submit", "Submit")
)
))
)
server = function(input, output) {
output$newWindowContent <- renderUI({
"Welcome to your new window!"
})
}
shinyApp(ui=ui, server=server)
The app is created, such that the ui created in newWindowContent is displayed in the new window. Sadly, new windows are somewhat cut off from the parent page, such that there is no easy way to configure each page independently. At the moment, all show the same content. None have reactivity features. I guess there can be initial configurations, if one uses the window's hash. But this works only client sided.
Nevertheless, it's a good start!

Resources