The toy app in the example below contains an R/Shiny actionGroupButtons element. I am looking for guidance please on how to start the actionGroupButtons with button ‘btn_edit’ disabled, which can then become enabled on a click of the button ‘btn_enable’.
Button ‘btn_duplicate’ should remain enabled at all times.
#DeanAttali mentions the use of the ‘disabled’ attribute here (Shiny: how to start application with action button disabled?), though I think that it is one of the inputs that it doesn’t work with.
Any ideas please? TIA
library(shiny)
library(shinyWidgets)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
fluidRow(
actionGroupButtons(
inputIds = c("btn_edit", "btn_duplicate"),
labels = list("Edit", "Duplicate")
)
),
br(),
fluidRow(
actionButton('btn_enable', 'enable edit')
),
br(),
fluidRow(
verbatimTextOutput('btns')
),
br(),
fluidRow(
verbatimTextOutput('btn_enable')
)
)
server <- function(input, output) {
observeEvent((input$btn_edit|input$btn_duplicate),{
output$btns <- renderPrint({paste(input$btn_edit, 'and', input$btn_duplicate)})
})
observeEvent(input$btn_enable,{
output$btn_enable <- renderPrint({input$btn_enable})
if(input$btn_enable > 0) {
shinyjs::enable("btn_edit")
} else {
shinyjs::disable("btn_edit")
}
}, ignoreInit = TRUE)
}
shinyApp(ui = ui, server = server)
You need to set ignoreNULL = FALSE in your observeEvent call, otherwise it will run only after btn_enable was pressed:
library(shiny)
library(shinyWidgets)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
fluidRow(
actionGroupButtons(
inputIds = c("btn_edit", "btn_duplicate"),
labels = list("Edit", "Duplicate")
)
),
br(),
fluidRow(
actionButton('btn_enable', 'enable edit')
),
br(),
fluidRow(
verbatimTextOutput('btns')
),
br(),
fluidRow(
verbatimTextOutput('btn_enable')
)
)
server <- function(input, output, session) {
observeEvent((input$btn_edit|input$btn_duplicate),{
output$btns <- renderPrint({paste(input$btn_edit, 'and', input$btn_duplicate)})
})
observeEvent(input$btn_enable, {
output$btn_enable <- renderPrint({input$btn_enable})
if(input$btn_enable > 0) {
shinyjs::enable("btn_edit")
} else {
shinyjs::disable("btn_edit")
}
}, ignoreInit = FALSE, ignoreNULL = FALSE)
}
shinyApp(ui = ui, server = server)
Another approach would be to disable the button outside of the observer:
library(shiny)
library(shinyWidgets)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
fluidRow(
actionGroupButtons(
inputIds = c("btn_edit", "btn_duplicate"),
labels = list("Edit", "Duplicate")
)
),
br(),
fluidRow(
actionButton('btn_enable', 'enable edit')
),
br(),
fluidRow(
verbatimTextOutput('btns')
),
br(),
fluidRow(
verbatimTextOutput('btn_enable')
)
)
server <- function(input, output, session) {
shinyjs::disable("btn_edit")
observeEvent((input$btn_edit|input$btn_duplicate),{
output$btns <- renderPrint({paste(input$btn_edit, 'and', input$btn_duplicate)})
})
observeEvent(input$btn_enable, {
output$btn_enable <- renderPrint({input$btn_enable})
shinyjs::enable("btn_edit")
})
}
shinyApp(ui = ui, server = server)
Related
Is there a way to collapse the sidebar by default. Right now, it is showing by default once the application is open. Can we make it collapsed by default
library(shiny)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
navbarPage("",
tabPanel("tab",
div( id ="Sidebar",sidebarPanel(
)),
mainPanel(actionButton("toggleSidebar", "Toggle sidebar")
)
)
)
)
server <-function(input, output, session) {
observeEvent(input$toggleSidebar, {
shinyjs::toggle(id = "Sidebar")
})
}
shinyApp(ui, server)
Here is a UI based solution which avoids flashing the sidebarPanel on startup:
library(shiny)
library(shinyjs)
ui <- fluidPage(useShinyjs(),
navbarPage("",
tabPanel(
"tab",
div(id = "sidebarWrapper", sidebarPanel(), style = "display: none;"),
mainPanel(actionButton("toggleSidebar", "Toggle sidebar"))
)))
server <- function(input, output, session) {
observeEvent(input$toggleSidebar, {
shinyjs::toggle(id = "sidebarWrapper")
})
}
shinyApp(ui, server)
PS: the same can be achived by using shinyjs::hidden(div(<...>)).
You can use the ignoreNULL argument at FALSE to trigger at initialization:
observeEvent(input$toggleSidebar, {
shinyjs::toggle(id = "Sidebar")
}, ignoreNULL = FALSE)
With the Github version of shinyGizmo (which should be on CRAN soon) you can toggle the sidebar with amazing effects:
# remotes::install_github("r-world-devs/shinyGizmo")
library(shiny)
library(shinyGizmo)
ui <- fluidPage(
navbarPage(
"",
tabPanel(
"tab",
conditionalJS(
div(
id = "Sidebar",
sidebarPanel(
sliderInput(
"obs", "Number of observations:",
min = 0, max = 1000, value = 500
)
)
),
condition = "input.toggleSidebar % 2 === 1",
jsCalls$animateVisibility("jello", "tada", duration = 1500)
),
mainPanel(
actionButton("toggleSidebar", "Toggle sidebar")
)
)
)
)
server <-function(input, output, session) {
}
shinyApp(ui, server)
When running the code below, you will notice that I have two options below. If you press the Excel option, a fileInput will appear right below the radioButtons. However, I would like to know if it is possible to separate fileInput from radioButtons. I will insert an image to clarify what I want. See that they are separated.
Executable code below:
library(shiny)
library(dplyr)
library(shinyjs)
library(shinythemes)
library(readxl)
ui <- fluidPage(
shiny::navbarPage(theme = shinytheme("flatly"), collapsible = TRUE,
br(),
tabPanel("PAGE1",
sidebarLayout(
sidebarPanel(
radioButtons("button",
label = h3("Data source"),
choices = list("Excel" = "Excel",
"Database" = "database"),
selected = "File"),
uiOutput('fileInput'),
),
mainPanel(
)))))
server <- function(input, output) {
observe({
if(is.null(input$button)) {
}else if (input$button =="Excel"){
output$fileInput <- renderUI({
fileInput("file",h4("Import file"), multiple = T, accept = ".xlsx")
})
} else if(input$button=="database"){
output$fileInput <- NULL
} else {
output$fileInput <- NULL
}
})
}
shinyApp(ui = ui, server = server)
Example:
I left it in red to specify the space
A possible workaround could be to use fluidRow with two columns to simulating a sidebarPanel with a mainPanel.
Notice that I wrapped the inputs in a div(class = "well well-lg") for the background.
App
library(shiny)
library(dplyr)
library(shinyjs)
library(shinythemes)
library(readxl)
ui <- navbarPage(
theme = shinytheme("flatly"), collapsible = TRUE,
br(),
tabPanel(
"PAGE1",
fluidRow(
column(
width = 6,
fluidRow(div(
class = "well well-lg",
radioButtons("button",
label = h3("Data source"),
choices = list(
"Excel" = "Excel",
"Database" = "database"
),
selected = "File"
)
)),
fluidRow(
uiOutput("fileInput")
)
),
column(
width = 6,
tableOutput("iris")
)
)
)
)
server <- function(input, output) {
output$iris <- renderTable({
iris
})
observe({
if (is.null(input$button)) {
} else if (input$button == "Excel") {
output$fileInput <- renderUI({
div(class = "well well-lg", fileInput("file", h4("Import file"), multiple = T, accept = ".xlsx"))
})
} else if (input$button == "database") {
output$fileInput <- NULL
} else {
output$fileInput <- NULL
}
})
}
shinyApp(ui = ui, server = server)
I wish to have a popout modal within a shiny app that depending on the user's action within the modal,
it would show or hide certain fields.
For example, the Modal includes a button that when pressed, another button would apear\disappear.
sadly, although the observeEvent detects a change in the hide\show button, shinyjs::toggle(), shinyjs::hide()
and shinyjs::show() fail to work
example script:
library(shiny)
ui <- fluidPage(
actionButton("show_modal", "show modal"),
)
server <- function(input, output) {
observeEvent(input$show_modal, {
showModal(
modalDialog(footer = NULL,easyClose = T,
tagList(
fluidRow(
box(status = "primary", width = 6, style = "direction: ltr",
actionButton("toggle_btn", "show or hide second button")
)),
fluidRow(
box(status = "success", width = 6, style = "direction: ltr",
actionButton("box_btn", "Box!")
))
)
))
})
observeEvent(input$toggle_btn, {
shinyjs::toggle("box_btn")
cat("\npresentation button pressed\n")
})
}
shinyApp(ui, server)
You can do it without shinyjs by using conditionalPanel():
library(shiny)
ui <- fluidPage(
actionButton("show_modal", "show modal"),
)
server <- function(input, output) {
rv <- reactiveValues(show_btn = FALSE)
observeEvent(input$toggle_btn, {
rv$show_btn <- !rv$show_btn
})
output$show_btn <- reactive({rv$show_btn})
outputOptions(output, "show_btn", suspendWhenHidden = FALSE)
observeEvent(input$show_modal, {
# add_path_to_existing_offers_DB(user = user)
showModal(
modalDialog(
footer = NULL,
easyClose = T,
tagList(
fluidRow(
actionButton("toggle_btn", "show or hide second button")
),
conditionalPanel(
condition = "output.show_btn == true",
fluidRow(
actionButton("box_btn", "Box!")
)
)
)
)
)
})
}
shinyApp(ui, server)
Turns out as Dean Attali the author of shinyjs pointed out kindly,
that I failed to call useShinyjs() function.
library(shiny)
library(shinyjs)
ui <- fluidPage(
**useShinyjs(),**
actionButton("show_modal", "show modal"),
)
server <- function(input, output) {
observeEvent(input$show_modal, {
showModal(
modalDialog(footer = NULL,easyClose = T,
tagList(
fluidRow(
box(status = "primary", width = 6, style = "direction: ltr",
actionButton("toggle_btn", "show or hide second button")
)),
fluidRow(
box(status = "success", width = 6, style = "direction: ltr",
actionButton("box_btn", "Box!")
))
)
))
})
observeEvent(input$toggle_btn, {
shinyjs::toggle("box_btn")
cat("\npresentation button pressed\n")
})
}
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)
I am new in shiny, I wonder how to put the "=" close beside the selectInput box?
library(shiny)
ui = fluidPage(
mainPanel(
titlePanel("Calculation:"),#Voltage calculation
fluidRow(
column(3,
selectInput("selc11", h4("Cable"),#Resistivity
choices = list("Copper" = 0.0174, "Alum" = 0.0282), selected = 1)),
h4("=")
)
)
)
server = function(input, output) {
}
shinyApp(ui = ui, server = server)
If you want something like this:
You can achive it with:
library(shiny)
library(shinyjs)
ui = fluidPage(
useShinyjs(),
mainPanel(
titlePanel("Calculation:"),#Voltage calculation
fluidRow(
column(1, h4('Cable')),
column(3, selectInput(
"selc11",
label = '',
choices = list("Copper" = 0.0174, "Alum" = 0.0282), selected = 1)
),
column(3, h4("="))
)
)
)
server = function(input, output) {
runjs("$('label.control-label').remove()")
}
shinyApp(ui = ui, server = server)