In this code
if (interactive()) {
# Define UI
ui <- fluidPage(
actionButton("add", "Add UI"),
actionButton("remove", "Remove UI"),
tags$div(id = "add")
)
# Server logic
server <- function(input, output, session) {
# adding UI
observeEvent(input$add, {
insertUI(
selector = "#add",
where = "afterEnd",
ui =
div(
textInput("txt", "Insert some text"),
id="textinput"
)
)
})
# removing UI
observeEvent(input$remove, {
removeUI(selector = "#textinput")
})
}
shinyApp(ui, server)
}
I want dynamic UI to appear only once. Regardless of the number of button "add" presses.
However, after you click "Remove UI" button, you should be able to add the dynamic interface again (also once)
You could do this using conditionalPanel and observe.
library(shiny)
if (interactive()) {
# Define UI
ui <- fluidPage(
actionButton("add", "Add UI"),
actionButton("remove", "Remove UI"),
conditionalPanel(condition = "input.add > 0",
uiOutput("textbox"))
)
# Server logic
server <- function(input, output, session) {
# adding UI
observe({
if (!is.null(input$add)) {
output$textbox <- renderUI({
div(
textInput("txt", "Insert some text"),
id="textinput"
)
})
}
})
# removing UI
observeEvent(input$remove, {
removeUI(selector = "#textinput")
})
}
shinyApp(ui, server)
}
EDIT - without conditionalPanel.
library(shiny)
if (interactive()) {
# Define UI
ui <- fluidPage(
actionButton("add", "Add UI"),
actionButton("remove", "Remove UI"),
uiOutput("textbox"))
# Server logic
server <- function(input, output, session) {
# adding UI
observeEvent(input$add,
output$textbox <- renderUI({
div(
textInput("txt", "Insert some text"),
id="textinput"
)
})
)
# removing UI
observeEvent(input$remove, {
removeUI(selector = "#textinput")
})
}
shinyApp(ui, server)
}
Related
I am trying to alternate the presence of a TinyMCE editor in R Shiny.
I can load the editor, then remove it with the respective actionButtons. However, upon attempting to load it more than once, only a textAreaInput-type interface is rendered:
library(shiny)
library(ShinyEditor)
ui <- fluidPage(
use_editor("API-KEY"),
uiOutput("tiny"),
actionButton("load", "Load TinyMCE"),
actionButton( "remove", "Remove TinyMCE" ))
server <- function(input, output, session) {
observeEvent(input$load, {
output$tiny = renderUI( editor('textcontent'))})
observeEvent(input$remove, {
output$tiny = renderUI( NULL)})
}
shinyApp(ui = ui, server = server)
How would it be possible to reload it? Thank you.
I would try that:
library(shiny)
library(ShinyEditor)
ui <- fluidPage(
use_editor("API-KEY"),
uiOutput("tiny"),
actionButton("btn", "Load/Remove TinyMCE"),
)
server <- function(input, output, session) {
output$tiny <- renderUI({
if(input$btn %% 2 == 0) {
editor('textcontent')
} else {
NULL
}
})
}
shinyApp(ui = ui, server = server)
And if that doesn't work I would hide it instead of removing it:
library(shiny)
library(ShinyEditor)
ui <- fluidPage(
use_editor("API-KEY"),
conditionalPanel(
condition = "input.btn %% 2 == 0",
uiOutput("tiny")
),
actionButton("btn", "Load/Remove TinyMCE"),
)
server <- function(input, output, session) {
output$tiny <- renderUI({
editor('textcontent')
})
}
shinyApp(ui = ui, server = server)
The following is based on #Stéphane Laurent's advice.
library(shiny)
library(ShinyEditor)
library(shinyjs)
ui <- fluidPage(
use_editor("API-KEY"),
useShinyjs(),
uiOutput("tiny"),
actionButton( "toggle", "Toggle TinyMCE" ))
server <- function(input, output, session) {
output$tiny = renderUI( editor('textcontent'))
observe({if(input$toggle %% 2 == 0) {
hide('tiny')
} else {
show('tiny')
}
})
}
shinyApp(ui = ui, server = server)
What I am trying to do is to use an if statement to prevent 'Analyse' button to perform an action twice, I want to disable the button when the button is clicked on one selection once already.
I have simplified the code to isolate the if statement area. Anyone know what's going on here? Thanks
library(shiny)
library(shinyjs)
ui <- fluidPage(
navbarPage(title = "Test",
tabPanel("Home",
sidebarPanel(
actionButton("append", "Analyse")
),
mainPanel()
)
)
)
server <- function(input, output, session) {
observeEvent(input$append,{
disbut<-1
if(disbut==1)
{
disable("append")
}
else {
enable("append")
}
})
}
shinyApp(ui, server)
You have to call useShinyjs() in the ui as shown below.
library(shiny)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
navbarPage(title = "Test",
tabPanel("Home",
sidebarPanel(
actionButton("append", "Analyse")
),
mainPanel()
)
)
)
server <- function(input, output, session) {
observeEvent(input$append,{
disbut<-1
if(disbut==1)
{
shinyjs::disable("append")
}
else {
shinyjs::enable("append")
}
})
}
shinyApp(ui, server)
You have to initialise shinyjs with useShinyjs()
ui <- fluidPage(
useShinyjs(),
navbarPage(title = "Test",
tabPanel("Home",
sidebarPanel(
actionButton("append", "Analyse")
),
mainPanel()
)
)
)
I have created the following application template in R shiny :
library(shiny)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
navbarPage("",actionButton("toggleSidebar", "toggle", icon =
icon("database")),
tabPanel("tab",
div( id ="Sidebar",sidebarPanel(
)),mainPanel() ))))
server <-function(input, output, session) {
observeEvent(input$toggleSidebar, {
shinyjs::toggle(id = "Sidebar")
}) }
shinyApp(ui, server)
The App will create a toggle button in the sidebar. The button should appear in the navbar and not above the sidebar. The actual toggle button appears above next to the word tab. It is however, not visible.
The part that is not visible that you mention is in fact the empty title parameter that you have "". Leaving this out as below places the toggle button in the title position:
library(shiny)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
navbarPage(actionButton("toggleSidebar", "toggle", icon =
icon("database")),
tabPanel("tab",
div( id ="Sidebar",sidebarPanel(
)),mainPanel() )))
server <-function(input, output, session) {
observeEvent(input$toggleSidebar, {
shinyjs::toggle(id = "Sidebar")
}) }
shinyApp(ui, server)
I made an example with multiple tabPanels.
library(shiny)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
navbarPage(title = tagList("title",actionLink("sidebar_button","",icon = icon("bars"))),
id = "navbarID",
tabPanel("tab1",
div(class="sidebar"
,sidebarPanel("sidebar1")
),
mainPanel(
"MainPanel1"
)
),
tabPanel("tab2",
div(class="sidebar"
,sidebarPanel("sidebar2")
),
mainPanel(
"MainPanel2"
)
)
)
)
server <-function(input, output, session) {
observeEvent(input$sidebar_button,{
shinyjs::toggle(selector = ".sidebar")
})
}
shinyApp(ui, server)
=======================================
I have created a simpler example that does not use the sidepanel class, but I am not sure if it will work in all environments.
library(shiny)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
navbarPage(title = tagList("title",actionLink("sidebar_button","",icon = icon("bars"))),
tabPanel("tab1",
sidebarPanel("sidebar1"),
mainPanel("MainPanel1")
),
tabPanel("tab2",
sidebarPanel("sidebar2"),
mainPanel("MainPanel2")
)
)
)
server <-function(input, output, session) {
observeEvent(input$sidebar_button,{
shinyjs::toggle(selector = ".tab-pane.active div:has(> [role='complementary'])")
})
}
shinyApp(ui, server)
Having issues calling updateTabsetPanel within a Shiny module, works fine without.
library(shiny)
mod_ui <- function(id){
ns <- NS(id)
tagList(
actionButton(ns("back"), "back")
)
}
mod <- function(input, output, session){
observeEvent(input$back, {
print("Button click, go back to home tab")
updateTabsetPanel(session = session, inputId = "tabs", selected = "home")
})
}
ui <- navbarPage(
"example",
id = "tabs",
tabPanel(
"home",
h4("updateTabsetPanel does not work with modules"),
h5("But the button below does"),
actionButton("switch", "switch")
),
tabPanel(
"secondtab",
mod_ui("second")
)
)
server <- function(input, output, session){
callModule(mod, "second")
observeEvent(input$switch, {
updateTabsetPanel(session = session, inputId = "tabs", selected = "secondtab")
})
}
shinyApp(ui, server)
Modules are designed in such a way that each module is absolutely self contained. If you need to communicate with the parent which called the module, parameters need to be passed explicitly. Here is how it is done:
library(shiny)
mod_ui <- function(id){
ns <- NS(id)
tagList(
actionButton(ns("back"), "back")
)
}
mod <- function(input, output, session,parent_session){
observeEvent(input$back, {
print("Button click, go back to home tab")
updateTabsetPanel(session = parent_session, inputId = "tabs", selected = "home")
})
}
ui <- navbarPage(
"example",
id = "tabs",
tabPanel(
"home",
h4("updateTabsetPanel does not work with modules"),
h5("But the button below does"),
actionButton("switch", "switch")
),
tabPanel(
"secondtab",
mod_ui("second")
)
)
server <- function(input, output, session){
callModule(mod, "second",parent_session = session)
observeEvent(input$switch, {
updateTabsetPanel(session = session, inputId = "tabs", selected = "secondtab")
})
}
shinyApp(ui, server)
The parent session is explicitly passed to the module.
Is there a way to close the context menu of a dropdownButton in a shiny app after clicking on a button? I was looking for an attribute like closed/opened in the dropdownButton-documentation and couldn't find anything but I believe there must be a way to do this.
This is an example app:
library(shiny)
library(shinyWidgets)
ui <- fluidPage(
dropdownButton(
actionButton("button", "Press this Button to close the dropdownButton!"),
circle = TRUE, status = "primary", icon = icon("user-circle")
)
)
server <- function(input, output) {
observeEvent(
input$button, {
# Set dropdownButton closed
print("Test")
}
)
}
shinyApp(ui = ui, server = server)
Do you mean something like this?
library(shiny)
library(shinyWidgets)
ui <- fluidPage(
uiOutput('help')
)
server <- function(input, output) {
observeEvent(
input$button, {
shinyjs::hide("button")
#output$help <- renderUI({} )
}
)
output$help <- renderUI(dropdownButton(
actionButton("button", "Press this Button to close the dropdownButton!"),
circle = TRUE, status = "primary", icon = icon("user-circle")
) )
}
shinyApp(ui = ui, server = server)
library(shiny)
library(shinyWidgets)
ui <- fluidPage(
uiOutput('help')
)
server <- function(input, output) {
observeEvent(
input$button, {
shinyjs::hideElement("dropdown-menu")
}
)
output$help <- renderUI(dropdownButton(
actionButton("button", "Press this Button to close the dropdownButton!"),
circle = TRUE, status = "primary", icon = icon("user-circle")
) )
}
shinyApp(ui = ui, server = server)
By dropping "sw-show" class from your dropdown menu, its context will be disappeared.
Use shinyjs::removeClass to do it.
Don't forget to add sw-content- prefix to the menu's ID.
`
library(shiny)
library(shinyjs)
library(shinyWidgets)
ui <- fluidPage(
useShinyjs(),
uiOutput('drop_down_output')
)
server <- function(input, output) {
output$drop_down_output <- renderUI({
dropdown(
inputId = 'drop_down_1',
actionButton("button", "Run!")
)
})
observeEvent(input$button,{
shinyjs::removeClass(id = 'sw-content-drop_down_1', class = 'sw-show')
})
}
shinyApp(ui = ui, server = server)
`