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)
Related
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)
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)
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()
)
)
)
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)
}
I just want to remove text value (put blank text) of a textInput after clicking on it. I tryed "updateTextInput" or "onclick" from shinyjs without success, any idea ?
if (interactive()) {
ui <- fluidPage(
titlePanel("test textInput clicking"),
sidebarLayout(
sidebarPanel(
textInput("sequenceTextInput", label = "", value = "Enter sequence
here...")
),
mainPanel(
)
))
server = function(input, output) {
}
shinyApp(ui, server)
}
You can get this to work with shinyjs as follows:
library(shinyjs)
ui <- fluidPage(
titlePanel("test textInput clicking"),
sidebarLayout(
sidebarPanel(
useShinyjs(),
textInput("sequenceTextInput", label = "", value = "Enter sequence here...")
),
mainPanel(
)
))
server = function(input, output,session) {
onclick("sequenceTextInput",updateTextInput(session,"sequenceTextInput",value=""))
}
shinyApp(ui, server)
Hope this helps!