My first shinydashboard app looks good so far, except for the bullet points in the sidebar. What am I doing wrong?
ui <- shinydashboard::dashboardPage(
shinydashboard::dashboardHeader(title="First App"),
shinydashboard::dashboardSidebar(
shinydashboard::menuItem("Accounts", tabName = "accounts", icon = shiny::icon("users")),
shinydashboard::menuItem("Topics", icon = shiny::icon("hashtag"),
shinydashboard::menuSubItem("Multi-Topic-View", tabName = "topics_multi"),
shinydashboard::menuSubItem("Single-Topic-View", tabName = "topic_single"),
shinydashboard::menuSubItem("Tweet-View", tabName = "topic_tweet")
)
),
shinydashboard::dashboardBody(
shinydashboard::tabItems(
shinydashboard::tabItem(tabName="accounts", shiny::h2("Account tab content")),
shinydashboard::tabItem(tabName="topics_multi", shiny::h2("Multi Topic tab content")),
shinydashboard::tabItem(tabName="topic_single", shiny::h2("Single Topic tab content")),
shinydashboard::tabItem(tabName="topic_tweet", shiny::h2("Tweet Topic tab content"))
)
)
)
server <- function(input, output) { }
app <- shiny::shinyApp(ui, server)
shiny::runApp(app, launch.browser=TRUE)
Here is a Screenshot when I run this code in Google Chrome on a Windows machine (R version 4.0.3, shinydashboard_0.7.1, shiny_1.6.0). Can I get rid of the bullet points?
Use sidebarMenu(id = "tabs",...) in dashboardSidebar() to eliminate bullet points. You can define your id as you wish.
ui <- shinydashboard::dashboardPage(
shinydashboard::dashboardHeader(title="First App"),
dashboardSidebar(
sidebarMenu(id = "tabs", # Setting id makes input$tabs give the tabName of currently-selected tab
menuItem("Accounts", tabName = "accounts", icon = icon("users")),
menuItem("Topics", icon = shiny::icon("hashtag"),
menuSubItem("Multi-Topic-View", tabName = "topics_multi"),
menuSubItem("Single-Topic-View", tabName = "topic_single"),
menuSubItem("Tweet-View", tabName = "topic_tweet")
))
),
shinydashboard::dashboardBody(
tabItems(
tabItem(tabName="accounts", shiny::h2("Account tab content")),
tabItem(tabName="topics_multi", shiny::h2("Multi Topic tab content")),
tabItem(tabName="topic_single", shiny::h2("Single Topic tab content")),
tabItem(tabName="topic_tweet", shiny::h2("Tweet Topic tab content"))
)
)
)
server <- function(input, output, session) { }
shinyApp(ui, server)
Related
Im trying to add an actionButton() in the fist tabItem that when pressed will move to the second tabItem named widgets. I cannot understand what am I doing wrong.
## app.R ##
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "Basic dashboard"),
dashboardSidebar(
sidebarMenu(id="inTabset",
menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")),
menuItem("Widgets", tabName = "widgets", icon = icon("th"))
)
),
dashboardBody(
)
)
server <- function(input, output) {
tabItems(
# First tab content
tabItem(tabName = "dashboard",
"dashboard",
actionButton("nextt","Next")
),
# Second tab content
tabItem(tabName = "widgets",
"widgets"
)
)
observeEvent(input$nextt, {
updateTabItems(session, "inTabset",selected = "dashboard")
})
}
shinyApp(ui, server)
The issue is that you added the tabItems in the server instead of inside dashboardBody. Additionally, to switch from dashboard to widgets you have to do selected="widgets" in updateTabItems and finally your server should have an argument session:
library(shinydashboard)
library(shiny)
ui <- dashboardPage(
dashboardHeader(title = "Basic dashboard"),
dashboardSidebar(
sidebarMenu(
id = "inTabset",
menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")),
menuItem("Widgets", tabName = "widgets", icon = icon("th"))
)
),
dashboardBody(
tabItems(
tabItem(
tabName = "dashboard",
actionButton("nextt", "Next")
),
tabItem(
tabName = "widgets"
)
)
)
)
server <- function(input, output, session) {
observeEvent(input$nextt, {
updateTabItems(session, "inTabset", selected = "widgets")
})
}
shinyApp(ui, server)
I am trying to have an action button within the Body of a tab (called "Widgets" in code) link to a different tab (called "data_table" in code). I know how to do this if the tab that I want to connect to, "data_table", is one of the menuItems that appears on the sidebarMenu. However, I do not wish for a link to the "data_table" tab to appear in the sidebar. I am stuck. I would have thought I need an "observeEvent"-type command which links the action button to the "data_table" tab. But I don't know what that is. Advice welcome. The code shows the UI side of things.
ui <- dashboardPage(
dashboardHeader(title = "My query"),
dashboardSidebar(
sidebarMenu(
menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")),
menuItem("Widgets", tabName = "widgets", icon = icon("th"))
)
),
dashboardBody(
tabItems(
tabItem(tabName = "dashboard",
h2("Dashboard tab content")),
tabItem(tabName = "widgets",
h2("Widgets"),
actionButton(inputId="seedata", label = "See data")),
tabItem(tabName = "data_table",
h2("Table with the data"))
)
)
)
server <- function(input, output, session) { }
shinyApp(ui, server)
Perhaps you are looking for something like this.
ui <- dashboardPage(
dashboardHeader(title = "My query"),
dashboardSidebar(
sidebarMenu(# Setting id makes input$tabs give the tabName of currently-selected tab
id = "tabs",
menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")),
menuItem("Widgets", tabName = "widgets", icon = icon("th"))
)
),
dashboardBody(
tabItems(
tabItem(tabName = "dashboard",
h2("Dashboard tab content")),
tabItem(tabName = "widgets", h2("Widgets"),
fluidRow(
tabBox(id = "tabset1", height = "850px", width=12, title = "My Data",
### The id lets us use input$tabset1 on the server to find the current tab
tabPanel("Table with the data", value="tab1", " ",
actionButton(inputId="seedata", label = "See data"),
uiOutput("dataTable")
),
tabPanel("Display Data Table", value="tab2", " ",
#uiOutput("someoutput")
DT::dataTableOutput("testtable")
)
)
)
))
)
)
server <- function(input, output, session) {
output$dataTable <- renderUI({
tagList(
div(style="display: block; height: 350px; width: 5px;",HTML("<br>")),
actionBttn(inputId="datatable",
label="Data Table",
style = "simple",
color = "success",
size = "md",
block = FALSE,
no_outline = TRUE
))
})
observeEvent(input$datatable, {
updateTabItems(session, "tabs", "widgets")
if (input$datatable == 0){
return()
}else{
## perform other tasks if necessary
output$testtable <- DT::renderDataTable(
mtcars,
class = "display nowrap compact", # style
filter = "top", # location of column filters
options = list( # options
scrollX = TRUE # allow user to scroll wide tables horizontally
)
)
}
})
observeEvent(input$datatable, {
updateTabsetPanel(session, "tabset1",
selected = "tab2")
})
}
shinyApp(ui, server)
There is a wrong display in shiny dashboard for the below code. The title "Yet to do" is getting displayed as soon as i run the app. I need that when I click on Bivariate Analysis. What is the issue here. This happened when I introduced selectinput under menu item. Earlier it was working well
library(shinydashboard)
library(shiny)
ui <- dashboardPage(
dashboardHeader(title = "Data Analysis"),
dashboardSidebar(
sidebarMenu(
menuItem("Univariate Analysis", tabName = "Univariate", icon =
icon("question"),selectInput("Factors",h5("Factors"),choices =
c("","A","B"))),
menuItem("Bivariate Analysis", tabName = "Bivariate", icon =
icon("question")))
),
dashboardBody(
tabItems(
tabItem(tabName = "Univariate",fluidRow(box(plotOutput("Plot1"),width =
1000,height = 1000),
box(plotOutput("Plot2"),width =
1000,height = 1000))),
tabItem(tabName = "Bivariate",h1("Yet to do")))
))
server <- function(input, output) {
}
shinyApp(ui, server)
It is related having selectInput() as menuItem(). I tried some options like creating menuSubItem etc. but couldn't get it to work. This is probably some bug so you may have to look around for a fix. For now, I'd suggest moving the selectInput inside dashboardBody() -
ui <- dashboardPage(
dashboardHeader(title = "Data Analysis"),
dashboardSidebar(
sidebarMenu(
menuItem("Univariate Analysis",
tabName = "Univariate", icon = icon("question")
# removing selectInput from here fixes the issue
# ,selectInput("Factors", h5("Factors"), choices = c("","A","B"))
),
# an option is to have selectInput by itself but probably not the layout you want
# selectInput("Factors", h5("Factors"), choices = c("","A","B")),
menuItem("Bivariate Analysis",
tabName = "Bivariate", icon = icon("question")
)
)
),
dashboardBody(
tabItems(
tabItem(tabName = "Univariate",
fluidRow(
# add selectInput somewhere on Univariate page
selectInput("Factors", h5("Factors"), choices = c("","A","B")),
box(plotOutput("Plot1"), width = "50%", height = "50%"),
box(plotOutput("Plot2"), width = "50%", height = "50%")
)
),
tabItem(tabName = "Bivariate",
h1("Yet to do")
)
)
)
)
server <- function(input, output) {}
shinyApp(ui, server)
Is there a way to have a new tab open in browser with the link given after clicking on a plot? Below is my code, right now I have a couple of links to click that work in the Widgets section and I have some output once I click the plot in the main Dashboard section.
## app.R ##
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "CN Basic dashboard"),
## Sidebar content
dashboardSidebar(
sidebarMenu(
menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")),
menuItem("Widgets", tabName = "widgets", icon = icon("th")),
menuItem("About", icon = icon("info-circle"), tabName = "about")
)
),
## Body content
dashboardBody(
tabItems(
# First tab content
tabItem(tabName = "dashboard",
fluidRow(
box(plotOutput("plot1", height = 250,click="plot_click")),
box(
title = "Controls",
sliderInput("slider", "Number of observations:", 1, 100, 50)
)
),
verbatimTextOutput("plot_clickinfo")
),
# Second tab content
tabItem(tabName = "widgets",
h2("Link1"),
tags$a(href="www.rstudio.com", "Click here!"),
h2("Link2"),
tags$a(HTML('Visit W3Schools!'))
),
tabItem(tabName = "about",
#includeHTML("www/about.html")
h2("Here is information about stuff that's important")
)
)
)
)
server <- function(input, output) {
set.seed(122)
histdata <- rnorm(500)
output$plot1 <- renderPlot({
data <- histdata[seq_len(input$slider)]
hist(data)
})
output$plot_clickinfo <- renderPrint({
cat("Click:\n")
str(input$plot_click)
})
}
shinyApp(ui, server)
Ultimately I just want to click on the plot and that brings me to a website.
This should do:
observeEvent(input$plot_click,{
browseURL("https://www.google.com")
})
I am trying to use update my Shiny Dashboard Sidebar based on the tab selected in the Main body. So when tab "Overall" is selected then this should display the menu items in Conditional Panel 1 (TA.Name1,TA.Name2), and when tab "Other" is selected then the sidebar displays the menu items for conditional panel 2. Data is bellow:
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
conditionalPanel(condition="input.conditionedPanels==1", sidebarMenu(width=150,
menuItem("TA.Name1", tabName = "TA1")),
menuItem("TA.Name2", tabName = "TA2"))),
conditionalPanel(condition="input.conditionedPanels==2",sidebarMenu(width=150,
menuItem("EA.Name1", tabName = "EA1")),
menuItem("EA.Name2", tabName = "EA2"))),
dashboardBody(
tabsetPanel(
tabPanel("Overall",value=1,fluidRow(
column(3,selectInput("PACO", h5("PACO"), levels(OA$PACO)))),
tabItems(
tabItem(tabName = "TA1","TA1"),fluidRow(
box(title="TA.Name1,dygraphOutput("TA1.data")),
box(title="TA.Name2,dygraphOutput("TA2.data")))),
tabItem(tabName = "TA2","TA2")
)),
tabPanel("Other",value=2,fluidRow(
column(3,selectInput("CV", h5("CV"), levels(OA$CV)))),
tabItems(
tabItem(tabName = "EA1","EA1"),fluidRow(
box(title="EA.Name1,dygraphOutput("EA1.data")),
box(title="EA.Name2,dygraphOutput("EA2.data")))),
tabItem(tabName = "EA2","EA2")
))))
Your Example Code is not good, i think You should have a look at this feed:
http://stackoverflow.com/questions/5963269/how-to-make-a-great-r-reproducible-example
I had to simplify Your code to actually find solution...
Have a look at it:
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
sidebarMenu(id="tabs",
sidebarMenuOutput("menu"))),
dashboardBody(
tabsetPanel(id="tabs2",
tabPanel("Overall",value=1),
tabPanel("Other",value=2))))
server <- function(input, output, session) {
output$menu <- renderMenu({
if (input$tabs2 == 1 ) {
sidebarMenu(
menuItem("TA.Name1", tabName = "TA1"),
menuItem("TA.Name2", tabName = "TA2"))}
else{
sidebarMenu(
menuItem("EA.Name1", tabName = "EA1"),
menuItem("EA.Name2", tabName = "EA2"))
}
})
}
shinyApp(ui = ui, server = server)
It should do what You want -- > reactive sidebarMenu