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)
`
Related
I'd like to use shinyWidgets::materialSwitch instead of a checkbox in my app for an improved UI.
However, I can't seem to get materialSwitch to work when used with renderUI/uiOutput. The input displays properly but doesn't seem to register a click to "switch".
For the purposes of my app - I need this to be inside a renderUI.
Pkg Versions:
shinyWidgets_0.7.2
shiny_1.7.2
library(shiny)
library(shinyWidgets)
# library(shinyjs)
ui <- fluidPage(
div(class="row",
column(width = 3,
uiOutput("switch")
)
)
)
server <- function(input, output, session) {
output$switch = renderUI({
materialSwitch(
inputId = "switch",
label = "Show Count",
right = TRUE,
status = "primary",
value = FALSE
)
})
}
shinyApp(ui = ui, server = server)
Why is this happening, and how can the problem be fixed?
The issue is that you give same name "switch" to both uiOutput.outputId and materiaSwitch.inputId.
It works OK when they get different ids:
library(shiny)
library(shinyWidgets)
ui <- fluidPage(
div(class="row",
column(width = 3,
uiOutput("switch"),
textOutput("result")
)
)
)
server <- function(input, output, session) {
output$switch = renderUI({
materialSwitch(
inputId = "switchButton",
label = "Show Count",
right = TRUE,
status = "primary",
value = FALSE
)
})
output$result = renderText(input$switchButton)
}
shinyApp(ui = ui, server = server)
Here is how it should work:
library(shiny)
library(shinyWidgets)
# library(shinyjs)
ui <- fluidPage(
div(style = 'position: absolute;left: 50px; top:100px; width:950px;margin:auto',
materialSwitch(inputId = "switch",
label = "Show Count",
right = TRUE,
status = "primary",
value = FALSE)
)
)
server <- function(input, output, session) {
output$value1 <- renderText({ input$switch })
}
shinyApp(ui = ui, server = server)
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)
I have the shiny app below which by default displays a plot. When I click the actionButton() it hides it but then I want to click the same actionButton() again and display it and so forth.
library(shiny)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
actionButton("hideshow_plot",
"HideShow plot")
),
mainPanel(
plotOutput(outputId = "car_plot")
)
)
)
server <- function(input, output) {
showPlot <- reactiveVal(TRUE)
observeEvent(input$hideshow_plot, {
showPlot(FALSE)
})
output$car_plot <- renderPlot({
if (showPlot()){
plot(cars)
}
else{
}
})
}
shinyApp(ui = ui, server = server)
You can do
observeEvent(input$hideshow_plot, {
showPlot(!showPlot())
})
to alternate TRUE/FALSE at each click.
Considered to use shinyjs?
library(shiny)
ui <- fluidPage(
shinyjs::useShinyjs(),
sidebarLayout(
sidebarPanel(
actionButton("hideshow_plot",
"HideShow plot")
),
mainPanel(
plotOutput(outputId = "car_plot")
)
)
)
server <- function(input, output) {
observeEvent(input$hideshow_plot, {
shinyjs::toggle("car_plot")
})
output$car_plot <- renderPlot({
plot(cars)
})
}
shiny::shinyApp(ui, server)
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)
It should be easy to prevent "London" showing up at the top of the page, but I couldn't find how.
library(shiny)
ui <- fluidPage(
mainPanel(
mylist <- c("London","Paris"),
selectInput("s", "Select", mylist)
)
)
server <- function(input, output) {}
shinyApp(ui = ui, server = server)
Take mylist out of fluidPage:
library(shiny)
mylist <- c("London","Paris")
ui <- fluidPage(
mainPanel(
selectInput("s", "Select", mylist)
)
)
server <- function(input, output) {}
shinyApp(ui = ui, server = server)
Otherwise mylist is included in the mainPanel function as another output to include such as a header.
Of course, as an alternative you could just include your option list directly in selectInput and omit the mylist vector completely:
selectInput("s", "Select", choices = c("London","Paris"))
You can use the vector into direct inside selectInput like:
library(shiny)
ui <- fluidPage(
mainPanel(
selectInput("s", "Select", choices = c("London","Paris"))
)
)
server <- function(input, output) {}
shinyApp(ui = ui, server = server)
if you have to use some static validation in your option based on selection you can use something like:
library(shiny)
library(shinyalert)
ui <- fluidPage(
mainPanel(
useShinyalert(),
selectInput("option_select", "Select", choices = c("London"="lon","Paris"="par")),
actionButton("check_city","City Selected")
)
)
server <- function(input, output) {
observeEvent(input$check_city,{
if(input$option_select=="lon")
{
shinyalert("City Selected: London")
}
else
{
shinyalert("City Selected: Paris")
}
})
}
shinyApp(ui = ui, server = server)