I am using Shiny DashboardPlus and I want the sidebar-mini to display only icons. The problem is that text appears also.
Same issue with shiny dashboard also.
The code for creating the sidebar menu below:
sidebar = dashboardSidebar(
sidebarMenu(
menuItem("DASHBOARD1", tabName = "Spectrum", icon = icon("table")
), #menuItem
menuItem("DASHBOARD2", tabName = "LTE", icon = icon("mobile-alt"))
)),
See it here:
I think there might be version issue as it all works fine for me:
library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
shinyApp(
ui = dashboardPagePlus(
header = dashboardHeaderPlus(
enable_rightsidebar = TRUE,
rightSidebarIcon = "gears"
),
sidebar = dashboardSidebar(
sidebarMenu(
menuItem("DASHBOARD1", tabName = "Spectrum", icon = icon("table")
), #menuItem
menuItem("DASHBOARD2", tabName = "LTE", icon = icon("mobile-alt"))
)),
body = dashboardBody(),
title = "TEST"
),
server = function(input, output) { }
)
Here is the sample session Info:
R version 3.5.2 (2018-12-20)
shiny_1.2.0
shinydashboard_0.7.1
shinydashboardPlus_0.6.0.9000
Related
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)
dropdown does not work if added with insertUI in Shiny R.
Please help making it work.
Here is the minimal example code demonstrating the issue:
library(shiny)
library(shinyWidgets)
ui <- fluidPage(
dropdown(textInput("text", label = NULL, value = "text"),
icon = icon("table"), label = "works"),
actionButton("add", "Add content to div2"),
div(id = "div2")
)
server <- function(input, output, session) {
observeEvent(input$add, {
insertUI(selector = "#div2",
where = "beforeEnd",
ui = dropdown(textInput("text", label = NULL, value = "text"),
icon = icon("table"), label = "does not work"))
})
}
shinyApp(ui = ui, server = server)
Solved by updating shinyWidgets to 0.7.3 and shiny to 1.7.2
Apparently, this was related to a known issue with scripts inside insertUI() and was solved by a recent update.
https://github.com/rstudio/shiny/issues/1545
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.
Edit: Generalized question by finding reproducible example
The app below has two tabPanels, each with some Javascript within a sidebarPanel. I expect the Javascript in Tab 1 to run anytime Tab 1 is activated (i.e., when I initially launch the app and when I navigate back to Tab 1 from Tab 2). Also, I expect the Javascript in Tab 2 to run anytime I navigate to that tab.
Instead, the Javascript for both tabs runs immediately upon launching the app and then never again.
As context, I constructed this example because I ran into this problem while trying to use Javascript to place an Amazon Associates ad in my Shiny app.
Reproducible example
library(shiny)
ui = navbarPage( "",
tabPanel( "Tab 1",
mainPanel(
wellPanel("Blah blah blah"),
width = 6
),
sidebarPanel(
# only runs once, like the ads
HTML('<script type="text/javascript"> alert("Tab 1 is talking"); </script>')
# # runs every time
#HTML('<b> test </b>')
, width=6 )
),
tabPanel( "Tab 2",
mainPanel(
wellPanel("Blah blah blah"),
width = 6
), # ends mainPanel
sidebarPanel(
# only runs once, like the ads
HTML('<script type="text/javascript"> alert("Tab 2 is talking"); </script>')
# # runs every time
#HTML('<b> test </b>')
, width=6 )
)
)
server <- function(input, output) {
}
app = shinyApp( ui, server )
Tabs only toggle visibility of content already on the page. So when the app launches, Tab 2 is actually loaded but hidden. If you want tabs to dynamically add and remove scripts, you could use renderUI to do this based on the active tab. Or sendCustomMessage and addCustomMessageHandler.
Here's an example using renderUI:
library(shiny)
ui = navbarPage("", id = "navbar",
tabPanel( "Tab 1",
mainPanel(
wellPanel("Blah blah blah"),
width = 6
),
sidebarPanel(
uiOutput("tab1"),
width = 6
)
),
tabPanel( "Tab 2",
mainPanel(
wellPanel("Blah blah blah"),
width = 6
),
sidebarPanel(
uiOutput("tab2"),
width=6
)
)
)
server <- function(input, output) {
output$tab1 <- renderUI({
req(input$navbar == "Tab 1")
HTML('<script type="text/javascript"> alert("Tab 1 is talking"); </script>')
})
output$tab2 <- renderUI({
req(input$navbar == "Tab 2")
HTML('<script type="text/javascript"> alert("Tab 2 is talking"); </script>')
})
}
shinyApp( ui, server )
I have created a Shiny App using Package 'shinydashboard' as below :
library(shinydashboard)
library(shiny)
sidebar <- dashboardSidebar(
sidebarMenu(id="tabs",
menuItem("ABC", tabName="ABC", icon=icon("line-chart"), selected=TRUE),
menuItem("ABC1", tabName="ABC1", icon=icon("line-chart"), selected=FALSE)
),
conditionalPanel("input.tabs == 'ABC'",
fluidRow(
column(11, offset = 1, h5((' Note')))
)
),
conditionalPanel("input.tabs == 'ABC1'",
fluidRow(
column(11, offset = 1, style = "height:20px; color:rgb(30,144,255);", h1((' Update')))
)
))
body <- dashboardBody(
tabItems(
tabItem(tabName = "ABC",br())
),
tabItems(
tabItem(tabName = "ABC1",br())
)
)
ui = dashboardPage(
dashboardHeader(title = "ABC"),
sidebar,
body
)
server = function(input, output){}
shinyApp(ui = ui, server = server)
However I have noticed a strange behaviour that, when I run the App, initially the comment 'Note' in "input.tabs == 'ABC'" is not visible. However when I click on "input.tabs == 'ABC1'" and then 'ABC', the 'Note' comment becomes visible.
Can somebody points me where I went wrong in above code?
Any help will be highly appreciated.
Thanks,
It seems that we introduced this bug in the newest version of shinydashboard. Sorry! I'll try to fix it soon. You can keep track of the progress here: https://github.com/rstudio/shinydashboard/issues/214.
Update (9 June 2017): This is now fixed on the development version of shinydashboard. Your original code should run just fine if you install shinydashboard from github:
devtools::install_github("rstudio/shinydashboard")
In the meantime, a couple of things:
You don't need to use selected = FALSE.
If the menuItem() that you want to start selected is the first one (like in the example you posted above), also remove selected = TRUE and your problem goes away. This is just a workaround to get your app working now. When this bug is solved, there will be no difference in having selected = TRUE or nothing in the first menuItem().
A more general workaround for now (works no matter which menuItem() you want to start selected) is to use a dynamic sidebar menu:
library(shinydashboard)
library(shiny)
sidebar <- dashboardSidebar(
sidebarMenuOutput("menu"),
conditionalPanel("input.tabs == 'ABC'",
fluidRow(
column(11, offset = 1, h5((' Note')))
)
),
conditionalPanel("input.tabs == 'ABC1'",
fluidRow(
column(11, offset = 1, style = "height:20px; color:rgb(30,144,255);", h1((' Update')))
)
))
body <- dashboardBody(
tabItems(
tabItem(tabName = "ABC",br())
),
tabItems(
tabItem(tabName = "ABC1",br())
)
)
ui = dashboardPage(
dashboardHeader(title = "ABC"),
sidebar,
body
)
server = function(input, output){
output$menu <- renderMenu({
sidebarMenu(id="tabs",
menuItem("ABC", tabName="ABC", icon=icon("line-chart"), selected=TRUE),
menuItem("ABC1", tabName="ABC1", icon=icon("line-chart"))
)
})
}
shinyApp(ui = ui, server = server)