I am trying to add an external URL in a shiny dashboard that uses the package bs4Dash but when I click in it their is no response. I have something similar to the example below. It does not work using newTab = FALSE or newTab = TRUE. Am I missing something or this is the way it is supposed to behave?
# NOT RUN {
## Only run this example in interactive R sessions
if (interactive()) {
library(shiny)
library(bs4Dash)
# A dashboard header with 3 dropdown menus
header <- dashboardHeader(
title = "My dashboard"
)
sidebar <- dashboardSidebar(
sidebarMenu(
menuItem("My menu L1", href = "https://rinterface.github.io/bs4Dash/", newTab = FALSE),
menuItem("My menu L2",
menuSubItem("My submenu 1", href = "https://rinterface.github.io/bs4Dash/", newTab = TRUE)
)
)
)
shinyApp(
ui = dashboardPage(
header,
sidebar,
dashboardBody()
),
server = function(input, output) { }
)
}
# }
#Dwight, I "solved" this issue via a hack. Basically, I started using the shinydashboard::menuItem for those particular instances. I think the author fix this and hopefully will be available in the next version (https://github.com/RinteRface/bs4Dash/issues/225).
shinydashboard::menuItem(
text = "Help",
href = "http://example.com"
)
Related
What is the parameter to control the right side bar on a Shiny bs4Dash dashboard. My reading of the dashboardControlbar function at https://rinterface.github.io/bs4Dash/articles/step-by-step.html, which I understand to be the sidebar to the right of the page, is to set disable = T, in a similar way to how the dashboardSidebar(disable = T) controls the appearance sidebar to the left.
I have set controlbar = dashboardControlbar(disable = T) however on the Shiny App below and the right sidebar still opens when pressing the button at the top. Thanks for any suggestions in advance.
Edit (in response to dashboardHeader comment ):
This question is in reference to bs4Dash V2.0.0 available via github.
https://github.com/RinteRface/bs4Dash
Please note that the github page also recommends github versions of htmltools and shiny.
library(shiny)
library(bs4Dash)
ui = dashboardPage(
header = dashboardHeader(),
sidebar = dashboardSidebar(
disable = T
),
body = dashboardBody(),
controlbar = dashboardControlbar(
disable = T
),
title = ""
)
server <- function(input, output, session) {}
shinyApp(ui, server)
You can remove controlbar argument to disable it.
library(shiny)
library(bs4Dash)
ui = dashboardPage(
header = dashboardHeader(),
sidebar = dashboardSidebar(
disable = T
),
body = dashboardBody(),
title = ""
)
server <- function(input, output, session) {}
shinyApp(ui, server)
For the dropdownMenu in the header, I want to change the icon reactively, so I have to place the code into server. However the styling goes bonkers, is there a way to keep the original styling? I've tried manually copying styles and setting everything important but it still doesn't work.
In this example, there are two dropdownMenu blocks, one in the ui (looks good) and one in the server (looks bad). I want to make the bad one look the same as the good one.
library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
shinyApp(
ui = dashboardPagePlus(
header = dashboardHeaderPlus(
uiOutput("my_dropdown"),
dropdownMenu(
type = "tasks",
badgeStatus = "danger",
icon = "Looks good"
)
),
sidebar = dashboardSidebar(),
body = dashboardBody(),
rightsidebar = rightSidebar()
),
server = function(input, output) {
output$my_dropdown <- renderUI({
dropdownMenu(
type = "tasks",
badgeStatus = "danger",
icon = "Looks bad"
)
})
}
)
This is what it looks like
This is what it should look like
I was trying to add website information on my shiny dashboard and for the "About" section (See image) I want few lines to be displayed on the dashboard body when clicked on that tab. how could i possibly achieve it? I could successfully add href for the "contact" section.
Maybe I do not understand your question properly, but what about:
library(shiny)
library(shinydashboard)
header <- dashboardHeader()
sidebar <- dashboardSidebar(
sidebarMenu(
id = "tabs",
menuItem("About", icon = icon("info"), tabName = "about"),
menuItem("Contact", icon = icon("phone"), tabName = "contact")
)
)
)
body <- dashboardBody(
tabItems(
tabItem("about",
h1("About")),
tabItem("contact",
h1("Contact"))
)
)
shinyApp(
ui = dashboardPage(header, sidebar, body),
server = function(input, output) { }
)
When you click on About you get a new tab in the dashboardBody where you can display whatever you want.
Update
Based on your clarification you can use shinyjs to hide/show the relevant part:
library(shiny)
library(shinydashboard)
library(shinyjs)
header <- dashboardHeader()
sidebar <- dashboardSidebar(
sidebarMenu(
id = "tabs",
menuItem("About", icon = icon("info"), tabName = "about"),
menuItem("Contact", icon = icon("phone"), tabName = "contact")
)
)
)
body <- dashboardBody(
useShinyjs(),
fluidPage(
fluidRow(id = "mainContent",
column(12, h1("Main Content"))
),
hidden(fluidRow(id = "contact", h1("Contact Info")))
)
)
shinyApp(
ui = dashboardPage(header, sidebar, body),
server = function(input, output) {
observe({
if (input$tabs == "contact") {
hideElement("mainContent")
showElement("contact")
} else {
hideElement("contact")
showElement("mainContent")
}
})
}
)
When you now click on Contact the main part is hidden and the contact is shown. I have, however, the feeling that is a bit mis-using the idea of shinydashboard.
#thothal, it did not allow me to add as a comment coz of the length, hence posting my comment(below) as an answer.
I am sorry if I was unclear. However, your answer helped me partially. I have incorporated tabItems part in my dashboardBody section, as shown below:
dashboardBody(
fluidPage(
fluidRow(
column(12, div(dataTableOutput("dataTable")))
)
),
tabItems(
tabItem("About", h1("text to be displayed"))
)
)
but the "text to be displayed" shows up below the table.
What I want is, About section (when clicked) should display only the text and not the table. I understand this is just formatting of the code in dashboardBody section but I don't know how to do it.
Just to be more clear, my dashboard's section should display the datatable at all times and the about section when clicked should show up the text and not the datatable. I really hope this is clear. Thanks a ton for your help :)
I have an issue while creating a shiny web app using semantic.dashboard library.
Below is the code for my app.
library(semantic.dashboard)
# Define UI
header <- dashboardHeader(
)
sidebar <- dashboardSidebar(
side = "left",
sidebarMenu(
menuItem(tabName = "overview", text = "Overview", icon = icon("home")),
menuItem(tabName = "analysis", text = "Analysis", icon = icon("chart bar"))
)
)
body <- dashboardBody(
dateRangeInput("datepicker", NULL, start = Sys.Date()-30, end = Sys.Date()-1)
)
tabItems(
tabItem(
tabName = "overview",
fluidRow(
)
),
tabItem(
tabName = "analysis",
fluidRow(
)
)
)
ui <- dashboardPage(
header,
sidebar,
body,
title = "My Dashboard",
theme = "lumen"
)
# Define server logic
server <- function(input, output, session) {
session$onSessionEnded(stopApp)
}
# Run the application
shinyApp(ui = ui, server = server)
The result is in the screenshot below:
The main problem is that the dates inside the daterangeinput widget are just like simple text inside textbox.
I can't click on them to change the dates.
Using fluidPage() would resolve the problem, but the whole web page isn't filled totally by the app (and for this app, responsiveness isn't really useful).
Below is the screenshot of the app when I use fluidPage(), you can see that there's so much space between the sidebar and the border, and beetween the sidebar and the body.
app with fluidPage()
I'd like to know if it's possible to use daterangeinput without using fluidPage() or, if not possible, know how to remove the padding between the border and the sidebar when using fluidPage.
Thanks in advance for your help.
Above example doesn't work because it uses bootstrap framework styles - contrary to shiny.semantic or semantic.dashboard packages.
Please check my PR to shiny.semantic package. I've implemented there simple date input with usage of semantic-ui components. You can also use it to create simple date range (added quick example in PR).
I'm putting the finishing touches on a shinydashboard. The dashboard uses googleAuthR for authentication via google oauth. Everything is working... but I currently have to put the login button in either the dashboardSidebar or dashboardBody, and I'd really really like it up where the dropdowns go in dashboardHeader. Unfortunately, it seems like shinydashboard's header is picky about what can go up in the header. Is there a hack (or less than a hack) to put stuff up there?
Here's a thing that definitely doesn't work, for example:
ui = dashboardPage(
dashboardHeader(
title = "My Awesome Dashboard"
, p('Pretend this is a login button')
)
, dashboardSidebar(
p('I don't want the login here.')
)
, dashboardBody(
p('I don't want the login here either.')
)
)
server = function(input, output, session) {
}
shinyApp(
ui = ui
, server = server
)
You can place anything in the header, but it needs to be a li tag of class dropdown. See the following example:
ui = dashboardPage(
dashboardHeader(
title = "My Awesome Dashboard",
tags$li(class = "dropdown",
tags$li(class = "dropdown", textOutput("logged_user"), style = "padding-top: 15px; padding-bottom: 15px; color: #fff;"),
tags$li(class = "dropdown", actionLink("login", textOutput("logintext"))))
)
, dashboardSidebar(), dashboardBody())
server = function(input, output, session) {
logged_in <- reactiveVal(FALSE)
# switch value of logged_in variable to TRUE after login succeeded
observeEvent(input$login, {
logged_in(ifelse(logged_in(), FALSE, TRUE))
})
# show "Login" or "Logout" depending on whether logged out or in
output$logintext <- renderText({
if(logged_in()) return("Logout here.")
return("Login here")
})
# show text of logged in user
output$logged_user <- renderText({
if(logged_in()) return("User 1 is logged in.")
return("")
})
}
shinyApp(ui = ui, server = server)
Ok, I think I figured it out based on Adding a company Logo to ShinyDashboard header , but I'm not sure yet why it works. Here's the general idea:
my_header = dashboardHeader(
title = "My More Awesome Dashboard"
)
my_header$children[[3]]$children[[3]] = p('Login goes here', style = 'float: right')
ui = dashboardPage(db_header, dashboardSidebar, dashboardBody)
Now to see if I can find documentation somewhere explaining the $children stuff...