Cannot hide tab-number appearing below navigation panel of my shiny app - r

For the shiny app, I changed the Titlepanel settings to create a favicon and window title. However, now I get a number appearing right below the navigation panel.
Here is the code for the UI:
ui <- navbarPage(titlePanel(windowTitle = "Name",
title = tags$head(tags$link(rel = "shortcut icon",
href = "images/image.png",
type="images/image-icon"))),
title = "Name",
selected = "home",
theme = shinytheme("readable"),
fluid = TRUE)
Here is the output
While I do see my favicon and window title, I cannot hide this tab number. What is the way to do this?

Related

Shiny Title image seems unformatted

I was working on a Shiny application, and instead of a title, I wanted to use an image. While the code did not raise any errors and shows the designated area for the image, the image doesn't show up.
Here is the code:
# header UI
ui <- navbarPage(title = div(img(src="/Users/atillacolak/Desktop/tafn_logo.png",
height = 60,
style = "margin-top: -14px; padding-right:10px;padding-bottom:10px")),
selected = "home",
theme = bs_theme(
bg = "white",
fg = "#ed7117",
base_font = font_google("Prompt"),
code_font = font_google("JetBrains Mono")),
fluid = TRUE,
home)
The result of this code is given in the image below.
As you can see the image does not format. What is the problem here?
You need to make the image available as a static resource to shiny's webserver.
Either you put the image in a www folder (subdirctory of your app folder) and set src = "/tafn_logo.png" or you use addResourcePath:
addResourcePath(prefix = "Desktop", directoryPath = "/Users/atillacolak/Desktop")
src using prefix:
img(src="Desktop/tafn_logo.png",
height = 60,
style = "margin-top: -14px; padding-right:10px;padding-bottom:10px")
See my related answer here.

shinydashboard - Sidebar toggle button doesn't work after update

After updating packages to the newest versions, sidebar toggle button has disappeared. It's not displayed properly (there should be 3 horizontal bars) and it doesn't work - clicking it doesn't make any action.
Previously it looked like this:
Here's the code:
shinydashboardPlus::dashboardPage(
skin = "midnight",
header = shinydashboard::dashboardHeader(
title = shiny::h3(id = "h3-main-title", "My Shiny App")
),
# __________________________________________________________________________
# Sidebar ####
sidebar = shinydashboard::dashboardSidebar(
shinydashboard::sidebarMenu(
id = "sidebar_menu",
# ______________________________________________________________________
# Home ####
shinydashboard::menuItem(
"Home",
tabName = "HOME",
icon = shiny::icon("home")
),
# rest of the code
)
)
)
Packages versions:
shiny: 1.6.0
shinydashboard: 0.7.1
shinydashboardPus: 2.0.0
During the change I've updated a lot of packages, could it be that one of them interferes with toggle button even though it isn't explicitly used in the code above?

Shiny R: Language button in dashboard header

What is the best way to create in the header of a shiny dashboard a button where you can choose languages to appear on the app page(English, French, Spanish...)? What I want is a kind of a dropdown button like this(https://www.conversationexchange.com/resources/keyboard-language.php?lg=en). I want to add a flag icon as well next to each language choice.
Any solution or tips would be appreciated!
What I tried:
dropdownMenu
It works but it's only useful either for "messages", "notifications" or "tasks". I was able to customise none of them to match my purpose.
navbarMenu
This is exactly what I want but can be used only in navbar. I tried putting this to the header but didn't work.
I assume that you are using shinydashboard, then you can do:
dashboardHeader(
title = "MY TITLE",
tags$li(class = "dropdown",
radioButtons(inputId = "language",
label = "",
choices = c("日文" = "cn", "English" = "en"),
selected = "jp")
)
)

R Shiny Dashboard - Custom Dropdown Menu In Header

From the shiny dashboard github, I've gathered that it's possible to create drop down menus at the top right of the header, but there are only 3 "types" (messages, notifications, and tasks).
https://rstudio.github.io/shinydashboard/structure.html#structure-overview
Is there a method for creating a custom dropdown? I'd like to make a settings dropdown, where I give the user some checkboxes that they can use to adjust the dashboard in ways (displaying/hiding things, filtering data, etc.)
I customized one of the three types of menu to allow this. You could then add actionItem(s) for items. tabSelect property when true simulate the selection of a sidebarMenuItem.
dropdownActionMenu <- function (..., title=NULL, icon = NULL, .list = NULL, header=NULL) {
items <- c(list(...), .list)
lapply(items, shinydashboard:::tagAssert, type = "li")
type <- "notifications" # TODO créer action + CSS
dropdownClass <- paste0("dropdown ", type, "-menu")
tags$li(class = dropdownClass, a(href = "#", class = "dropdown-toggle",
`data-toggle` = "dropdown", icon, title), tags$ul(class = "dropdown-menu",
if(!is.null(header)) tags$li(class="header",header),
tags$li(tags$ul(class = "menu", items))))
}
actionItem = function (inputId, text, icon = NULL, tabSelect=FALSE) {
if(!is.null(icon)) {
shinydashboard:::tagAssert(icon, type = "i")
icon <- tagAppendAttributes(icon, class = paste0("text-", "success"))
}
if(tabSelect) {
tags$li(a(onclick=paste0("shinyjs.tabSelect('",inputId,"')"),icon,text))
} else {
tags$li(actionLink(inputId,text,icon))
}
}
javascript function to select tab (to be inserted after useShinyjs() in body)
extendShinyjs(text="shinyjs.tabSelect=function(tabName){$('a[data-value='+tabName+']').click();}")
Sample code
dashboardHeader(
dropdownActionMenu(title="test",
actionItem("mnuFirst","First"),
actionItem("mnuSecond","Second")
)
)
Shiny Dashboard is based on admin LTE. So the existing type of drop downs are designed for admin LTE use case, which is quite different from many Shiny app usage.
If something is not even available in admin LTE, it's less likely to be supported in Shiny dashboard.
For your specific question, you can put some controls in the side bar. Another possibility is to use the wrench icon in box, which is not implemented in Shiny yet.

Direct link to tabItem with R shiny dashboard

I am using the shiny dashboard template to generate my web UI.
I'd like to dynamically generate an infobox when a computation is completed with a link directed to one of the tabItems in dashboardBody.
For example,
I can put this in my tabItem1 output,
renderInfoBox({
infoBox("Completed",
a("Computation Completed", href="#tabItem2"),
icon = icon("thumbs-o-up"), color = "green"
)
})
But the problem is that when I click the link, it does nothing. I would like it jumps to tabItem2. The link href seems valid when I hover on it.
Thanks!
Update:
Other than using Javascripts, looks like using actionLink and updateTabItems functions in shinydashboard package will work as well.
I apologize for the lengthy code sample, but I had to copy an example with tabItems from the shinydashboard homepage.
Your approach has only few problems. First, if you would inspect the menuItems, you'd see that the actual tab's id is not tabItem2, but shiny-tab-tabItem2. This, plus the extra attribute data-toggle="tab" within the a tag would suffice to open the desired tab. Snippet:
a("Computation Completed", href="#shiny-tab-tabItem2", "data-toggle" = "tab")
But, this has its limits. First and most obvious, the state of the menuItem in the sidebar is not set to active. This looks very odd and one might not be convinced, that one has been moved to another tab.
Second, and less obvious, if you listen to tab changes (on the server side), you will not get information about this tab switch. Those are triggered by the menuItem being clicked, and the tab itself will not report if it is visible or hidden.
So, my approach will be to simulate that the corresponding menuItem is clicked, and thus, all the above problems are solved.
Code example:
library(shiny)
library(shinydashboard)
ui <- shinyUI(
dashboardPage(
dashboardHeader(title = "Some Header"),
dashboardSidebar(
sidebarMenu(
menuItem("Computations", tabName = "tabItem1", icon = icon("dashboard")),
menuItem("Results", tabName = "tabItem2", icon = icon("th"))
)
),
dashboardBody(
tags$script(HTML("
var openTab = function(tabName){
$('a', $('.sidebar')).each(function() {
if(this.getAttribute('data-value') == tabName) {
this.click()
};
});
}
")),
tabItems(
tabItem(tabName = "tabItem1",
fluidRow(
box(plotOutput("plot1", height = 250)),
box(
title = "Controls",
sliderInput("slider", "Number of observations:", 1, 100, 50)
)
),
infoBoxOutput("out1")
),
tabItem(tabName = "tabItem2",
h2("Widgets tab content")
)
)
)
)
)
server <- function(input, output){
histdata <- rnorm(500)
output$plot1 <- renderPlot({
data <- histdata[seq_len(input$slider)]
hist(data)
})
output$out1 <- renderInfoBox({
infoBox("Completed",
a("Computation Completed", onclick = "openTab('tabItem2')", href="#"),
icon = icon("thumbs-o-up"), color = "green"
)
})
}
shinyApp(ui, server)
Note, that the only important thing is the onclick property, not an href. This means, that every div or other element can be used to create this link. You could even have just the thumbs-up image with this onclick command.
If you have more questions, please comment.
Best Regards
Edit: Whole infoBox clickable.
This is an answer to a comment by OmaymaS. The point was to make the infoBox a clickable container. To achieve this, one can define a new function that makes a somewhat different infoBox. The custom box will be as follows:
customInfoBox <- function (title, tab = NULL, value = NULL, subtitle = NULL, icon = shiny::icon("bar-chart"), color = "aqua", width = 4, href = NULL, fill = FALSE) {
validateColor(color)
tagAssert(icon, type = "i")
colorClass <- paste0("bg-", color)
boxContent <- div(class = "info-box", class = if (fill) colorClass,
onclick = if(!is.null(tab)) paste0("$('.sidebar a')).filter(function() { return ($(this).attr('data-value') == ", tab, ")}).click()"),
span(class = "info-box-icon", class = if (!fill) colorClass, icon),
div(class = "info-box-content",
span(class = "info-box-text", title),
if (!is.null(value)) span(class = "info-box-number", value),
if (!is.null(subtitle)) p(subtitle)
)
)
if (!is.null(href)) boxContent <- a(href = href, boxContent)
div(class = if (!is.null(width)) paste0("col-sm-", width), boxContent)
}
This code is copied from the original infoBox function definition and only the line with onclick is new. I also added the openTab function (with some twitches) right inside the container such that you dont need to worry where to put this function inside the view. Might be a bit overloaded i feel.
This custom info box can be used exactly like the default one and if you pass the additional tab argument, the link to the sidebar is added.
Edit: Subtitle exploit
As Alex Dometrius mentioned, the use of subtitle crashes this functionality. This is because the script tag that was inserted, on accident, was used as the subtitle argument in order to be rendered with the box. To free up this spot, I edited the main example up top such that the script tag is sitting top level in the dashboardBody (literally anywhere in the ui would be fine).
(To avoid confusion: in Version 1, the tags$script was supplied inside of infobox where it was interpreted as the subtitle parameter.)

Resources