I'm trying to do a presentation of my shiny app with the package rintrojs. This works well when I use it on actionButton or things like that but I would like to use it on the names of tabPanels.
I don't want to present something display in the panels, I want to have an intro box on the name of the panels. However, when doing this, the tabPanels do not display anymore. How should I do it?
Here's a reproducible example:
library(shiny)
library(rintrojs)
ui <- navbarPage(
title = "foo",
introjsUI(),
tabPanel(
introBox(title = "Panel 1",
data.step = 1,
data.intro = "This is Panel 1"),
fluidRow(actionButton("button1", "Button 1"))
),
tabPanel(
introBox(title = "Panel 2",
data.step = 2,
data.intro = "This is Panel 2"),
fluidRow(actionButton("button2", "Button 2"))
)
# If you want to see a "normal" app, comment from "introjsUI()" to here, and uncomment the chunk below
# tabPanel(title = "Panel 1",
# fluidRow(actionButton("button1", "Button 1"))
# ),
# tabPanel(title = "Panel 2",
# fluidRow(actionButton("button2", "Button 2"))
# )
)
server <- shinyServer(function(input, output, session) {
introjs(session)
})
shinyApp(ui, server)
Here's the answer provided here:
library(shiny)
library(rintrojs)
ui <- navbarPage(
title = "foo",
introjsUI(),
tabPanel(
title = introBox("Panel 1",
data.step = 1,
data.intro = "This is Panel 1"),
fluidRow(actionButton("button1", "Button 1"))
),
tabPanel(
title = introBox("Panel 2",
data.step = 2,
data.intro = "This is Panel 2"),
fluidRow(actionButton("button2", "Button 2"))
)
# If you want to see a "normal" app, comment from "introjsUI()" to here, and uncomment the chunk below
# tabPanel(title = "Panel 1",
# fluidRow(actionButton("button1", "Button 1"))
# ),
# tabPanel(title = "Panel 2",
# fluidRow(actionButton("button2", "Button 2"))
# )
)
server <- shinyServer(function(input, output, session) {
introjs(session)
})
shinyApp(ui, server)
Related
I would like to start my app with the first tabset panel displayed.
To do this I need to click on TabSet 1 button. How can I let this TabSet displayed without need to click on the TabSet 1 button ?
And also, to do the changing on tabSet Panels I use observeEventfor times. Is this the best practice to do this?
How can I improve the observeEventcode part?
library(shiny)
library(shinyWidgets)
ui <- fluidPage(
actionButton("btn_1", "tabSet 1"),
actionButton("btn_2", "tabSet 2"),
actionButton("btn_3", "tabSet 3"),
actionButton("btn_4", "tabSet 4"),
uiOutput("tabset")
)
server <- function(input, output, session) {
observeEvent(input$btn_1,{
output$tabset <- renderUI({
tabsetPanel(
tabPanel(
h6("TabPanel 1")
),
tabPanel(
h6("TabPanel 2")
),
tabPanel(
h6("TabPanel 3")
),
tabPanel(
h6("TabPanel 4")
)
)
})
})
observeEvent(input$btn_2,{
output$tabset <- renderUI({
tabsetPanel(
tabPanel(
h6("TabPanel 1")
)
)
})
})
observeEvent(input$btn_3,{
output$tabset <- renderUI({
tabsetPanel(
tabPanel(
h6("TabPanel 3")
),
tabPanel(
h6("TabPanel 3")
),
tabPanel(
h6("TabPanel 3")
),
tabPanel(
h6("TabPanel 3")
),
tabPanel(
h6("TabPanel 3")
)
)
})
})
observeEvent(input$btn_4,{
output$tabset <- renderUI({
tabsetPanel(
tabPanel(
h1("LASt Button Title Panel")
)
)
})
})
}
shinyApp(ui, server)
I'd recommend to avoid renderUI when ever you can, as it is slow to re-render all those elements on a button click compared to switching their visibility on and off.
Please read chapter 10 from Mastering Shiny:
That’s because it’s reactive: the app must load, trigger a reactive
event, which calls the server function, yielding HTML to insert into
the page. This is one of the downsides of renderUI(); relying on it
too much can create a laggy UI.
You could use radioButtons and conditionalPanels or simply a nested tabsetPanel to keep the work in the UI part of the app (client side):
library(shiny)
ui <- fluidPage(
tabsetPanel(
tabPanel(
"tabSet 1",
tabsetPanel(tabPanel(h6("TabPanel 1")),
tabPanel(h6("TabPanel 2")),
tabPanel(h6("TabPanel 3")),
tabPanel(h6("TabPanel 4"))
)
),
tabPanel("tabSet 2",
tabsetPanel(tabPanel(h6(
"TabPanel 1"
)))
),
tabPanel(
"tabSet 3",
tabsetPanel(
tabPanel(h6("TabPanel 3")),
tabPanel(h6("TabPanel 3")),
tabPanel(h6("TabPanel 3")),
tabPanel(h6("TabPanel 3")),
tabPanel(h6("TabPanel 3"))
)
),
tabPanel("tabSet 4",
tabsetPanel(tabPanel(
h1("LASt Button Title Panel")
))
)
)
)
server <- function(input, output, session) {}
shinyApp(ui, server)
I want to hide a tabsetPanel in a ShinyApp. Following this answer in a Shiny issue I can do that just fine like this:
library(shiny)
ui <- fluidPage(
tags$style("#inTabset { display:none; }"), #This works
sidebarLayout(
sidebarPanel(
sliderInput("controller", "Controller", 1, 3, 1)
),
mainPanel(
tabsetPanel(id = "inTabset",
tabPanel(title = "Panel 1", value = "panel1", "Panel 1 content"),
tabPanel(title = "Panel 2", value = "panel2", "Panel 2 content"),
tabPanel(title = "Panel 3", value = "panel3", "Panel 3 content")
)
)
)
)
server <- function(input, output, session) {
observeEvent(input$controller, {
updateTabsetPanel(session, "inTabset", selected = paste0("panel", input$controller))
})
}
shinyApp(ui, server)
However, I'm using bslib for theming. This library seems to modify the css selectors involved and I can't seem to figure out how to modify the tabsetPanel selector to hide it:
library(shiny)
library(bslib)
ui <- fluidPage(
theme = bs_theme(primary = "#EA80FC"),
tags$style("#inTabset { display:none; }"), #This no longer works,
sidebarLayout(
sidebarPanel(
sliderInput("controller", "Controller", 1, 3, 1)
),
mainPanel(
tabsetPanel(id = "inTabset",
tabPanel(title = "Panel 1", value = "panel1", "Panel 1 content"),
tabPanel(title = "Panel 2", value = "panel2", "Panel 2 content"),
tabPanel(title = "Panel 3", value = "panel3", "Panel 3 content")
)
)
)
)
server <- function(input, output, session) {
observeEvent(input$controller, {
updateTabsetPanel(session, "inTabset", selected = paste0("panel", input$controller))
})
}
shinyApp(ui, server)
I tried inspecting and playing with the elements shown in chrome's dev console to no avail. So, how do I reference this element when using bslib?
Not sure what's the reason you want to hide the tabs via CSS when you could achieve the same result via type="hidden" which also seems to work fine with bslib:
library(shiny)
library(bslib)
ui <- fluidPage(
theme = bs_theme(primary = "#EA80FC"),
sidebarLayout(
sidebarPanel(
sliderInput("controller", "Controller", 1, 3, 1)
),
mainPanel(
tabsetPanel(id = "inTabset",
type = "hidden",
tabPanel(title = "Panel 1", value = "panel1", "Panel 1 content"),
tabPanel(title = "Panel 2", value = "panel2", "Panel 2 content"),
tabPanel(title = "Panel 3", value = "panel3", "Panel 3 content")
)
)
)
)
server <- function(input, output, session) {
observeEvent(input$controller, {
updateTabsetPanel(session, "inTabset", selected = paste0("panel", input$controller))
})
}
shinyApp(ui, server)
#>
#> Listening on http://127.0.0.1:3626
I want to display inputs (checkboxes, select input) in the sidebar of my shiny dashboard, but only when a certain tab is clicked.
Minimum reporducible example below. How can I get the checkboxes and select input to only show up when on Page 2?
#ui.R
library(shiny)
library(shinydashboard)
# Define UI for application that draws a histogram
shinyUI(dashboardPage(
dashboardHeader(title = "Test Application",
titleWidth = "400px"
),
dashboardSidebar(
id = "navbar",
menuItem("Page 1", tabName = "page1"),
menuItem("Page 2", tabName = "page2"),
# THESE SHOW UP ALL THE TIME - HOW TO GET JUST ON PAGE 2?
checkboxGroupInput("outcome", "Select Outcome Variable(s):", choices = c("Box 1", "Box 2", "Box 3")),
selectInput("selectinput", label = "Select:", choices = c("Choice 1", "Choice 2", "Choice 2"))
),
dashboardBody(
tabItems(
tabItem(
tabName = "page1",
h1("This is page 1")
),
tabItem(
tabName = "page2",
h1("This is page 2")
)
)
)
))
I assume something is needed in here to make the inputs dynamic?
# server.R
library(shiny)
# Define server logic required to draw a histogram
shinyServer(function(input, output) {
})
ANSWER: use a conditional panel that queries the selected tab.
Credit: Mine at Rstudio
library(shiny)
library(shinydashboard)
# ui ---------------------------------------------------------------------------
ui <- dashboardPage(
# title ----
dashboardHeader(title = "Test Application"),
# sidebar ----
dashboardSidebar(
sidebarMenu(id = "sidebarid",
menuItem("Page 1", tabName = "page1"),
menuItem("Page 2", tabName = "page2"),
conditionalPanel(
'input.sidebarid == "page2"',
sliderInput("bins", "Number of bins:", min = 1, max = 50, value = 30),
selectInput("title", "Select plot title:", choices = c("Hist of x", "Histogram of x"))
)
)
),
# body ----
dashboardBody(
tabItems(
# page 1 ----
tabItem(tabName = "page1", "Page 1 content. This page doesn't have any sidebar menu items."),
# page 2 ----
tabItem(tabName = "page2",
"Page 2 content. This page has sidebar meny items that are used in the plot below.",
br(), br(),
plotOutput("distPlot"))
)
)
)
# server -----------------------------------------------------------------------
server <- function(input, output, session) {
output$distPlot <- renderPlot({
x <- faithful[, 2]
bins <- seq(min(x), max(x), length.out = input$bins + 1)
hist(x, breaks = bins, col = "darkgray", border = "white", main = input$title)
})
}
# shiny app --------------------------------------------------------------------
shinyApp(ui, server)
If I understood your question correctly, all you need to do is the following:
When defining the dashboardSidebar if you just want it as a navigational panel add sidebarmenu() and then add your menu items.
Then to have the checkboxes and select input appear only for the main dashboard on page 2 add it under dashboardbody() with the tabItem = "page2". See below:
#ui.R
library(shiny)
library(shinydashboard)
# Define UI for application that draws a histogram
ui<- dashboardPage(
dashboardHeader(title = "Test Application",titleWidth = "400px"),
dashboardSidebar(
sidebarMenu( #Add sidebarMenu here!!!!!
menuItem("Page 1", tabName = "page1", icon = icon("dashboard")), # You can add icons to your menu if you want
menuItem("Page 2", tabName = "page2", icon = icon("dashboard")))),
dashboardBody(
tabItems(
tabItem(
tabName = "page1",
h1("This is page 1")),
tabItem( #Add checkboxGroupInput into this tabItem
tabName = "page2",
h1("This is page 2"),
checkboxGroupInput("outcome", "Select Outcome Variable(s):", choices = c("Box 1", "Box 2", "Box 3")),
selectInput("selectinput", label = "Select:", choices = c("Choice 1", "Choice 2", "Choice 2")))
)
))
server <- function(input,output,session) {
}
shinyApp(ui, server)
I need some help as to how to re-hide a shiny output once it has been rendered. Below I have provided a reproducible example to explain my question.
I want text 2.2 to only be shown if Option 1 and B are selected, and text 1 to only show when option 2 is selected. I have done this by including conditionalPanel() with the conditions set accordingly.
This works, however, once the text has been rendered this text will not disappear when the input changes. I want text 2.2 to disappear if the user then changes the inputs to select any other option i.e. chooses Option 2.
Is it possible to do this with shiny? Apologies if this has been asked before - I couldn't find anything through searching - your help is much appreciated!
library(shiny)
ui <- fluidPage(
sidebarPanel(
selectInput("Input1", label = "Input1", choices = c("Option 1", "Option 2") ),
conditionalPanel(condition = "input.Input1 == 'Option 1'",
selectInput("Input2", label = "Input2",
choices = c("A", "B"))),
),
mainPanel(
tabsetPanel(
tabPanel("Tab 1", textOutput(outputId = "text1")),
tabPanel("Tab 2", textOutput(outputId = "text2.1"), textOutput(outputId = "text2.2") )
)
)
)
server <- function(input, output) {
observe({if(input$Input1 == 'Option 2'){
output$text1 <- renderText("This text only shows for option 2")
}})
output$text2.1 <- renderText("some text")
observe({if(input$Input2 == 'B'){
output$text2.2 <- renderText("Show this only if option 1B is selected")
}})
}
shinyApp(ui, server)
You need to specify the different if possiblities inside the observe environment. Here's a solution:
library(shiny)
ui <- fluidPage(
sidebarPanel(
selectInput("Input1", label = "Input1", choices = c("Option 1", "Option 2") ),
conditionalPanel(condition = "input.Input1 == 'Option 1'",
selectInput("Input2", label = "Input2",
choices = c("A", "B"))),
),
mainPanel(
tabsetPanel(
tabPanel("Tab 1", textOutput(outputId = "text1")),
tabPanel("Tab 2", textOutput(outputId = "text2.1"), textOutput(outputId = "text2.2") )
)
)
)
server <- function(input, output) {
observe({
if(input$Input1 == 'Option 2'){
output$text1 <- renderText("This text only shows for option 2")
}
else {
output$text1 <- renderText("")
}
})
output$text2.1 <- renderText("some text")
observe({
if (input$Input2 == "B") {
output$text2.2 <- renderText("Show this only if option 1B is selected")
}
else {
output$text2.2 <- renderText("")
}
})
}
shinyApp(ui, server)
I am trying to add tooltips/popovers using the shinyBS package for a Shiny application but am having an issue due to tabs don't have input/ids. This is preventing the tooltip from firing. Any thoughts?
library(shiny)
library(shinyBS)
shinyApp(
ui = tagList(
navbarPage(
theme = "cerulean", # <--- To use a theme, uncomment this
"shinythemes",
tabPanel(id="test","Navbar 1",
bsTooltip("test", title="Test Title", trigger = "hover"),
sidebarPanel(
fileInput("file", "File input:"),
textInput("txt", "Text input:", "general"),
sliderInput("slider", "Slider input:", 1, 100, 30),
tags$h5("Deafult actionButton:"),
actionButton("action", "Search"),
tags$h5("actionButton with CSS class:"),
actionButton("action2", "Action button", class = "btn-primary")
),
mainPanel(
tabsetPanel(
tabPanel("Tab 1",
bsTooltip("Tab 1", title="Test Title"),
h4("Table"),
tableOutput("table"),
h4("Verbatim text output"),
verbatimTextOutput("txtout"),
h1("Header 1"),
h2("Header 2"),
h3("Header 3"),
h4("Header 4"),
h5("Header 5")
),
tabPanel("Tab 2"),
tabPanel("Tab 3")
)
)
),
tabPanel("Navbar 2"),
tabPanel("Navbar 3")
)
),
server = function(input, output) {
output$txtout <- renderText({
paste(input$txt, input$slider, format(input$date), sep = ", ")
})
output$table <- renderTable({
head(cars, 4)
})
}
)
Attached is a test application using TabPanels and Tabset Panels for testing.
You can use HTML when passing the Title of the Tabs. In this case I just put the title in a span and added the attribute title which is the attribute HTML uses default for mouse-overs. For me this is much simpler than trying to add it over shinyBS.
library(shiny)
library(shinyBS)
shinyApp(
ui = tagList(
navbarPage(
theme = "cerulean", # <--- To use a theme, uncomment this
"shinythemes",
tabPanel(id="test",span("Navbar 1",title="Test Title"),
sidebarPanel(
fileInput("file", "File input:"),
textInput("txt", "Text input:", "general"),
sliderInput("slider", "Slider input:", 1, 100, 30),
tags$h5("Deafult actionButton:"),
actionButton("action", "Search"),
tags$h5("actionButton with CSS class:"),
actionButton("action2", "Action button", class = "btn-primary")
),
mainPanel(
tabsetPanel(
tabPanel(span("Tab 1", title="Test Title"),
h4("Table"),
tableOutput("table"),
h4("Verbatim text output"),
verbatimTextOutput("txtout"),
h1("Header 1"),
h2("Header 2"),
h3("Header 3"),
h4("Header 4"),
h5("Header 5")
),
tabPanel("Tab 2"),
tabPanel("Tab 3")
)
)
),
tabPanel("Navbar 2"),
tabPanel("Navbar 3")
)
),
server = function(input, output) {
output$txtout <- renderText({
paste(input$txt, input$slider, format(input$date), sep = ", ")
})
output$table <- renderTable({
head(cars, 4)
})
}
)
Here is a minimal example that adds a tooltip to forst tab
library(shiny)
library(shinyBS)
shinyApp(
ui = tagList(
navbarPage(
theme = "cerulean", # <--- To use a theme, uncomment this
"shinythemes",
tabPanel(id="test","Navbar 1",
bsTooltip("test", title="Test Title", trigger = "hover"),
sidebarPanel(
fileInput("file", "File input:"),
textInput("txt", "Text input:", "general"),
sliderInput("slider", "Slider input:", 1, 100, 30),
tags$h5("Deafult actionButton:"),
actionButton("action", "Search"),
tags$h5("actionButton with CSS class:"),
actionButton("action2", "Action button", class = "btn-primary")
),
mainPanel(
tabsetPanel(
tabPanel("Tab 1",
bsTooltip("Tab 1", title="Test Title"),
div(id = "my_id", #changed
h4("Table"),
tableOutput("table"),
h4("Verbatim text output"),
verbatimTextOutput("txtout"),
h1("Header 1"),
h2("Header 2"),
h3("Header 3"),
h4("Header 4"),
h5("Header 5")
), # changed
bsTooltip('my_id','some text...') # changed
),
tabPanel("Tab 2"),
tabPanel("Tab 3")
)
)
),
tabPanel("Navbar 2"),
tabPanel("Navbar 3")
)
),
server = function(input, output) {
output$txtout <- renderText({
paste(input$txt, input$slider, format(input$date), sep = ", ")
})
output$table <- renderTable({
head(cars, 4)
})
}
)
As you can see, I have only changed 3 lines
The first and the second line wraps the contents of the first tab inside a div. The div has an id my_id which will be used later
The third line adds the tooltip by using the div id
Basycally, you should be able to wrap whatever content you want into a div, give it an id and then add a popover. If you run into any problems with this approach, please let me know.