How to minimize a sidebarLayout in a Shiny App? - shiny

I am building a shiny app and I am using two sidebarLayouts. I’m looking for a way to minimize them. I have try put each sidebarLayout into a box.
Example code:
library(shiny)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
headerPanel("Here goes the heder"),
box(sidebarLayout(
sidebarPanel(textOutput("someinputs")),
mainPanel(textOutput("someoutputs"))),
width = 12,
title = "BB",
collapsible = T,
collapsed = F
)
)
server <- function(input, output) {
output$someinputs <- renderText({
"Here will go the inputs"
})
output$someoutputs <- renderText({
"Here will go the outputs"
})
}
shinyApp(ui, server)
Output:
When I press the collapsible button the Layout does not collapse. Why is this happening? What should I do? Is there other way to do this?

Because you didn't use shinydashboard. The box comes from shinydashboard package. You need to use shinydashboard::dashboardPage instead of fluidPage.
dashboardPage Loads required javascripts and CSS files to toggle the button.
library(shiny)
ui <- shinydashboard::dashboardPage(
shinydashboard::dashboardHeader(),
shinydashboard::dashboardSidebar(),
shinydashboard::dashboardBody(
headerPanel("Here goes the heder"),
shinydashboard::box(
width = 12,
title = "BB",
collapsible = TRUE,
collapsed = FALSE,
sidebarLayout(
sidebarPanel(textOutput("someinputs")),
mainPanel(textOutput("someoutputs")))
)
)
)
If you don't want to use dashboardPage, you can write your own scripts to control the button:
library(magrittr)
library(shiny)
ui <- fluidPage(
headerPanel("Here goes the heder"),
shinydashboard::box(
width = 12,
title = "BB",
collapsible = TRUE,
collapsed = FALSE,
sidebarLayout(
sidebarPanel(textOutput("someinputs")),
mainPanel(textOutput("someoutputs")))
)%>% {.$attribs[['id']] <- 'example-box'; .},
tags$head(tags$script(
"$(document).ready(function(){
$('#example-box button').attr({
'data-toggle':'collapse',
'data-target':'#example-box .box-body',
'aria-expanded':false
})
})"
))
)
I used a hack to assign an ID to the box %>% {.$attribs[['id']] <- 'example-box'; .}, and use some jquery to control the button. Be sure the ID in the script matches the ID you assign in UI, example-box in this case. In javascript, you add # for ID searching, so #example-box.
I wouldn't recommend you to use the second way. You can see in your UI, it's not really a box. It has no border and the button is not at the right place. If you use dashboardPage, you can see the difference.

Related

How to listen to checkbox event that has been insert into ui using `insertUI` in Shiny-R

I am trying to build a simple To do list app using Shiny, the application is very simple, there's a textInput where I put things I want to do, and submit it, and it creates a checkbox. What I want to achieve is, if I check the box, there will be a text on the right side that says: "you have done XXX", the XXX is the information of the checkbox.
So far, I have managed to figure out how to insert a checkbox back into the UI however, I have problems in: writing the party of the code that once the checkbox is checked, generate a text which says " you have done XXX"
The two main difficulties is : 1. listen to the inserted UI (each checkbox needs a special id, but I can't write logic in the server components that has indeterministic checkbox id. Also, I can figure out a way to extract the content of the checkbox from the server side, the input$checkbox only gives me true or false value.
This is the code I am working on so far, I am wondering if this functionality is achievable using Shiny-R?
ui <- fluidPage(
theme = bs_theme(version = 4, bootswatch = "sketchy"),
titlePanel("A simple todo App"),
sidebarLayout(
sidebarPanel(
# Date configuration
dateInput("date", label = "Date Configuration"),
# Things to do
h3("Daily Todo", id="start", style = "color:grey", align = "center"),
checkboxInput("checkbox","Submit One Job Application"),
textInput("todo", label = "Other things to do"),
actionButton("todoBnt", label = "Submit"),
br(),
br(),
textInput("learnt", label = "Key things learnt"),
actionButton("learntBnt", label = "Submit")),
mainPanel(
h1(textOutput("timing"), align = "center"),
h1("What have I done",align = "center"),
verbatimTextOutput("value"),
h1("What have I learnt", align = "center"),
h2(textOutput("selected_var"),align = "center"),
p(textOutput("summary"),align="center"))
)
)
server <- function(input, output) {
inserted <- c()
observeEvent(input$todoBnt, {
insertUI(
selector = "#start",
where = "afterEnd",
ui = checkboxInput("chekcbox",input$todo)
)
})
output$timing <- renderText({
paste0("Today is ", as.character(input$date))
})
output$value <- renderText({ input$checkbox }) ##this gives "TRUE" value, I don't think it's right.
output$summary <- renderText({
paste0("I have learnt to ", input$learnt, "!")
})
}
shinyApp(ui = ui, server = server)
I have tried to search answer online, but I think the checkbox in Shiny-R is mainly used to filter graphs etc... So I am not sure if the function I want is actually achievable using the langague. Please help!
Instead of inserting each checkbox separately one option would be to switch to a checkboxGroupInput which you could update in your observeEvent. Doing so makes it easy to get a list of things you have done. However, doing so requires to track the things to do for which I use a reactiveVal choices which gets updated each time a new item is added to the to-do list:
library(shiny)
library(bslib)
ui <- fluidPage(
theme = bs_theme(version = 4, bootswatch = "sketchy"),
titlePanel("A simple todo App"),
sidebarLayout(
sidebarPanel(
# Date configuration
dateInput("date", label = "Date Configuration"),
# Things to do
h3("Daily Todo", id="start", style = "color:grey", align = "center"),
checkboxGroupInput("checkbox", label = "", choices = "Submit One Job Application"),
textInput("todo", label = "Other things to do"),
actionButton("todoBnt", label = "Submit"),
br(),
br(),
textInput("learnt", label = "Key things learnt"),
actionButton("learntBnt", label = "Submit")),
mainPanel(
h1(textOutput("timing"), align = "center"),
h1("What have I done",align = "center"),
verbatimTextOutput("value"),
h1("What have I learnt", align = "center"),
h2(textOutput("selected_var"),align = "center"),
p(textOutput("summary"),align="center"))
)
)
server <- function(input, output) {
choices <- reactiveVal("Submit One Job Application")
inserted <- c()
observeEvent(input$todoBnt, {
selected <- input$checkbox
choices(c(choices(), input$todo))
updateCheckboxGroupInput(inputId = "checkbox", choices = choices(), selected = selected)
updateTextInput(inputId = "todo", value = "")
})
output$timing <- renderText({
paste0("Today is ", as.character(input$date))
})
output$value <- renderText({
paste(input$checkbox, collapse = "\n")
})
output$summary <- renderText({
paste0("I have learnt to ", input$learnt, "!")
})
}
shinyApp(ui = ui, server = server)

Reload a page and switch to tab

I use the package shinyjs to allow the user to reload the page by clicking on "Reload the page" button in Tab 2 and I would like to stay on Tab 2 after reloading the page. But after realoading, the page is taking to Tab1 instead of Tab2
How can we fix it ? This is my code below :
library(shiny)
library(shinyjs)
jscode <- "shinyjs.refresh = function() { history.go(0); }"
ui <- fluidPage(
useShinyjs(),
extendShinyjs(text = jscode, functions = "refresh"),
tabsetPanel(
tabPanel("Tab 1"),
tabPanel("Tab 2", actionButton("mybutton", "Reload the page",
onclick ="javascript:window.location.reload(true)")))
)
server <- function(input, output, session) {
}
shinyApp(ui = ui, server = server)
Some help would be appreciated
You can resort to plain JavaScript. The idea is that you provide an id to tabsetPanel such that you can use updateTabsetPanel in the server.
All you have to do then is to let the reloaded page know that you want to start on the second tab. As a refresh typically resets all of the inputs and reactives (you are aware of that, right?), you cannot use reactives and you have to rely on another way of communication. The query string would be one possibility.
With these ingredients you can:
Write a simple JavaScript function that reloads the page and adds a parameter to the url.
Parse the query string in the server and if the parameter is found, react on it accordingly.
library(shiny)
js <- HTML("
function doReload(tab_index) {
let loc = window.location;
let params = new URLSearchParams(loc.search);
params.set('tab_index', tab_index);
loc.replace(loc.origin + loc.pathname + '?' + params.toString());
}")
ui <- fluidPage(
tags$head(tags$script(js, type ="text/javascript")),
tabsetPanel(
tabPanel("Tab 1", value = "tab1"),
tabPanel("Tab 2", value = "tab2",
actionButton("mybutton", "Reload the page",
onclick = "doReload('tab2')")),
id = "tabsets"
)
)
server <- function(input, output, session) {
observe({
params <- parseQueryString(session$clientData$url_search)
if ("tab_index" %in% names(params)) {
updateTabsetPanel(session, "tabsets", selected = params$tab_index)
}
})
}
shinyApp(ui = ui, server = server)

Q: How to make shiny app output result in a new page?

I am trying to make an app that allow user to input data and then let shiny server to calculate some results, for example, I could make shiny generate a plot or a data table.
However, due to the space of the UI, I kind of "run out of" space. The input box, and documentation of the app take a whole screen. And when the shiny generate the results it will show at the very bottom of the screen.
Is there a way that I can make shiny pop-up a message box to show the result?
My sudo-code would be:
ui <- fluidPage(
textInput("text", "Name"),
numericInput("age", "Age", 20),
actionButton("demo", "Fill in fields with demo"))
server <- function(input, output, session) {
observeEvent(input$demo, {
****************************
OpenNewPage/MoveScreenDown()
****************************
updateTextInput(session, "text", value = H)
updateNumericInput(session, "age", value = "30")
})}
When clicking the "demo", a message box popup or I can make the screen move to the result part and allow the text to be at the top of the screen.
There are options to show your results in a separated window. But maybe will be easier to have everything on the same window.
You can use the shinyBS library to create a modal window to show the plot. Another option is to use JavaScript to move the scroll to the bottom of the page. I put the two options in the following example, so you can see which one is better for you.
library(shiny)
library(shinyBS)
runApp(list(
ui = shinyUI(fluidPage(
textInput("text", "Name"),
numericInput("age", "Age", 20),
# option 1, using ShinyBS with a modal window
actionButton("demo", "Using a modal"),
# modal window to show the plot
bsModal("largeModalID","Results", "demo", size = "large", plotOutput('plot')),
# Option 2, action button with a JavaScript function to move the scroll to the bottom
# after drawing the plot.
actionButton("demoJS", "Using JS",
# there is a delay to allow the renderPlot to draw the plot and you should
# change it according to the processes performed
onclick = "setTimeout( function() {
$('html, body').scrollTop( $(document).height() );},
300)"),
# to plot the results after click on "Using JS"
uiOutput("plotUI")
)
),
server = shinyServer(function(input, output, session) {
output$plot <- renderPlot({
# simple plot to show
plot(sin, -pi, 2*pi)
})
output$plotUI <- renderUI({
# this UI will show a plot only if "Using JS" is clicked
if (input$demoJS > 0)
# the margin-top attribute is just to put the plot lower in the page
div(style = "margin-top:800px", plotOutput('plot2'))
})
output$plot2 <- renderPlot({
# another simple plot,
plot(sin, -pi, 2*pi)
})
})
))
If you think that the JavaScript option works better for you, you could consider start using the shinyjs library, it includes very useful functions and you can easily add your own JavaScript code to your Shiny Apps.

shiny - how to disable the dashboardHeader

I am new to shiny. When I made my project, I need to hide the dashboardHeader in server side.
In the shinydashboard website, I found the code dashboardHeader(disable = TRUE). I tried this, but it was not work.
However, I tried use shinyjs to solve the problem.
<code>
library(shiny)
library(shinydashboard)
library(shinyjs)
ui <- dashboardPage(
dashboardHeader(
extendShinyjs(text = 'shinyjs.hidehead = function(params) {
$("header").addClass("sidebar-collapse") }'),
),
dashboardSidebar(),
dashboardBody(
actionButton("button","hide_header",width = 4 )
)
)
server <- function(input, output) {
observeEvent(input$button, {
js$hidehead()
})}
shinyApp(ui, server)</code>
I guess you already known, it still not worked.
Any ideas for my case?
Shinyjs is a great library. The problem with your code is that you need first to initialize shinyjs with shinyjs::useShinyjs() and put it inside the dashboarBody function. Also, to hide/show the header you don't need to add the class "sidebar-collapse" that is actually for the sidebar. You only need to add style="display:none" to hide the header, and remove it to show the header. Below is your code modified to hide/show the header. The JS code used is very simple and it receive the parameter to add directly from the js$hidehead() function.
library(shiny)
library(shinydashboard)
library(shinyjs)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
# initialize shinyjs
shinyjs::useShinyjs(),
# add custom JS code
extendShinyjs(text = "shinyjs.hidehead = function(parm){
$('header').css('display', parm);
}"),
actionButton("button","hide header"),
actionButton("button2","show header")
)
)
server <- function(input, output) {
observeEvent(input$button, {
js$hidehead('none')
})
observeEvent(input$button2, {
js$hidehead('')
})
}
shinyApp(ui, server)

How to programmatically collapse a box in shiny dashboard

I'm trying to collapse a box programmatically when an input changes. It seems that I only need to add the class "collapsed-box" to the box, I tried to use the shinyjs function addClass, but I don't know how to do that becuase a box doesn't have an id. Here as simple basic code that can be used to test possible solutions:
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
box(collapsible = TRUE,p("Test")),
actionButton("bt1", "Collapse")
)
)
server <- function(input, output) {
observeEvent(input$bt1, {
# collapse the box
})
}
shinyApp(ui, server)
I've never tried using boxes before so keep in mind that my answer might be very narrow minded. But I took a quick look and it looks like simply setting the "collapsed-box" class on the box does not actually make the box collapse. So instead my next thought was to actually click the collapse button programatically.
As you said, there isn't an identifier associated with the box, so my solution was to add an id argument to box. I initially expected that to be the id of the box, but instead it looks like that id is given to an element inside the box. No problem - it just means that in order to select the collapse button, we need to take the id, look up the DOM tree to find the box element, and then look back down the DOM tree to find the button.
I hope everything I said makes sense. Even if it doesn't, this code should still work and will hopefully make things a little more clear :)
library(shiny)
library(shinydashboard)
library(shinyjs)
jscode <- "
shinyjs.collapse = function(boxid) {
$('#' + boxid).closest('.box').find('[data-widget=collapse]').click();
}
"
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
useShinyjs(),
extendShinyjs(text = jscode, functions = "collapse"),
actionButton("bt1", "Collapse box1"),
actionButton("bt2", "Collapse box2"),
br(), br(),
box(id = "box1", collapsible = TRUE, p("Box 1")),
box(id = "box2", collapsible = TRUE, p("Box 2"))
)
)
server <- function(input, output) {
observeEvent(input$bt1, {
js$collapse("box1")
})
observeEvent(input$bt2, {
js$collapse("box2")
})
}
shinyApp(ui, server)