SelectInput under menuitem is not working - r

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)

Related

R shiny downloadbutton aligned to other input elements like dateInput

I have an R shiny app with different download buttons as illustrated in the code below. The issue is that the position of the download button within fluidRow is not automatically aligned with the positions of other input elements like dateInput below.
ui <- dashboardPage(
title = "Test Dashboard", # this is the name of the tab in Chrome browserr
dashboardHeader(title = "Web Portal"),
dashboardSidebar(
sidebarMenu(
menuItem('Retail', tabName = "retail", icon = icon("th"),
menuItem('Dashboard', tabName = 'retail_dashboard'))
)
),
dashboardBody(
tabItem(tabName = "retail_dashboard",
tabsetPanel(type = "tabs",
tabPanel("Dashboard",
h3("Test."),
fluidRow(column(2,
dateInput("idx_muni_tot_ret_start_dt", label = "Start Date:", value = Sys.Date()-10)), # 1yr ago
column(2,
dateInput("idx_muni_tot_ret_end_dt", label = "End Date:", value = Sys.Date())),
column(2,
downloadButton("download_idx_muni_TR_data","Download Data"))
)
)
)
)
)
)
server <- function(input, output, session) {
# code...
}
cat("\nLaunching 'shinyApp' ....")
shinyApp(ui, server)
I found similar questions here How do I align downloadButton and ActionButton in R Shiny app? and here Change download button position in a tab panel in shiny app but they don't seem to answer my questions. I also attach a screenshot with the current button position as well as the expected one.
A workaround is to simulate a label on top of the download button and add 5px of margin-bottom.
column(
width = 2,
div(tags$label(), style = "margin-bottom: 5px"),
div(downloadButton("download_idx_muni_TR_data", "Download Data"))
)
A bit of css does the trick:
ui <- dashboardPage(
title = "Test Dashboard",
dashboardHeader(title = "Web Portal"),
dashboardSidebar(
),
dashboardBody(
h3("Test."),
fluidRow(column(2,
dateInput("idx_muni_tot_ret_start_dt",
label = "Start Date:", value = Sys.Date() - 10)),
column(2,
dateInput("idx_muni_tot_ret_end_dt",
label = "End Date:", value = Sys.Date())),
column(2,
div(style = "margin-bottom:15px",
downloadButton("download_idx_muni_TR_data","Download Data")))
, style = "display:flex;align-items:end")
)
)
Update
If you want to add a selectInput you need yet some new css tweaks to get the input on the same line:
ui <- dashboardPage(
title = "Test Dashboard",
dashboardHeader(title = "Web Portal"),
dashboardSidebar(),
dashboardBody(
h3("Test."),
fluidRow(column(2,
dateInput("idx_muni_tot_ret_start_dt",
label = "Start Date:", value = Sys.Date() - 10)),
column(2,
dateInput("idx_muni_tot_ret_end_dt",
label = "End Date:", value = Sys.Date())),
column(2,
tagAppendAttributes(selectInput("slc", "Select", LETTERS), style="margin-bottom:10px")),
column(2,
div(style = "margin-bottom:15px",
downloadButton("download_idx_muni_TR_data","Download Data"))),
style = "display:flex;align-items:end")
)
)

How do I add an image to shinydashboard menuItem()s?

In essence, I would like to replace the icon in each menuItem() in a shinydashboard with an image. More specifically, I just need each menuItem() to have an image then text next to it.
Here's some moderately successful attempts I have tried (commented in code below);
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "Dashboard MenuItems"),
dashboardSidebar(
sidebarMenu(
id = "tabs",
menuItem(
"Dashboard",
tabName = "dashboard",
## creates a drop down w/ no image
# label = img(src = "logo.png",
# title = "logo", height = "35pt")
## creates a drop down with the images
# `tag$` isn't needed
# tags$img(src = "logo.png",
# title = "logo", height = "35pt")
),
menuItem(
"Not Dashboard",
tabname = "not_dashboard"
)
) # end sidebarMenu
), # end dashboardSidebar
dashboardBody(
fluidRow(
box(
title = "stuff goes here",
width = 12
)
)
) # end dashboardBody
)
server <- function(input, output, session) {
message("You can do it!")
}
shinyApp(ui, server)
I successfully used action buttons with background images to simulate the behavior, but I would prefer to find a solution using menuItem()s, if possible.
I was hoping there would be a similar method to add the image to the background of the menuItem() or concatenate the image with the text within the menuItem().
I am not good with shiny tags. I don't really know much about HTML/CSS/JS or Bootstrap, most of the time I can find a solution here and hack my way to what I want, but this one has eluded me.
Any ideas?
You can keep your images in the www folder and use a div to wrap the image along with the text as shown below.
ui <- dashboardPage(
dashboardHeader(title = "Dashboard MenuItems"),
dashboardSidebar(
sidebarMenu(
id = "tabs",
menuItem( div(tags$img(src = "YBS.png", width="20px"), "Dashboard2"),
tabName = "dashboard" # , icon=icon("b_icon")
),
menuItem(
div(tags$img(src = "mouse.png", width="35px"),"Not Dashboard"),
tabname = "not_dashboard" #, icon=icon("home")
)
) # end sidebarMenu
), # end dashboardSidebar
dashboardBody(
fluidRow(
box(
title = "stuff goes here",
width = 12
)
)
) # end dashboardBody
)
server <- function(input, output, session) {
message("You can do it!")
}
shinyApp(ui, server)

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)

R Shiny tabsetPanel displaying strange tab name?

I am working with shinydashboard and using tabsetPanel, however strange name/number appears on the each tabPanel in the upper-left corner (like: tab-4750-1 and the number changes).
Does anyone know how i can remove it?
Hint: The problem appears in the menuItem: Tabelle & Plots
Code:
library(shiny)
library(shinydashboard)
library(ggplot2)
library(scales)
library(reshape2)
library(plyr)
library(dplyr)
library(DT)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
sidebarMenu(
menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")),
menuItem("Tabelle & Plots", icon = icon("area-chart"), tabName = "tabelle")
)
),
dashboardBody(
tabItems(
tabItem(tabName = "dashboard"
),
tabItem(tabName = "tabelle",
tabsetPanel(id="tabs",width = NULL, height = "800px", selected = 1,
tabPanel(value=1,title="Tabelle filtern",
fluidRow(
column(12,
box(width = NULL, div(style = 'overflow-y: scroll; overflow-x: scroll;max-height: 650px; position:relative;',
dataTableOutput("tabelle")))))),
tabPanel("Plots", value = 2,
fluidRow(
column(12,
box(width = NULL, plotOutput("plot", height=650)),
box(status = "danger",width = NULL,div(style = 'overflow-x: scroll;position:relative;',
dataTableOutput("tabelle2")))))))
)
)
)
)
server <- function(input, output) {
}
shinyApp(ui, server)
Thanks for help!
Cheers

Resources