Shiny dataTableOutput won't show up if its is under tabItem - r

My Shiny APP has a simple structure looks like:
ui <- fluidPage(
dashboardPage(
dashboardHeader(title = "My App"),
dashboardSidebar(
sidebarMenu(
menuItem("Dashboard", tabName = "dashboard",
selectInput('location', 'Please Select a Location', choices= c("A", "B", "C")),
downloadButton(outputId = 'download', lable = "Downlaod"),
menuItem("Widgets", tabName = "widgets", badgeLabel = "new", badgeColor = "green")
)),
# dashboardBody first try (works no problem):
dashboardBody(DT::dataTableOutput(outputId = 'mytable'))
# dashboardBody second try (data table does not appear):
dashboardBody(
tabItems(
tabItem(tabName = "dashboard",
DT::dataTableOutput(outputId = 'mytable')),
tabItem(tabName = "widgets",
h2("Widgets tab content"))
)))
server <- shinyServer(function(input, output, session){
output$mytable<- DT::renderDataTable({```some calculation```})
output$downloadcsv <- downloadHandler(
filename = function(){paste0(sys.Date(),'-mytable.csv')},
content = function(file) {write.csv(```the table from renderDataTable step```, file)}
)}
As you can see, the app includes two different "pages" where the first one is a data table depends on the selectInput.
My app runs perfectly if I don't wrap it with tabItem. However, once I write it under tabItem, the app only shows "Widgets tab content" which is the content of the second tab and does not populate the data table at all (while the download button still works).
I've also tried to add class='active' behind tabName = "dashboard", but it still doesn't work. Plus, I'm not getting any error message.
I'm wondering if anyone knows which step did I go wrong? Any help would be appreciated!

The problem lies in the placement of the table. I have rendered input options outside the menuItem. Check this code below
ui <- fluidPage(
dashboardPage(
dashboardHeader(title = "My App"),
dashboardSidebar(
sidebarMenu(
selectInput('location', 'Please Select a Location', choices= c("A", "B", "C")),
downloadButton(outputId = 'download.csv', lable = "Downlaod"),
menuItem("Dashboard", tabName = "dashboard"),
menuItem("Widgets", tabName = "widgets", badgeLabel = "new", badgeColor = "green")
)),
# dashboardBody first try (works no problem):
#dashboardBody(DT::dataTableOutput(outputId = 'mytable'))
#dashboardBody second try (data table does not appear):
dashboardBody(
tabItems(
tabItem(tabName = "dashboard",
DT::dataTableOutput(outputId = 'mytable')),
tabItem(tabName = "widgets",
h2("Widgets tab content"))
))
))
server <- function(input, output, session){
output$mytable<- DT::renderDataTable({DT::datatable(head(iris))})
output$downloadcsv <- downloadHandler(
filename = function(){paste0(sys.Date(),'-mytable.csv')},
content = function(file) {write.csv(head(iris), file)}
)}
shinyApp(ui=ui, server=server)

Related

Link to a tab from dashboardBody

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)

SelectInput under menuitem is not working

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)

How to connect Shiny plot click to website

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")
})

shinydashboard: menuSubItem not rendering at start in case of several menuSubItems

I found that menuSubItem content is not rendering in case of several (more than one) tabItems.
Minimal example demonstrating this behavior is below.
The desired behavior is to show content of the tabItem marked as selected = TRUE on startup. Now, the content shows up only after switching between menuSubItems in the sidebar.
How can I make it work?
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "MINIMAL EXAMPLE"),
dashboardSidebar(
sidebarMenuOutput("menu")
),
dashboardBody(
uiOutput("body")
)
)
server <- function(input, output, session) {
output$menu <- renderMenu(
sidebarMenu(
menuItem(text = "TABS", tabName = "TABS", startExpanded = T,
menuSubItem(text = "tab1", tabName="tab1",
icon = icon("cube"), selected = TRUE),
menuSubItem(text = "tab2", tabName="tab2",
icon = icon("cube"), selected = FALSE)
)
)
)
output$body <- renderUI({
tabItems(
tabItem(tabName = "tab1",
h4("MY TEXT 1")
),
tabItem(tabName = "tab2",
h4("MY TEXT 2")
))
})
}
shinyApp(ui = ui, server = server)
Indeed, putting ui elements directly in UI solves it.
But the approach of putting everything inside ui is limited to situations that do not involve using reactive values. As I understand passing reactive value from server to ui is not possible in general (or limited to special cases). Please correct if I am wrong... Thanks
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "MINIMAL EXAMPLE"),
dashboardSidebar(
sidebarMenuOutput("menu")
),
dashboardBody(
tabItems(
tabItem(tabName = "tab1",
h4("MY TEXT 1")
),
tabItem(tabName = "tab2",
h4("MY TEXT 2")
))
)
)
server <- function(input, output, session) {
output$menu <- renderMenu(
sidebarMenu(
menuItem(text = "TABS", tabName = "TABS", startExpanded = T,
menuSubItem(text = "tab1", tabName="tab1",
icon = icon("cube"), selected = TRUE),
menuSubItem(text = "tab2", tabName="tab2",
icon = icon("cube"), selected = FALSE)
)
)
)
}
shinyApp(ui = ui, server = server)
Renaming your output to something other than "body" helps - please see this.
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "MINIMAL EXAMPLE"),
dashboardSidebar(
sidebarMenuOutput("menu")
),
dashboardBody(
uiOutput("myBodyOutput")
)
)
server <- function(input, output, session) {
output$myBodyOutput <- renderUI({
tabItems(
tabItem(tabName = "tab1",
h4("MY TEXT 1")
),
tabItem(tabName = "tab2",
h4("MY TEXT 2")
))
})
output$menu <- renderMenu(
sidebarMenu(id = "sidebarID",
menuItem(text = "TABS", tabName = "TABS", startExpanded = T,
menuSubItem(text = "tab1", tabName="tab1",
icon = icon("cube"), selected = TRUE),
menuSubItem(text = "tab2", tabName="tab2",
icon = icon("cube"), selected = FALSE)
)
)
)
}
shinyApp(ui = ui, server = server)

SideBar Not rendering anything on Dashboard Body: R Shiny Dashboard

I am creating a shiny Dashboard which has two tabs in the side bar. Tab1 is for importing a csv and Tab2 is for showing the plots for the selected variable.
Tab2 has 1 select input option for selecting the variable for plot
Problem: After clicking on sidebar tabs, my dashboard body doesn't change. It is always showing me Tab1 Content i.e csv import results.
So despite of clicking on Tab2 in sidebar, nothing happens
Following is my script
library(shinydashboard)
library(shiny)
library(DT)
#UI
sidebar=dashboardSidebar(width=200,
sidebarMenu( id="sidebar",
menuItem("Data UpLoad", tabName = "dashboard", icon = icon("table"),
fileInput('file1','Choose CSV File',
accept=c('text/csv','text/comma-separated-values,text/plain', '.csv'))),
menuItem("Uni Variate", tabName = "Uni", icon = icon("line-chart"),
fluidRow(
selectInput("options",label=h5("Select Column"),"")))))
body= dashboardBody(
tabItems(
tabItem(tabName="dashboard",class='active',
fluidRow(
box(
title="Data",solidHeader = TRUE, collapsible = TRUE,
div(style='overflow-x: scroll',tableOutput("table1"))))),
tabItem(tabName = "Uni",
fluidRow(box(title="Plot",solidHeader = TRUE,plotOutput("plot1"))),
h2("tab content"))))
dashboardPage(
dashboardHeader(title= "test"),sidebar,body)
#Server
server <- function(input, output,session) {
data_set <- reactive({
req(input$file1)
inFile <- input$file1
data_set1<-read.csv(inFile$datapath)
list(data=data_set1)
})
# updating select input of second tab in shiny side bar
observe({
updateSelectInput(
session,
"options",
choices = names(data_set()$data))})
# tab1
output$table1= renderTable({
de=as.data.frame(data_set()$data[1:7,])})
#tab2
output$plot1 <- renderPlot({ggplot(data_set$data,aes(y=input$options,x=Prediction))+geom_histogram(binwidth=0.50, fill="blue") })
}
Every help is important!
It seems that the problem is related to putting widgets on the sidebar, it takes them as sub-menus. Below are a couple of possible solution to have widgets on the sidebar depending if you want to hide them when are inactive.
Option 1- widgets always visible
library(shinydashboard)
library(shiny)
sidebar <- dashboardSidebar(width=200,
sidebarMenu( id="sidebar",
menuItem("Data UpLoad", icon = icon("table"), tabName = "dashboard"),
div(
fileInput('file1','Choose CSV File',
accept=c('text/csv','text/comma-separated-values,text/plain', '.csv'))
),
menuItem("Uni Variate", icon = icon("line-chart"), tabName = "Uni"),
div(
selectInput("options",label=h5("Select Column"),"")
)
)
)
body <- dashboardBody(
tabItems(
tabItem(tabName="dashboard", class='active',
box( title="Data",solidHeader = TRUE, collapsible = TRUE,
div(style='overflow-x: scroll', p("table1"))
)
),
tabItem(tabName = "Uni",
box(title="Plot", solidHeader = TRUE, p("plot1"))
)
)
)
server <- function(input, output,session) {}
shinyApp(dashboardPage(dashboardHeader(title= "test"), sidebar, body), server = server)
Option 2- widgets only visible when tab is active
Please note that to show the correct tab on the body, the users must click on the sub-item.
library(shinydashboard)
library(shiny)
sidebar <- dashboardSidebar(width=200,
sidebarMenu( id="sidebar",
menuItem("data", icon = icon("table"), tabName = "dashboard",
menuSubItem(tabName = "dashboard",
fileInput('file1','Choose CSV File',
accept=c('text/csv','text/comma-separated-values,text/plain', '.csv'))
)),
menuItem("Uni Variate", icon = icon("line-chart"), tabName = "Uni",
menuSubItem( tabName = "Uni",
selectInput("options",label=h5("Select Column"),"")
))
)
)
body <- dashboardBody(
tabItems(
tabItem(tabName="dashboard", class='active',
box( title="Data",solidHeader = TRUE, collapsible = TRUE,
div(style='overflow-x: scroll', p("table1"))
)
),
tabItem(tabName = "Uni",
box(title="Plot", solidHeader = TRUE, p("plot1"))
)
)
)
server <- function(input, output,session) {}
shinyApp(dashboardPage(dashboardHeader(title= "test"), sidebar, body), server = server)

Resources