I need a menuItem hidden, when the app is entered into. When a user chooses a certain value, the menuItem has to appear.
I have tried shinyjs functions hidden, and it hides a menuItem, but when using show or toggle, a menuItem doesn't appear.
I've found R shinydashboard - show/hide multiple menuItems based on user input
and came up with this
library(shiny)
library(shinydashboard)
library(shinyjs)
header <- dashboardHeader(title = "APP", titleWidth = 330)
sidebar <- dashboardSidebar(
sidebarMenu(id="tabs",
menuItem("",tabName="default"),
menuItem("Scenarios",tabName = "scenarios", icon = icon("flag")),
uiOutput("recOpt"),
menuItem("Simulation", tabName = "game", icon = icon("gamepad")),
menuItem("Actions", tabName = "actions", icon = icon("folder"),
menuSubItem("Save project", tabName = "save"),
menuSubItem("Open project", tabName = "open")
)
)
)
body <- dashboardBody(
tabItems(
tabItem(tabName = "scenarios",
useShinyjs(),
radioButtons("radio", h3("Radio buttons"),
choices = list("Choice 1" = 1,
"Choice 2" = 2,
"Choice 3" = 3))
)
)
)
ui <- dashboardPage(header, sidebar, body)
server <- function(input, output) {
output$recOpt <- renderUI({
if(input$radio == 2)
menuItem("Options", tabName = "recOpt", icon = icon("bell"),
menuSubItem("No option",tabName="RO_00"),
menuSubItem("Option 1",tabName="RO_01")
)
})
}
shinyApp(ui, server)
It works but the hidden/shown item is not aligned correcty, nor the encoding is correct.
Have any ideas how to make it better?
A little late, but anyway:
Check the shinydashboard capabilities on dynamic content.
This should do it:
library(shiny)
library(shinydashboard)
library(shinyjs)
header <- dashboardHeader(title = "APP", titleWidth = 330)
sidebar <- dashboardSidebar(
sidebarMenu(id="tabs",
menuItem("",tabName="default"),
menuItem("Scenarios",tabName = "scenarios", icon = icon("flag")),
menuItemOutput("recOpt"),
menuItem("Simulation", tabName = "game", icon = icon("gamepad")),
menuItem("Actions", tabName = "actions", icon = icon("folder"),
menuSubItem("Save project", tabName = "save"),
menuSubItem("Open project", tabName = "open")
)
)
)
body <- dashboardBody(
tabItems(
tabItem(tabName = "scenarios",
useShinyjs(),
radioButtons("radio", h3("Radio buttons"),
choices = list("Choice 1" = 1,
"Choice 2" = 2,
"Choice 3" = 3))
)
)
)
ui <- dashboardPage(header, sidebar, body)
server <- function(input, output) {
output$recOpt <- renderMenu({
if(input$radio == 2)
menuItem("Options", tabName = "recOpt", icon = icon("bell"),
menuSubItem("No option",tabName="RO_00"),
menuSubItem("Option 1",tabName="RO_01")
)
})
}
shinyApp(ui, server)
Related
I would like to set the starting page empty in my R shiny app. I mean the starting page shouldn't show anything except for the search bar. Then, once any value is plugged in the search bar, the result should show up. How can I achieve this?
My code is here:
library(shiny)
library(shinydashboard)
library(shinyWidgets)
BB = read.table("first.csv", header = TRUE,sep = ";",stringsAsFactors = FALSE)
shinyApp(
ui = dashboardPage(
dashboardHeader(title = "ciliogenics"),
dashboardSidebar(sidebar <- dashboardSidebar(
sidebarMenu(id = "SEARCH",
menuItem("SEARCH", tabName = "SEARCH"),
menuItem("Clinical Signs and Symptoms", tabName = "Clinical Signs and Symptoms"),
menuItem("Diseases", tabName = "Diseases"),
menuItem("Genes", tabName = "Genes"),
menuItem("Classifications and schemas", tabName = "Classification and schemas"),
menuItem("HELP", tabName = "HELP"),
menuItem("Related papers", tabName = "Related papers"),
menuItem("FAQs", tabName = "FAQs")
)
)),
dashboardBody(tabItems(tabItem(tabName = "SEARCH" ,
fluidRow(column(width=6,box(DT::dataTableOutput('myTable'), width=NULL)),
column(width=6,box(textOutput("myText"), width=NULL))))))
),
server = function(input, output, session){
mytbl <- BB
output$myTable <- DT::renderDataTable({DT::datatable(mytbl,
rownames=FALSE)})
output$myText <- renderText({ "The value entered in the seach box should appear here!" })
}
)
You can write your own search function. Using mtcars dataset -
library(shiny)
library(shinydashboard)
library(shinyWidgets)
library(DT)
shinyApp(
ui = dashboardPage(
dashboardHeader(title = "ciliogenics"),
dashboardSidebar(sidebar <- dashboardSidebar(
sidebarMenu(id = "SEARCH",
menuItem("SEARCH", tabName = "SEARCH"),
menuItem("Clinical Signs and Symptoms", tabName = "Clinical Signs and Symptoms"),
menuItem("Diseases", tabName = "Diseases"),
menuItem("Genes", tabName = "Genes"),
menuItem("Classifications and schemas", tabName = "Classification and schemas"),
menuItem("HELP", tabName = "HELP"),
menuItem("Related papers", tabName = "Related papers"),
menuItem("FAQs", tabName = "FAQs")
)
)),
dashboardBody(tabItems(tabItem(tabName = "SEARCH" ,
fluidRow(column(width=6,box(DT::dataTableOutput('myTable'), width=NULL)),
column(width=6,box(textOutput("myText"), width=NULL))))))
),
server = function(input, output, session){
rv <- reactiveValues(inds = 0, mytbl = mtcars)
output$myTable <- DT::renderDataTable({DT::datatable(rv$mytbl[rv$inds, ],rownames=FALSE, callback = JS(
"table.on( 'search.dt', function () {",
"Shiny.setInputValue( 'search', table.search() );",
"} );"
))})
output$myText <- renderText({paste0("Searching for ...", input$search)})
observeEvent(input$search, {
rv$inds <- which(rowSums(sapply(rv$mytbl, function(x) grepl(input$search, x))) > 0)
})
}
)
I want to hide and show a menuItem when a user check a box. I used useShinyjs() and renderMenu() function but once the menuItem is shown, I cannot hide it again by unchecking the box.
This is what I did :
library(shiny)
library(shinydashboard)
library(shinyjs)
header <- dashboardHeader(title = "my app")
sidebar <- dashboardSidebar(
sidebarMenu(id="menu",
menuItem("Tab 1",tabName = "tab1", icon = icon("question")),
menuItemOutput("another_tab"),
menuItem("Tab 2", tabName = "tab2", icon = icon("home"))
)
)
)
body <- dashboardBody(
tabItems(
tabItem(tabName = "tab1",
useShinyjs(),
checkboxInput("somevalue", "Check me", FALSE)
)
)
)
ui <- dashboardPage(header, sidebar, body)
server <- function(input, output) {
output$another_tab <- renderMenu({
if(input$somevalue == TRUE)
menuItem("My tab", tabName = "tab3", icon = icon("cogs"))
})
}
shinyApp(ui, server)
How can we hide the menuItem again ?
Another way to do it is
output$another_tab <- renderMenu({
if(input$somevalue == TRUE) {
menuItem("My tab", tabName = "tab3", icon = icon("cogs"))
}else shinyjs::hide(selector = "a[data-value='tab3']" )
})
You can create an empty menuItem():
server <- function(input, output) {
output$another_tab <- renderMenu({
if(input$somevalue == TRUE)
menuItem("My tab", tabName = "tab3", id="tab3", icon = icon("cogs"))
else
menuItem(NULL)
})
}
I have a Shiny app where there is an action button that is suppose to connect to Skype so people can directly chat with me. Below is the code I tried however when the action button is clicked nothing happens.
library(shiny)
library(shinydashboard)
rm(list=ls())
header <- dashboardHeader()
sidebar <- dashboardSidebar(
sidebarMenu(id = "menuChoice",
menuItem("Resources", tabName = "ResourcesMenu", icon = icon("leaf"),
menuSubItem("Filter Selection", tabName =
"LayoutSubMenu", icon = icon("angle-double-right")),
menuSubItem("Test", tabName = "Test2", icon = icon("globe")),
menuSubItem("Test 3", tabName = "Test3", icon = icon("wrench"))
),
menuItem("Trial Run", tabName = "TR", icon = icon("star"))
)
)
body <- dashboardBody(
uiOutput("TabSelect"),
#This action button is where I need help
a(actionButton(inputId = "phone",
label = "867-5309",
icon = icon("fab fa-skype", lib = "font-awesome")
),
href="skype:LastName, FirstName?chat"
)
)
ui <- dashboardPage(header, sidebar, body)
server <- function(input, output, session) {
output$TabSelect <- renderUI ({
selectInput(inputId = "LoadTab", "Available Tabs",
choices = c(input$menuChoice)
)
})
}
shinyApp(ui, server)
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)
I am trying to build a shiny application using sidebarMenu with menuItems. Currently the menu items are duplicated,
enter image description here
Clicking the first and second menu items are not showing the table or the plot. Only the last two shows the output. How can I modify it to have only two items - 1) Plots Menu, 2) Table Menu (with sub items) and clicking on it show the respective output. Used the mtcars dataset and the code ispasted below
data(mtcars)
ibrary(shiny)
library(shinydashboard)
library(dplyr)
ui <- dashboardPage(
dashboardHeader(title = "Dynamic sidebar"),
dashboardSidebar(
sidebarMenu(
menuItem("Plots Menu", tabName = "plot_page", icon = icon("line-chart")),
menuItem("Table Menu", tabName="intro_page", icon = icon("info"),
selectInput(inputId = "mcm", label = "Some label",
multiple = TRUE, choices = unique(mtcars$cyl), selected = unique(mtcars$cyl)))
),
sidebarMenuOutput("menu")
),
dashboardBody(tabItems(
tabItem(tabName = "plots", h2("Dashboard plots"),
fluidRow(column(width = 12, class = "well",
h4("Boxplot"),
plotOutput("bxp")))
),
tabItem(tabName = "dashboard", h2("Dashboard tab content"),
dataTableOutput(outputId = "subdt"))
)
)
)
server <- function(input, output, session) {
output$menu <- renderMenu({
sidebarMenu(
menuItem("Plots Menu", tabName = "plots", icon = icon("line-chart")),
menuItem("Table Menu", tabName="dashboard", icon = icon("calendar"))
)
})
datsub <- reactive({
mtcars %>%
filter_at(vars("cyl"), all_vars(. %in% input$mcm))
})
output$subdt <- renderDataTable({
datsub()
})
output$bxp <- renderPlot({
hist(rnorm(100))
})
}
shinyApp(ui, server)
I put the code together.
-Ian
data(mtcars)
library(shiny)
library(shinydashboard)
library(dplyr)
ui <- dashboardPage(
dashboardHeader(title = "Dynamic sidebar"),
dashboardSidebar(sidebarMenu(id = "menu", sidebarMenuOutput("menu"))),
dashboardBody(tabItems
(
tabItem
(tabName = "plots", h2("Dashboard plots"),
fluidRow(column(width = 12, class = "well",
h4("Boxplot"),
plotOutput("bxp")))
),
tabItem(tabName = "dashboard", h2("Dashboard tab content"),
dataTableOutput(outputId = "subdt"))
)
)
)
server <- function(input, output, session) {
output$menu <- renderMenu({
sidebarMenu(
menuItem("Plots Menu", tabName = "plots", icon = icon("line-chart")),
menuItem("Table Menu", icon = icon("info"),
menuSubItem(
"Dashboard", tabName = "dashboard", icon = icon("calendar")
),
selectInput(
inputId = "mcm", label = "Some label", multiple = TRUE,
choices = unique(mtcars$cyl), selected = unique(mtcars$cyl)
)
)
)
})
datsub <- reactive({
mtcars %>%
filter_at(vars("cyl"), all_vars(. %in% input$mcm))
})
output$subdt <- renderDataTable({
datsub()
})
output$bxp <- renderPlot({
hist(rnorm(100))
})
}
shinyApp(ui, server)
You have both the standard and reactive sidebar options running in tandem. If you need a reactive sidebar, just put the contents in the server function and call all of it with sidebarMenuOutput in ui.
ui.R
dashboardSidebar(sidebarMenu(id = "menu", sidebarMenuOutput("menu")))
server.R
output$menu <- renderMenu({
sidebarMenu(
menuItem("Plots Menu", tabName = "plots", icon = icon("line-chart")),
menuItem("Table Menu", icon = icon("info"),
menuSubItem(
"Dashboard", tabName = "dashboard", icon = icon("calendar")
),
selectInput(
inputId = "mcm", label = "Some label", multiple = TRUE,
choices = unique(mtcars$cyl), selected = unique(mtcars$cyl)
)
)
)
})