Related
right now when the user runs the app, the desired website/dashboard body is displayed, however, I want the desired website/body to display ONLY when the user selects "Control Chart" from "Tab 1" in the sidebar menu. This is because I will have multiple sidebar tabs, when depending on the website the user selects, the embedded website should automatically change. When the user initially runs the app, the dashboard body should be blank. Only when they select Tab 1 -> Cell Culture -> Control Chart should they see the google homepage.
Please help!
ui <-
dashboardPage(
skin = "black",
dashboardHeader(title = "Dashboard ", titleWidth = 450),
dashboardSidebar(sidebarMenu(
menuItem(
"Tab 1",
tabName = "tab 1",
icon = icon("medicine"),
menuItem("Cell Culture",
menuItem("Control Chart"))
)
)),
dashboardBody(mainPanel(fluidRow(htmlOutput("frame"))
),
))
server = function(input, output, session) {
observe({
test <<- paste0("https://google.com") #sample url
})
output$frame <- renderUI({
input$Member
my_test <- tags$iframe(src = test,
height = 800,
width = 800)
print(my_test)
my_test
})
}
shinyApp(ui, server)
You can define a blank tab as the first menuItem, and then you should be able to select the appropriate menuItem to display the desired objects. Also, you should define tabName to ensure that the appropriate objects are displayed and tie it to them in dashboardBody as shown below. Try this
ui <-
dashboardPage(
skin = "black",
dashboardHeader(title = "Dashboard ", titleWidth = 450),
dashboardSidebar(sidebarMenu(
menuItem("",tabName="home"),
menuItem(
"Tab 1",
tabName = "tab 1",
icon = icon("medicine"),
menuItem("Cell Culture",
menuItem("Control Chart", tabName = "mytab"))
)
)),
dashboardBody(mainPanel(
tabItems(
tabItem(tabName = "home"),
tabItem(tabName = "mytab",
fluidRow(plotOutput("plot1"), htmlOutput("frame"))
)
)
),
))
server = function(input, output, session) {
#observe({
# test <- paste0("https://google.com") #sample url
#})
output$plot1 <- renderPlot(plot(cars))
url <- a("Google Homepage", href="https://www.google.com/")
output$frame <- renderUI({
#input$Member
my_test <- tags$iframe(href = url,
height = 800,
width = 800)
print(my_test)
print("Hello!")
my_test
})
}
shinyApp(ui, server)
I´ve been looking for the solution to this but I do not find it
My issue is that I have a shiny dashboard that looks like this:
It is selecting all tabs even If I do not select them (like pre-rendered)
I tried making an observeEvent with a button but It do not know how to make the UI appear after they click it.
My code is
library(shiny)
library(shinydashboard)
gamestop <- tags$img(src = "GSLL.png",
height = '30', width = '170')
ui <- dashboardPage(skin = "yellow",
dashboardHeader(title = gamestop,
dropdownMenu(type = "tasks",
messageItem(
from = "My contact",
message = "x",
icon = icon("glyphicon glyphicon-envelope"),
href = "mailto:x"),
messageItem(
from = "Leads",
message = "y",
icon = icon("glyphicon glyphicon-envelope"),
href = "mailto:y"),
messageItem(
from = "",
message = "z",
icon = icon("glyphicon glyphicon-envelope"),
href = "mailto:z"),
icon = icon("envelope")
)
),
dashboardSidebar(
sidebarMenu(
menuItem("Main menu", tabName = "main_menu", icon = icon("home")),
menuItem("Peripherals", tabName = "peripherals", icon = icon("hdd")),
menuItem("Database repair", tabName = "widgets", icon = icon("th")),
menuItem("Polling", tabName = "polling", icon = icon("cloud")),
menuItem("more issues!!", tabName = "issues", icon = icon("ad"))
)
),
dashboardBody(tags$head(
tags$link(rel = "stylesheet", type = "text/css", href = "Custom.css")),
fluidPage(
tabItem(tabName = "peripherals",
h1("Peripherals",
style = "color:#15942B"),
tabsetPanel(type = "tabs",
tabPanel("Printers",br(),
tabsetPanel(type = "tabs",
tabPanel("M452DW",br(),
tabsetPanel(type = "tabs",
tabPanel("Not pinging"),
tabPanel("Error messages")
)
),
tabPanel("M402DW",br(),
tabsetPanel(type = "tabs",
tabPanel("Not pinging")
),
)
)
),
tabPanel("Pinpad",br(),
tabsetPanel(type = "tabs",
tabPanel("Offline / busy"),
tabPanel("Not turning on")
)
),
tabPanel("Scanners",br(),
tabsetPanel(type = "tabs",
tabPanel("GBT4400"),
tabPanel("DS2278")
)
),
tabPanel("Receipt printer / cashdrawer",br(),
tabsetPanel(type = "tabs",
tabPanel("Receipt printer"),
tabPanel("Cash drawer")
)
),
tabPanel("Label printer",br(),
tabsetPanel(type ="tabs",
tabPanel("ZD410"),
tabPanel("LP2824 & +")
),
)
)
), #Final tab peripherals
tabItem(tabName = "main_menu",
h1("Main menu",
style = "color:#15942B"),
strong("Here we can add the news of the day or a welcome image"),br(),
br(),
br(),
strong("This is a work in progress, to be presented to our team leads so we can make
it an aid page for all of us")
),
tabItem(tabName = "issues",
h1("More issue resolutions to come!!!!!",
style = "color:#15942B" ),
strong("My plan is to add the hardest issue resolutions for our team, so they can access this web page and
with a glipse they can resolve the issue in hand")
),
tabItem(tabName = "polling",
)
)
)
)
)
server <- function(input, output) {
observeEvent(input$tabs,
if(input$sidebarmenu == "Printers"){
})
}
shinyApp(ui, server)
I would like to know how to render the tab when the user clicks on the tab itself and not before
Thanks a lot!!!
If you want to render the tab when the user clicks on the tab, you need to observe the tabsetpanel and check if the tab is clicked.
library(shiny)
library(shinydashboard)
ui <- fluidPage(
tabItem(tabName = "peripherals",
h1("Peripherals",
style = "color:#15942B"),
tabsetPanel(id = "firsttabset",
type = "tabs",
tabPanel("Printers"),
tabPanel("Pinpad1",
h1("Dies ist tab \"Pinpad1\""),
textOutput("text")),
tabPanel("Scanners"),
tabPanel("Receipt printer / cashdrawer"),
tabPanel("Label printer")
)
)
)
server <- function(input, output) {
observeEvent(input$firsttabset, {
if(input$firsttabset == "Pinpad1") {
cat("tab \"Pinpad1\" is now being rendered \n")
output$text <- renderText({"tadaa"})
}
})
}
shinyApp(ui, server)
EDIT: If you want to apply this to nested tabsetpanels, I found a way by observing both tabsetpanel1 and tabsetpanel2 and checking in the conditions which tabs are selected. I suppose the first tab of tabsetpanel2, that is Scanners2 in this example, has to be rendered if you want to render the tab Pinpad1.
Check it out if it works for you. This logic can be extended to further nesting of tabsetpanels, but it will get complicated.
library(shiny)
library(shinydashboard)
ui <- fluidPage(
tabItem(tabName = "peripherals",
h1("Peripherals",
style = "color:#15942B"),
tabsetPanel(id = "firsttabset",
type = "tabs",
tabPanel("Printers"),
tabPanel("Pinpad1",
tabsetPanel(id = "secondtabset",
type = "tabs",
tabPanel("Scanners2",
h1("Dies ist tab \"Scanners2\"")),
tabPanel("Pinpad2",
h1("Dies ist tab \"Pinpad2\""),
textOutput("text2"))),
h1("Dies ist tab \"Pinpad1\""),
textOutput("text")),
tabPanel("Scanners"),
tabPanel("Receipt printer / cashdrawer"),
tabPanel("Label printer")
)
)
)
server <- function(input, output) {
observeEvent(c(input$firsttabset,
input$secondtabset), {
if(input$firsttabset == "Pinpad1" & input$secondtabset == "Scanners2") {
cat("tab \"Pinpad1\" is now being rendered \n")
output$text <- renderText({"tadaa"})
}
if (input$firsttabset == "Pinpad1" & input$secondtabset == "Pinpad2") {
cat("tab2 \"Pinpad2\" is now being rendered \n")
output$text2 <- renderText({"tadooo"})
}
})
}
shinyApp(ui, server)
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)
I am working on something where I need a floating button in shinydashboard. Below is a code to get a floating button using shinyMaterial package.
library(shiny)
library(shinymaterial)
# Wrap shinymaterial apps in material_page
ui <- material_page(title = "Basic Page",
tags$h1("Page Content"),
material_floating_button(
input_id = "example_floating_button",
icon = "live_help",
depth = 5,
color = "red lighten-3"
)
)
server <- function(input, output) {
}
shinyApp(ui = ui, server = server)
When I am trying to use the floating button from shinymaterial library in shinydashboard, it doesn't work. Any help is appreciated, all I want if a floating button on every page..using any library.
library(shiny)
library(shinydashboard)
library(dplyr)
library("shinymaterial")
ui <- dashboardPage(
dashboardHeader(dropdownMenuOutput("notificationMenu")),
dashboardSidebar(sidebarMenu(menuItem("Page 1", tabName = "page1"),
menuItem("Page 2", tabName = "page2"))),
dashboardBody(tabItems(
tabItem(tabName = "page1", h4("This is Page 1"),
material_floating_button(
input_id = "example_floating_button",
icon = "live_help",
depth = 5,
color = "red lighten-3"
)),
tabItem(tabName = "page2",
textInput("text", "Enter News:", "New News."),
actionButton("save", "Save"))
)))
server <- function(input, output, session){
raw_news <- reactiveValues()
# Intial Header News: 1 Message from Admin
raw_news$news <- data_frame(from = "Admin", text = "this is a message")
# The notifications in header
output$notificationMenu <- renderMenu({
raw_news <- raw_news$news
dropdownMenu(
messageItem(raw_news$from[1], raw_news$text[1])
)
})
# save a new notification
observeEvent(input$save, {
raw_news$news <- data.frame(from = "User", text = input$text)
})
}
shinyApp(ui = ui, server = server)
Just use an actionButton in a fixedPanel instead.
tabItem(tabName = "page1", h4("This is Page 1"),
fixedPanel(
actionButton("test", label = "test"),
right = 10,
bottom = 10
)
),
I am trying to add a home button in the header of my Shiny app so that whenever anyone clicks it from any tab, it will redirect to the first page. Currently I am using one actionButton in every tab with observeEvent to go back to first page.
I am not able to add any actionButton in the header section of Shiny app. Is there any way around for this feature?
It is something like this:
Sample Shiny Look
Reproducible Code:
library(shiny)
library(shinydashboard)
library(shinyjs)
options(shiny.maxRequestSize=1000*1024^2)
app <- shinyApp(
a <- dashboardPage(
dashboardHeader(title = "Sample Shiny", titleWidth=1450),
dashboardSidebar(sidebarMenu(id='tabs',
menuItem("Welcome", tabName = "welcome"),
menuItem("Tab1", tabName = "tab1"),
menuItem("Tab2",
menuSubItem("Tab2_1", tabName = "tab2_1"),
menuSubItem("Tab2_2", tabName = "tab2_2"))
)
),
dashboardBody( shinyjs::useShinyjs(),
tabItems(
tabItem(tabName="welcome", tabPanel(title = "Score",fluidRow(valueBoxOutput("box_01"),valueBoxOutput("box_02")))),
# First tab content
tabItem(tabName = "tab1",actionButton("homeButton1", "Home")),
# Second tab content
tabItem(tabName = "tab2_1",tabsetPanel(id = "test",tabPanel(title = "tab2_1",actionButton("homeButton2", "Home"),actionButton("NextButton2", "Tab3")))),
tabItem(tabName = "tab2_2",tabsetPanel(id = "outputTabset",tabPanel(title = "Tab 3",actionButton("homeButton3", "Home"))))
)
)),
b<-shinyServer(function(input, output, session) {
##########Links from first page
output$box_01 <- renderValueBox({
box1<-valueBox(value=01,
icon = icon("database",lib="font-awesome")
,width=NULL
,color = "blue"
,href="#"
,subtitle=HTML("<b>Tab 1</b>")
)
box1$children[[1]]$attribs$class<-"action-button"
box1$children[[1]]$attribs$id<-"button_box_01"
return(box1)
})
output$box_02 <- renderValueBox({
box2<-valueBox(value=02,
icon = icon("user-secret",lib="font-awesome")
,width=NULL
,color = "yellow"
,href="#"
,subtitle=HTML("<b>Tab 2</b>")
)
box2$children[[1]]$attribs$class<-"action-button"
box2$children[[1]]$attribs$id<-"button_box_02"
return(box2)
})
observeEvent(input$button_box_01,{
if(input$button_box_01[1]>0){
newtab <- switch(input$tabs,
"welcome" = "tab1",
"tab1" = "welcome"
)
updateTabItems(session, "tabs", newtab)
} })
observeEvent(input$button_box_02,{
if(input$button_box_02[1]>0){
newtab <- switch(input$tabs,
"welcome" = "tab2_1",
"tab2_1" = "welcome"
)
updateTabItems(session, "tabs", newtab)
} })
### HomeButtons
observeEvent(input$homeButton1,{
newtab <- switch(input$tabs,
"welcome" = "tab1",
"tab1" = "welcome"
)
updateTabItems(session, "tabs", newtab)
})
observeEvent(input$homeButton2,{
newtab <- switch(input$tabs,
"welcome" = "tab2_1",
"tab2_1" = "welcome"
)
updateTabItems(session, "tabs", newtab)
})
observeEvent(input$NextButton2,{
newtab <- switch(input$tabs,
"tab2_2" = "tab2_1",
"tab2_1" = "tab2_2"
)
updateTabItems(session, "tabs", newtab)
})
observeEvent(input$homeButton3,{
newtab <- switch(input$tabs,
"welcome" = "tab2_2",
"tab2_2" = "welcome"
)
updateTabItems(session, "tabs", newtab)
})
#######SideBar Disable
addClass(selector = "body", class = "sidebar-collapse")
})
)
shiny::runApp(app,launch.browser=TRUE,host="0.0.0.0",port=6105)
See the following solution. You need to style the position with CSS, still. Key is to put the actionButton into the header with tags$li(class = "dropdown", ...), otherwise dashboardHeader will not accept it:
ui <- dashboardPage(
dashboardHeader(title = "Demo", tags$li(class = "dropdown", actionButton("home", "Home"))),
dashboardSidebar(sidebarMenu(id = "sidebar", # id important for updateTabItems
menuItem("Home", tabName = "home", icon = icon("house")),
menuItem("Tab1", tabName = "tab1", icon = icon("table")),
menuItem("Tab2", tabName = "tab2", icon = icon("line-chart")),
menuItem("Tab3", tabName = "tab3", icon = icon("line-chart")))
),
dashboardBody(
tabItems(
tabItem("home", "This is the home tab"),
tabItem("tab1", "This is Tab1"),
tabItem("tab2", "This is Tab2"),
tabItem("tab3", "This is Tab3")
))
)
server = function(input, output, session){
observeEvent(input$home, {
updateTabItems(session, "sidebar", "home")
})
}
shinyApp(ui, server)
Here's an option using javascript and a home icon which fits into the header nicely:
dashboardHeader(title = "Your Title",
tags$li(a(onclick = "openTab('home')",
href = NULL,
icon("home"),
title = "Homepage",
style = "cursor: pointer;"),
class = "dropdown",
tags$script(HTML("
var openTab = function(tabName){
$('a', $('.sidebar')).each(function() {
if(this.getAttribute('data-value') == tabName) {
this.click()
};
});
}")))
)
Change home in the openTab('home') part to whatever your home tab is called and it will switch to that tab when clicked.