This question already has an answer here:
Toggle display of sidebar menu in shinydashboard programmatically
(1 answer)
Closed 7 months ago.
Below application has sidebar open by default. Is there a way to make it close by default and slide when the user clicks on "Release" button.
So when the user clicks again on teh button, the side bar should slide inside and this is on and off type. Can we achieve this
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "Basic dashboard"),
dashboardSidebar(),
dashboardBody(
# Boxes need to be put in a row (or column)
fluidRow(
box(plotOutput("plot1", height = 250)),
box(
title = "Controls",
sliderInput("slider", "Number of observations:", 1, 100, 50)
),
box(actionButton("release", "Release"))
)
)
)
server <- function(input, output) {
set.seed(122)
histdata <- rnorm(500)
output$plot1 <- renderPlot({
data <- histdata[seq_len(input$slider)]
hist(data)
})
}
shinyApp(ui, server)
A version using the onclick event:
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "Basic dashboard"),
dashboardSidebar(collapsed = TRUE),
dashboardBody(
# Boxes need to be put in a row (or column)
fluidRow(
box(plotOutput("plot1", height = 250)),
box(
title = "Controls",
sliderInput("slider", "Number of observations:", 1, 100, 50)
),
box(actionButton("release", "Release", onclick = "$('body').toggleClass('sidebar-collapse');"))
)
)
)
server <- function(input, output) {
set.seed(122)
histdata <- rnorm(500)
output$plot1 <- renderPlot({
data <- histdata[seq_len(input$slider)]
hist(data)
})
}
shinyApp(ui, server)
Related
I am trying to hide the conditional panel illustrated below when there is any user input other than the user clicking on the action button "Delete" or making a selection in the selectInput() function rendered in the conditional panel, as shown in the below image. Other user inputs will be added (action buttons, radio buttons, selectInputs, etc.) so it isn't feasible to list each action that causes the conditional panel to hide. That conditional panel should always render upon the click of "Delete". Any suggestions for how to do this? Code is shown at the bottom.
Code:
library(rhandsontable)
library(shiny)
mydata <- data.frame('Col 1' = c(1,24,0,1), check.names = FALSE)
rownames(mydata) <- c('Term A','Term B','Term C','Term D')
ui <- fluidPage(br(),
rHandsontableOutput("mytable"),br(),
fluidRow(
column(1,actionButton("addCol", "Add",width = '70px')),
column(1,actionButton("delCol","Delete",width = '70px')),
column(3,conditionalPanel(condition = "input.delCol",uiOutput("delCol"))) # js here
)
)
server <- function(input, output) {
output$mytable = renderRHandsontable(df())
df <- eventReactive(input$addCol, {
if(input$addCol > 0){
newcol <- data.frame(mydata[,1])
names(newcol) <- paste("Col",ncol(mydata)+1)
mydata <<- cbind(mydata, newcol)
}
rhandsontable(mydata,rowHeaderWidth = 100, useTypes = TRUE)
}, ignoreNULL = FALSE)
observeEvent(input$delCol,
{output$delCol<-renderUI(selectInput("delCol",label=NULL,choices=colnames(mydata),selected="Col 1"))}
)
}
shinyApp(ui,server)
Per Mike´s comment I started with shinyjs and this simple example from the shinyjs reference manual, with minor modification for 2 buttons:
library(shiny)
library(shinyjs)
ui = fluidPage(
useShinyjs(), # Set up shinyjs
actionButton("btn", "Click to show"),
actionButton("btn1","Click to hide"),
hidden(p(id = "element", "I was invisible"))
)
server = function(input, output) {
observeEvent(input$btn, {show("element")})
observeEvent(input$btn1,{hide("element")})
}
shinyApp(ui,server)
Then I expanded it to my code in the OP per the below. Note that this will still require an observeEvent() for each user action that triggers selectInput() to hide instead of a global hide every time there's any user input other than a click of "Delete" action button. I'm not sure this is possible but will continue researching. Multiple observeEvents() won't be too bad of an option in any case.
Resolving code:
library(rhandsontable)
library(shiny)
library(shinyjs)
mydata <- data.frame('Col 1' = c(1,24,0,1), check.names = FALSE)
rownames(mydata) <- c('Term A','Term B','Term C','Term D')
ui <- fluidPage(
useShinyjs(), # set up shinyjs
br(),
rHandsontableOutput("mytable"),br(),
fluidRow(
column(1,actionButton("addCol", "Add",width = '70px')),
column(1,actionButton("delCol","Delete",width = '70px')),
column(3, hidden(uiOutput("delCol2")))) # hide selectInput()
)
server <- function(input,output,session){
output$mytable = renderRHandsontable(dat())
dat <- eventReactive(input$addCol, {
if(input$addCol > 0){
newcol <- data.frame(mydata[,1])
names(newcol) <- paste("Col",ncol(mydata)+1)
mydata <<- cbind(mydata, newcol)
}
rhandsontable(mydata,rowHeaderWidth = 100, useTypes = TRUE)
}, ignoreNULL = FALSE)
observeEvent(input$delCol, show("delCol2")) # clicking Delete button reveals selectInput()
observeEvent(input$addCol, hide("delCol2")) # clicking Add hides selectInput()
output$delCol2 <-renderUI({
selectInput(
"delCol3",
label=NULL,
choices=colnames(mydata),
selected="Col 1"
)
})
}
shinyApp(ui,server)
I have a shinydashboard with 10 boxes, and which can be closed or collapsed. All the box id starts with "box". I was trying set an alert button when all boxes are closed or collapsed.
Below is the code of the dashboard:
library(shiny)
library(shinydashboardPlus)
box_create <- function(i){
shinydashboardPlus::box(tags$p(paste0("Box",i)),
id = paste0("box", i),
closable = TRUE,
collapsible = TRUE)
}
all_box <- purrr::map(1:10, ~box_create(.x))
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
all_box
)
)
server <- function(input, output, session) {
}
shinyApp(ui, server)
I have noticed on pressing close or collapse button shiny sets the display = 'none' for that box.
So is it possible to extract all styles associated with the id which starts with 'box' and check if all the style property sets as 'none' using jQuery?
Using shinydashboardPlus's dev version you can access the box state via it's id (pattern: input$mybox$collapsed).
Please see this related article.
Install it via devtools::install_github("RinteRface/shinydashboardPlus")
library(shiny)
library(tools)
library(shinydashboard)
library(shinydashboardPlus)
box_ids <- paste0("box", 1:10)
box_create <- function(box_id){
shinydashboardPlus::box(tags$p(toTitleCase(box_id)),
id = box_id,
closable = TRUE,
collapsible = TRUE)
}
all_boxes <- lapply(box_ids, box_create)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
all_boxes
)
)
server <- function(input, output, session) {
observe({
if(all(sapply(box_ids, function(box_id){input[[box_id]]$collapsed}))){
showModal(modalDialog("All boxes are collapsed!"))
}
})
# observe({
# print(paste("Is box1 collapsed?", input$box1$collapsed))
# })
}
shinyApp(ui, server)
I thought you wanted a button when all were collapsed OR all were closed. Here is a solution for that.
library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
box_create <- function(i){
shinydashboardPlus::box(tags$p(paste0("Box",i)),
id = paste0("box", i),
closable = TRUE,
collapsible = TRUE)
}
all_box <- purrr::map(1:10, ~box_create(.x))
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
all_box,
div(id = "alert_button")
)
)
server <- function(input, output, session) {
observe({
boxes <- paste0("box", 1:10)
visible_status <- sapply(boxes, \(x) input[[x]]$visible)
collapsed_status <- sapply(boxes, \(x) input[[x]]$collapsed)
if (!any(visible_status) || all(collapsed_status)) {
insertUI(
selector = "#alert_button",
ui = div(id = "added", actionButton("btn","all hidden OR all collapsed"))
)
} else {
removeUI(selector = "#added")
}
})
}
shinyApp(ui, server)
I have a below shiny code, I am trying to disable single radio button choice from grouped radio buttons.
I can disable complete radio button using shinyjs::disable() function. But, having trouble disabling single choice.
library(shiny)
library(shinyjs)
library(shinyWidgets)
if (interactive()) {
ui <- fluidPage(
useShinyjs(),
radioGroupButtons(inputId = "somevalue", choices = c("A", "B", "C")),
verbatimTextOutput("value")
)
server <- function(input, output) {
output$value <- renderText({ input$somevalue })
shinyjs::disable(id="somevalue")
}
shinyApp(ui, server)
}
You can do
runjs("$('input[value=B]').parent().attr('disabled', true);")
or
runjs('$("#somevalue button:eq(1)").attr("disabled", true);')
or
disable(selector = "#somevalue button:eq(1)")
I would like to add a slider in a collapsible sidebar. I am having some issues displaying the content that is associated with the tabName in the body. Ie. When I click the tab, the content in the body does not show.
This is the code and how it looks like when we comment out the slider input.
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "Dynamic Menu"),
dashboardSidebar(
sidebarMenu(
menuItem("hello", tabName = "helloWorld", icon = icon("calendar")#,
#sliderInput("slide", "chose Slide", min = 5, max = 10, value = 10)
)
)
),
dashboardBody(
tabItems(
tabItem(tabName = "helloWorld",
tags$h1("hey")
)
)
)
)
server <- function(input, output, session){
}
shinyApp(ui, server)
If we use the slider input, the body disappears. I have tried using some java script but I can not seem to get the result I am looking for. Keep in my the sidebar should be collapsible if I decide to add in another menuItem.
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "Dynamic Menu"),
dashboardSidebar(
sidebarMenu(
menuItem("hello", tabName = "helloWorld", icon = icon("calendar"),
sliderInput("slide", "chose Slide", min = 5, max = 10, value = 10)
)
)
),
dashboardBody(
tabItems(
tabItem(tabName = "helloWorld",
tags$h1("hey")
)
)
)
)
server <- function(input, output, session){
}
shinyApp(ui, server)
What if you remove tabItems and tabItem entirely of your Body?
Try with this:
dashboardBody(
tags$h1("hey")
)
Or do you want to have multiple bodies depending on which menuItem is selected?
I would like to disable menu items and selectInput, while my Shiny app is loading. I have managed to disable buttons and textInput with some javacript (cf. Disable elements when Shiny is busy), but I can't get it to work with selectInput and menus. I'm not interested in alternatives solutions.
library(shiny)
js <- "$(document).on('shiny:busy', function() {
var $inputs = $('button,input,select,ul');
console.log($inputs);
$inputs.prop('disabled', true);
});
$(document).on('shiny:idle', function() {
var $inputs = $('button,input,select,ul');
console.log($inputs);
$inputs.prop('disabled', false);
});"
ui <- fluidPage(
titlePanel("Hello Shiny!"),
sidebarLayout(
sidebarPanel(
tags$head(tags$script(js)),
navlistPanel(
tabPanel("Component 1"),
tabPanel("Component 2")
)
),
mainPanel(
actionButton("buttonID","This adds 10 seconds of Sys.sleep"),
textInput("textID","Write text here..."),
selectInput("selectID","This should be disables while loading",choices=c("A","B","C"))
)
)
)
server <- function(input, output) {
observeEvent(input$buttonID,{
Sys.sleep(10)
})
}
shinyApp(ui, server)
Theres easier way of disabling widgets using shinyjs package. theres a reactiveValuesToList function which will collect all the reactivesinputs you have within the session and you can simply use that:
library(shiny)
library(shinyjs)
ui <- fluidPage(
titlePanel("Hello Shiny!"),
useShinyjs(),
sidebarLayout(
sidebarPanel(
navlistPanel(
tabPanel("Component 1"),
tabPanel("Component 2")
)
),
mainPanel(
actionButton("buttonID","This adds 5 seconds of Sys.sleep"),
textInput("textID","Write text here..."),
selectInput("selectID","This should be disables while loading",choices=c("A","B","C"))
)
)
)
server <- function(input, output) {
observeEvent(input$buttonID,{
myinputs <- names(reactiveValuesToList(input))
print(myinputs)
for(i in 1:length(myinputs)){
disable(myinputs[i])
}
Sys.sleep(5)
for(i in 1:length(myinputs)){
enable(myinputs[i])
}
})
}
shinyApp(ui, server)
ANSWER A)
The simple answer to your question is to set selectize = FALSE in your selectInput.
In the shiny docs, it's stated that the selectInput function uses the selectize.js JavaScript library by default (see below).
"By default, selectInput() and selectizeInput() use the
JavaScript library selectize.js
(https://github.com/brianreavis/selectize.js) to instead of the basic
select input element. To use the standard HTML select input element,
use selectInput() with selectize=FALSE."
By setting selectize = FALSE you are instead using the standard HTML select input element. This, in turn, is now picked up by your jquery var $inputs = $('button,input,select,ul');. I'm not sure why the element is not picked up when using the selectize.js library.
See the below example. Note that the selectInput options look different when using the html standard (not as nice aesthetically imo).
# ANSWER A)
library(shiny)
js <- "$(document).on('shiny:busy', function() {
var $inputs = $('button,input,select,ul');
console.log($inputs);
$inputs.prop('disabled', true);
});
$(document).on('shiny:idle', function() {
var $inputs = $('button,input,select,ul');
console.log($inputs);
$inputs.prop('disabled', false);
});"
ui <- fluidPage(
titlePanel("Hello Shiny!"),
sidebarLayout(
sidebarPanel(
tags$head(tags$script(js)),
navlistPanel(
tabPanel("Component 1"),
tabPanel("Component 2")
)
),
mainPanel(
actionButton("buttonID", "This adds 3 seconds of Sys.sleep"),
textInput("textID", "Write text here..."),
selectInput("selectID", "This should be disables while loading", choices=c("A","B","C"), selectize = FALSE)
)
)
)
server <- function(input, output) {
observeEvent(input$buttonID,{
Sys.sleep(3)
})
}
shinyApp(ui, server)
ANSWER B)
Below is how I got the selectize.js selectInput to disable when shiny is busy, as per your question, using the conditionalPanel. It's a bit of a hacky solution, but works well.
Note that I am creating two selectInputs which are similar. One is initialised as disabled using the shinyjs package. This is the one that is displayed when shiny is busy. Using jquery snippet $('html').hasClass('shiny-busy') we make use of the shiny-busy class applied when shiny is busy performing logic on the server side. When this class is removed (i.e. when shiny is idle) the conditionalPanel swaps in the other selectInput UI element that is not disabled.
# EXAMPLE B)
library(shiny)
library(shinyjs)
js <- "$(document).on('shiny:busy', function() {
var $inputs = $('button,input,select,ul');
console.log($inputs);
$inputs.prop('disabled', true);
});
$(document).on('shiny:idle', function() {
var $inputs = $('button,input,select,ul');
console.log($inputs);
$inputs.prop('disabled', false);
});"
ui <- fluidPage(
titlePanel("Hello Shiny!"),
sidebarLayout(
sidebarPanel(
tags$head(tags$script(js)),
navlistPanel(
tabPanel("Component 1"),
tabPanel("Component 2")
)
),
mainPanel(
useShinyjs(),
actionButton("buttonID", "This adds 3 seconds of Sys.sleep"),
textInput("textID", "Write text here..."),
#selectInput("selectID", "This should be disables while loading", choices=c("A","B","C"), selectize = FALSE)
div(
conditionalPanel(
condition="$('html').hasClass('shiny-busy')",
shinyjs::disabled(
selectInput(
inputId = 'selectID_disabled', # note the addition of "_disabled" as IDs need to be unique
label = "This should be disables while loading",
choices = "Loading...",
selected = NULL,
selectize = TRUE,
width = 250,
size = NULL
)
)
),
conditionalPanel(
condition="$('html').hasClass('')",
selectInput(
inputId = 'selectID',
label = "This should be disables while loading",
choices = c("A","B","C"),
selected = NULL,
selectize = TRUE,
width = 250,
size = NULL
)
),
style = "margin-top:20px;"
),
)
)
)
shinyServer(function(input, output, session) {
observeEvent(input$buttonID,{
Sys.sleep(3)
})
})
shinyApp(ui, server)