Shiny: adding addPopover to actionLink - r

I want to include a small "Help" actionLink (next to a "Render" actionButton) that acts as a popover (see here). Here's my code:
server.R:
shinyUI(pageWithSidebar(
sidebarPanel(
actionButton("renderButton", "Render"),
actionLink("link", "Help") ),
mainPanel()
))
ui.R:
shinyServer(function(input, output, session) {
# ... dealing with renderButton ...
output$link <- renderUI({
addPopover(session=session, id=output$link, title="",
content="Testing.", placement = "bottom",
trigger = "click", options = NULL)
})
})
Right now, the actionLink shows up on the sidebar, but clicking on it has no effect. Any tips? I think it may have to do with the id in addPopover, but I haven't found many examples to provide a framework. I found this, but I want to deal with the popover in server.R, not ui.R. Can it be done this way, or should I just make the popover in ui.R?

From ?Tooltips_and_Popovers:
There must be at least one shinyBS component in the UI of your app in
order for the necessary dependencies to be loaded. Because of this,
addTooltip and addPopover will not work if they are the only shinyBS
components in your app.
To get the pop over to work, you can change your actionButton into a bsButton, and modify server.R to only contain the call to addPopover. The id argument to addPopover also needs to be changed to refer to the id of the ui object you want the pop over to appear on, in your case "link", the id of the actionLink .
Here's the modified example code in a self-contained code chunk:
library(shiny)
library(shinyBS)
runApp(
# Ui
list(ui = pageWithSidebar(
headerPanel("Test App"),
sidebarPanel(
bsButton("renderButton", "Render"),
actionLink("link", "Help") ),
mainPanel("Hello World!")
),
# Server
server = function(input, output, session) {
# ... dealing with renderButton ...
addPopover(session=session, id="link", title="",
content="Testing.", placement = "bottom",
trigger = "click", options = NULL)
})
)

Related

Login to single tabPanel in Shiny

I have been trying to make a login for a single tabPanel in Shiny. I have used the shinyAlert method, (as described here: How to access Shiny tab ids for use with shinyalerts?) which works, but unfortunately, it shows parts of the tabPanel's content before the user is logged in.
Is there a way to change this? I am trying to figure out how to make the "backdrop" of the shinyAlert just a white page until the user is successfully logged in. I read that this might be possible with CSS, but it is unclear to me how.
Or is there another method to do this, that I haven't considered? I am pretty new to Shiny.
Edit: the relevant parts of the code.
ui <- fluidPage(navbarPage("Eksempel", theme = shinytheme("cerulean"),
tabPanel("Home", icon = icon("home"),
fluidRow(
box(
Title = "Welcome to the example layout",
width = 10,
solidHeader = TRUE,
"Welcome text")
)),
tabPanel("Prototype", icon = ("chart-line"),
fluidPage(tagList(
textInput("user", "User:"),
passwordInput("password", "Password:"),
uiOutput("secrets"))),
# other tabPanels
server <- function(input, output, session){
output$secrets <- renderUI({
req(input$user == "admin", input$password == "shiny")
fluidPage( #contents of tabPanel, containing different plots ect.
)
})
The contents of the fluidPage I am trying to hide works fine when I don't try to hide it.
You can use req in combination with a renderUI and uiOutput to hide stuff until someone authenticates.
library(shiny)
ui <- fluidPage(
tagList(
textInput("user", "User:"),
passwordInput("password", "Password:"),
uiOutput("secrets")
)
)
server <- function(input, output) {
output$secrets <- renderUI({
req(input$user == "admin", input$password == "stackoverflow")
wellPanel("Hello admin! These are the secrets!")
})
}
shinyApp(ui = ui, server = server)
If you want a more enterprise-ready approach, you can try ShinyProxy or Shiny-Server Pro.

Add Tooltip to navbarMenu in Shiny

I would like to add a tooltip for navbarMenu in Shiny app. Similar question asked here but, there is no answer.Here is my reproducible code
library(shiny)
library(shinyBS)
ui <- shinyUI(fluidPage(
sidebarLayout(
sidebarPanel(),
mainPanel(tabsetPanel(
navbarMenu("Tab1",bsTooltip(id="Tab1", title="Short description for the tab", trigger = "hover"),
tabPanel("Tab1.1"),
tabPanel("Tab1.2")),
tabPanel("Tab2",tabsetPanel(
tabPanel("Tab2.1"),
tabPanel("Tab2.2"))),
tabPanel("Tab3",tabsetPanel(
tabPanel("Tab3.1"),
tabPanel("Tab3.2"),
tabPanel("Tab3.3")))
)))))
server <- function(input, output) {}
shinyApp(ui = ui, server = server)
During my research I found this solution R Shiny: Use navbarPage with bsModal by shinyBS, but for bsModel.
Also, there is a procedure mentioned here which is based in java-script.I know both solutions are for tabpanel but I believe it's the same problem, which is navbarMenu and tabpanel don't have an id.
I'm statistician and I don't have background in HTML or java-script to rewrite the attribute for the tab title or navbarMenu.
I hope I phrase my question in a clear manner. Thanks in advance for your time and kind help.
you can use HTML wenn passing the Title of the Tabs. in this case I just pt the title in a span and added the attribute titlewhich is the attribute HTML uses default for mouse-overs. For me this is much sinpler the trying to add it over shinyBS.
library(shiny)
library(shinyBS)
ui <- shinyUI(fluidPage(
sidebarLayout(
sidebarPanel(),
mainPanel(tabsetPanel(
navbarMenu(span("Tab1",title="Short description for the tab" ),
tabPanel("Tab1.1"),
tabPanel("Tab1.2")),
tabPanel("Tab2",tabsetPanel(
tabPanel("Tab2.1"),
tabPanel("Tab2.2"))),
tabPanel("Tab3",tabsetPanel(
tabPanel("Tab3.1"),
tabPanel("Tab3.2"),
tabPanel("Tab3.3")))
)))))
server <- function(input, output) {}
shinyApp(ui = ui, server = server)
hope this helps!
I found another solution using javascript. Perhaps it may be more useful.
library(shiny)
shinyApp(
ui = navbarPage(
tags$script(HTML('
$( document ).on("shiny:sessioninitialized", function(event) {
$(\'span[data-toggle="tooltip"]\').tooltip({
html: true
});
});'
)),
navbarMenu(
"Menu"
,tabPanel(span("navbarTitle 1",title="XXX",`data-toggle`="tooltip"),
tabsetPanel(
tabPanel(span("Tab 1", title = "aaa",`data-toggle`="tooltip")),
tabPanel(span("Tab 2",title="bbb",`data-toggle`="tooltip")),
tabPanel(span("Tab 3",title="ccc",`data-toggle`="tooltip"))
)
)
,tabPanel( "navbarTitle 2")
)
),
server = function(input, output) {
}
)

How to hide navbarMenus with shinyjs?

This question delas with the combination of navbarMenus and the shinyjs package. I've build a shiny app and I also added an user-login following this suggestion: https://gist.github.com/withr/9001831.
So I know, which user is logged in. Now I'd like to show and hide both a whole navbarMenu and single tabPanels, depending on which user is logged in. Let's say, there are two users, 'admin' and 'custom', and for 'admin' all navbarMenus and all tabPanels should be shown, while 'custom' only gets navbarMenu 2 and within this menu only tabPanel 22 to see.
library(shiny)
library(shinyjs)
# Define UI
ui <-
fluidPage(
titlePanel("NAVBARPAGE"), # title
br(),
################### NAVBAR ############################
navbarPage(
"", # title
################### TABS THEMA #######################
hidden(div(id='m1',
navbarMenu("Menu1",
tabPanel('tab11',plotOutput('tab_11')),
tabPanel('tab12',uiOutput('tab_12'))))),
navbarMenu("Menu2",
tabPanel('tab21',uiOutput('tab_21')),
hidden(div(id='xxx',tabPanel('tab22',uiOutput('tab_22')))))
#######################################################
))
###### SERVER #####
server <- function(input, output,session) {
#Define user
user<-'admin'
observe({
if (user=='admin') {
show('xxx')
show('m1')
}
else {
hide('xxx')
hide(m1)
}
})
# Run the application
shinyApp(ui = ui, server = server)
In this minimal example, the tabPanel ('tab22') is hidden, but is does not show up, when I define
user<-'custom'
Plus, the appearance of the first navbarMenu 'm1' is strange - it is actually not hidden, it is only only empty.
Does anyone know help?
Your code has some errors, missing } at the end of your server function, calling the hide funciton with m1 instead of "m1", and not initialize shinyjs with shinyjs::useShinyjs(). In addition, you can not use a div around navbarMenu or tabPanel, they will not be rendered. Lastly, it would be very easy for any user to show/hide the content.
A better option is to create the navbar according to the user using a uiOutput and control what to render using the user name. Below is an example based on your code to show content based on the users.
library(shiny)
library(shinyjs)
ui <- fluidPage(
selectInput("userSL", 'Users:', c('admin', 'custom')),
titlePanel("NAVBARPAGE"),
br(),
uiOutput("navbarPageUI")
)
server <- function(input, output,session) {
output$navbarPageUI <- renderUI({
user <- input$userSL
if (user == 'admin') {
navbarPage("",
navbarMenu("Menu1",
tabPanel('tab11',plotOutput('tab_11')),
tabPanel('tab12',uiOutput('tab_12'))
),
navbarMenu("Menu2",
tabPanel('tab21',uiOutput('tab_21')),
tabPanel('tab22',uiOutput('tab_22'))
)
)
} else {
navbarPage("",
navbarMenu("Menu2",
tabPanel('tab21',uiOutput('tab_21'))
)
)
}
})
}
shinyApp(ui = ui, server = server)

R Shiny: Present a ShinyBS Modal Popup on page visit (no user action)

I used bsModal successfully in my code before. However, I can't seem to get a modal pop up to show just when the user visits an app's first page by default. I thought something like this would work, but not. Any idea how I can trigger a bsModal on page visit?
library(shiny)
library(shinyBS)
ui <- fluidPage(
mainPanel(
bsModal(id = 'startupModal', title = 'Dum Dum', trigger = '',
size = 'large', p("here is my mumbo jumbo")),
width = 12
)
)
server <- function(input, output, session) {
}
shinyApp(ui = ui, server = server)
I simply need to alert the user with a message when they visit the app and then allow them to close the modal pop up and navigate the rest of the app freely. I am using Shinydashboard. So, eventually, this has to work with that.
You can use toggleModal to manually trigger the popup from the server.
library(shiny)
library(shinyBS)
ui <- fluidPage(
mainPanel(
bsModal(id = 'startupModal', title = 'Dum Dum', trigger = '',
size = 'large', p("here is my mumbo jumbo")),
width = 12
)
)
server <- function(input, output, session) {
toggleModal(session, "startupModal", toggle = "open")
}
shinyApp(ui = ui, server = server)
Here is a solution using JS to trigger bsModal when page load "onload" from ui without waiting for the server. Along with a solution proposed here to prevent end users from accidentally closing the modal by clicking outside the modal or press Esc
library(shiny)
library(shinyBS)
bsModalNoClose <-function(...) {
b = bsModal(...)
b[[2]]$`data-backdrop` = "static"
b[[2]]$`data-keyboard` = "false"
return(b)
}
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
bsModalNoClose("window", "Window",
title="Enter Login Details",size='small',
textInput('username', 'Username'),
passwordInput('pwInp', 'Password'),
actionButton('butLogin', 'Login', class = 'btn action-button btn-success', icon = icon('sign-in')),
footer = h4(actionLink('create_account','Create an account'),align='right'),
tags$head(tags$style("#window .modal-footer{display:none}
.modal-header .close{display:none}"),
tags$script("$(document).ready(function(){
$('#window').modal();
});")
))
)
,mainPanel()
))
server <- function(input, output, session) {}
shinyApp(ui, server)
I hope it may be helpful for future readers.

Insert a link into the navbar in shiny

I have some trouble with inserting a link into a navbar with navbarPage in shiny. I can put a link but the navbar looks weird. Does anyone know how to fix it ?
To produce an app with a link in the navbar :
library(shiny)
runApp(list(
ui = navbarPage(
title="My App",
tabPanel("tab1"),
tabPanel("tab2"),
tabPanel(a(href="http://stackoverflow.com", "stackoverflow"))),
server = function(input, output) { }
))
With shiny_0.9.1
Thanks !
EDIT :
A colleague show me a workaround, it consist of puting the link we want in panel 3 into the headerof panel 2.
An app to demonstrate this and the solution from #
20050 8519 21102 26896 16937 for the link in the title's app :
runApp(list(
ui = navbarPage(
title=HTML("stackoverflow"),
tabPanel("tab1"),
tabPanel(HTML("tab2</a></li><li><a href=\"http://stackoverflow.com\">stackoverflow"))
),
server = function(input, output) { }
))
I managed to get it working on a more recent version of Shiny for the left-hand site element of the NavBar, the title, with this:
corner_element = HTML(paste0('<a href=',shQuote(paste0("https://my.page.com/",page_name,"/")), '>', 'Foo', '</a>'))
navbarPage(corner_element, id="page", collapsable=TRUE, inverse=FALSE,
# [...]
)
With shiny 1.7.0 and bslib 0.3.0, it became easier to customize the navbar:
library(shiny)
library(bslib)
ui <- page_navbar(
nav("First tab"),
nav("Second tab"),
nav_item(a(href="http://stackoverflow.com", "stackoverflow")))
)
shinyApp(ui, server = function(...){})

Resources