I am using auth0 package for authentication in shiny. The package contains auth0::logoutButton(). I would like to put these button on the right side of the NavbarPage in Shiny app. Here is a simple app:
library(shiny)
library(markdown)
ui <- navbarPage("Navbar!",
tabPanel("Plot",
sidebarLayout(
sidebarPanel(
radioButtons("plotType", "Plot type",
c("Scatter"="p", "Line"="l")
)
),
mainPanel(
plotOutput("plot")
)
)
),
tabPanel("Summary",
verbatimTextOutput("summary")
)
###
# HERE ADD loginButton() in new panel that will be on the right side for test any actionbutton
###
)
server <- function(input, output, session) {
output$plot <- renderPlot({
plot(cars, type=input$plotType)
})
output$summary <- renderPrint({
summary(cars)
})
output$table <- DT::renderDataTable({
DT::datatable(cars)
})
}
shinyApp(ui = ui, server = server)
You can try with actionbutton instead of loginButton. The solution will be the same.
I'm not sure exactly what the HTML would be for auth0:logoutButton(), but you can add an action button to the upper right side of the navbarPage by adding an HTML script after your last tabPanel like this:
library(shiny)
library(markdown)
ui <- navbarPage("Navbar!",
tabPanel("Plot",
sidebarLayout(
sidebarPanel(
radioButtons("plotType", "Plot type",
c("Scatter"="p", "Line"="l")
)
),
mainPanel(
plotOutput("plot")
)
)
),
tabPanel("Summary",
verbatimTextOutput("summary")
),
tags$script(
HTML("var header = $('.navbar > .container-fluid');
header.append('<div style=\"float:right; padding-top: 8px\"><button id=\"signin\" type=\"button\" class=\"btn btn-primary action-button\" onclick=\"signIn()\">Sign In</button></div>')")
)
)
server <- function(input, output, session) {
output$plot <- renderPlot({
plot(cars, type=input$plotType)
})
output$summary <- renderPrint({
summary(cars)
})
output$table <- DT::renderDataTable({
DT::datatable(cars)
})
}
Note: this code calls an undefined signIn() function, so you would want to alter the onclick behavior to match what you're trying to do.
If you prefer sticking with shiny functions actionButton or actionLink, you may find this helpful:
ui <- navbarPage("Navbar!",
tabPanel("Plot",
sidebarLayout(
sidebarPanel(
radioButtons("plotType", "Plot type",
c("Scatter"="p", "Line"="l")
)
),
mainPanel(
plotOutput("plot")
)
)
),
tabPanel("Summary",
verbatimTextOutput("summary")
),
actionLink("signing", "", icon = icon("sign-in-alt"),
style = "position: absolute; right: 20px; top: -3px")
)
I'm not familiar with auth0 but here's a generic solution. You can add a reactive expression to the server or an onclick argument to actionButton.
library(shiny)
ui <- fluidPage(
style = "padding: 0px;", # no gap in navbar
actionButton("logout", "Log Out", icon = icon("user"),
style = "position: absolute; top: 5px; right: 5px; z-index:10000;"),
navbarPage(
title = "My App",
tabPanel("Panel 1", h1("Hi there"))
)
)
server <- function(input, output, session) {
observeEvent(input$logout, {
# do something
})
}
shinyApp(ui, server)
Related
The toy app in the example below contains an R/Shiny actionGroupButtons element. I am looking for guidance please on how to start the actionGroupButtons with button ‘btn_edit’ disabled, which can then become enabled on a click of the button ‘btn_enable’.
Button ‘btn_duplicate’ should remain enabled at all times.
#DeanAttali mentions the use of the ‘disabled’ attribute here (Shiny: how to start application with action button disabled?), though I think that it is one of the inputs that it doesn’t work with.
Any ideas please? TIA
library(shiny)
library(shinyWidgets)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
fluidRow(
actionGroupButtons(
inputIds = c("btn_edit", "btn_duplicate"),
labels = list("Edit", "Duplicate")
)
),
br(),
fluidRow(
actionButton('btn_enable', 'enable edit')
),
br(),
fluidRow(
verbatimTextOutput('btns')
),
br(),
fluidRow(
verbatimTextOutput('btn_enable')
)
)
server <- function(input, output) {
observeEvent((input$btn_edit|input$btn_duplicate),{
output$btns <- renderPrint({paste(input$btn_edit, 'and', input$btn_duplicate)})
})
observeEvent(input$btn_enable,{
output$btn_enable <- renderPrint({input$btn_enable})
if(input$btn_enable > 0) {
shinyjs::enable("btn_edit")
} else {
shinyjs::disable("btn_edit")
}
}, ignoreInit = TRUE)
}
shinyApp(ui = ui, server = server)
You need to set ignoreNULL = FALSE in your observeEvent call, otherwise it will run only after btn_enable was pressed:
library(shiny)
library(shinyWidgets)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
fluidRow(
actionGroupButtons(
inputIds = c("btn_edit", "btn_duplicate"),
labels = list("Edit", "Duplicate")
)
),
br(),
fluidRow(
actionButton('btn_enable', 'enable edit')
),
br(),
fluidRow(
verbatimTextOutput('btns')
),
br(),
fluidRow(
verbatimTextOutput('btn_enable')
)
)
server <- function(input, output, session) {
observeEvent((input$btn_edit|input$btn_duplicate),{
output$btns <- renderPrint({paste(input$btn_edit, 'and', input$btn_duplicate)})
})
observeEvent(input$btn_enable, {
output$btn_enable <- renderPrint({input$btn_enable})
if(input$btn_enable > 0) {
shinyjs::enable("btn_edit")
} else {
shinyjs::disable("btn_edit")
}
}, ignoreInit = FALSE, ignoreNULL = FALSE)
}
shinyApp(ui = ui, server = server)
Another approach would be to disable the button outside of the observer:
library(shiny)
library(shinyWidgets)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
fluidRow(
actionGroupButtons(
inputIds = c("btn_edit", "btn_duplicate"),
labels = list("Edit", "Duplicate")
)
),
br(),
fluidRow(
actionButton('btn_enable', 'enable edit')
),
br(),
fluidRow(
verbatimTextOutput('btns')
),
br(),
fluidRow(
verbatimTextOutput('btn_enable')
)
)
server <- function(input, output, session) {
shinyjs::disable("btn_edit")
observeEvent((input$btn_edit|input$btn_duplicate),{
output$btns <- renderPrint({paste(input$btn_edit, 'and', input$btn_duplicate)})
})
observeEvent(input$btn_enable, {
output$btn_enable <- renderPrint({input$btn_enable})
shinyjs::enable("btn_edit")
})
}
shinyApp(ui = ui, server = server)
I have the shiny app below which by default displays a plot. When I click the actionButton() it hides it but then I want to click the same actionButton() again and display it and so forth.
library(shiny)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
actionButton("hideshow_plot",
"HideShow plot")
),
mainPanel(
plotOutput(outputId = "car_plot")
)
)
)
server <- function(input, output) {
showPlot <- reactiveVal(TRUE)
observeEvent(input$hideshow_plot, {
showPlot(FALSE)
})
output$car_plot <- renderPlot({
if (showPlot()){
plot(cars)
}
else{
}
})
}
shinyApp(ui = ui, server = server)
You can do
observeEvent(input$hideshow_plot, {
showPlot(!showPlot())
})
to alternate TRUE/FALSE at each click.
Considered to use shinyjs?
library(shiny)
ui <- fluidPage(
shinyjs::useShinyjs(),
sidebarLayout(
sidebarPanel(
actionButton("hideshow_plot",
"HideShow plot")
),
mainPanel(
plotOutput(outputId = "car_plot")
)
)
)
server <- function(input, output) {
observeEvent(input$hideshow_plot, {
shinyjs::toggle("car_plot")
})
output$car_plot <- renderPlot({
plot(cars)
})
}
shiny::shinyApp(ui, server)
What I am trying to do is to use an if statement to prevent 'Analyse' button to perform an action twice, I want to disable the button when the button is clicked on one selection once already.
I have simplified the code to isolate the if statement area. Anyone know what's going on here? Thanks
library(shiny)
library(shinyjs)
ui <- fluidPage(
navbarPage(title = "Test",
tabPanel("Home",
sidebarPanel(
actionButton("append", "Analyse")
),
mainPanel()
)
)
)
server <- function(input, output, session) {
observeEvent(input$append,{
disbut<-1
if(disbut==1)
{
disable("append")
}
else {
enable("append")
}
})
}
shinyApp(ui, server)
You have to call useShinyjs() in the ui as shown below.
library(shiny)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
navbarPage(title = "Test",
tabPanel("Home",
sidebarPanel(
actionButton("append", "Analyse")
),
mainPanel()
)
)
)
server <- function(input, output, session) {
observeEvent(input$append,{
disbut<-1
if(disbut==1)
{
shinyjs::disable("append")
}
else {
shinyjs::enable("append")
}
})
}
shinyApp(ui, server)
You have to initialise shinyjs with useShinyjs()
ui <- fluidPage(
useShinyjs(),
navbarPage(title = "Test",
tabPanel("Home",
sidebarPanel(
actionButton("append", "Analyse")
),
mainPanel()
)
)
)
I have created the following application template in R shiny :
library(shiny)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
navbarPage("",actionButton("toggleSidebar", "toggle", icon =
icon("database")),
tabPanel("tab",
div( id ="Sidebar",sidebarPanel(
)),mainPanel() ))))
server <-function(input, output, session) {
observeEvent(input$toggleSidebar, {
shinyjs::toggle(id = "Sidebar")
}) }
shinyApp(ui, server)
The App will create a toggle button in the sidebar. The button should appear in the navbar and not above the sidebar. The actual toggle button appears above next to the word tab. It is however, not visible.
The part that is not visible that you mention is in fact the empty title parameter that you have "". Leaving this out as below places the toggle button in the title position:
library(shiny)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
navbarPage(actionButton("toggleSidebar", "toggle", icon =
icon("database")),
tabPanel("tab",
div( id ="Sidebar",sidebarPanel(
)),mainPanel() )))
server <-function(input, output, session) {
observeEvent(input$toggleSidebar, {
shinyjs::toggle(id = "Sidebar")
}) }
shinyApp(ui, server)
I made an example with multiple tabPanels.
library(shiny)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
navbarPage(title = tagList("title",actionLink("sidebar_button","",icon = icon("bars"))),
id = "navbarID",
tabPanel("tab1",
div(class="sidebar"
,sidebarPanel("sidebar1")
),
mainPanel(
"MainPanel1"
)
),
tabPanel("tab2",
div(class="sidebar"
,sidebarPanel("sidebar2")
),
mainPanel(
"MainPanel2"
)
)
)
)
server <-function(input, output, session) {
observeEvent(input$sidebar_button,{
shinyjs::toggle(selector = ".sidebar")
})
}
shinyApp(ui, server)
=======================================
I have created a simpler example that does not use the sidepanel class, but I am not sure if it will work in all environments.
library(shiny)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
navbarPage(title = tagList("title",actionLink("sidebar_button","",icon = icon("bars"))),
tabPanel("tab1",
sidebarPanel("sidebar1"),
mainPanel("MainPanel1")
),
tabPanel("tab2",
sidebarPanel("sidebar2"),
mainPanel("MainPanel2")
)
)
)
server <-function(input, output, session) {
observeEvent(input$sidebar_button,{
shinyjs::toggle(selector = ".tab-pane.active div:has(> [role='complementary'])")
})
}
shinyApp(ui, server)
I am looking for a way to link from an HTML text (nested in the server part) to a specific Shiny tabPanel (nested in UI). Let's say we have the following app:
library(shiny)
shinyUI(fluidPage(
sidebarLayout(
mainPanel(
tabsetPanel(
type="tabs",
tabPanel("Contents", htmlOutput("contents")),
tabPanel("Plot", plotOutput("plot")) # <- A link to here
)
)
)
))
shinyServer(function(input, output) {
output$contents <- renderText({
HTML("A link to <a href='#Plot'>Plot</a>") # <- from there
})
output$plot({
some ggplot
})
})
How could I create a link within the text that then redirects to a certain tab. I tried anchor tags but they don't seem to work as the id keeps changing upon each start of the app.
Thanks in advance.
I don't know whether this is possible with a link. But you can use a button and updateTabsetPanel.
library(shiny)
library(ggplot2)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(),
mainPanel(
tabsetPanel(
type="tabs",
id = "tabset",
tabPanel("Contents", actionButton("go", "Go to plot")),
tabPanel("Plot", plotOutput("plot"))
)
)
)
)
server <- function(input, output, session) {
observeEvent(input$go, {
updateTabsetPanel(session, "tabset", "Plot")
})
output$plot <- renderPlot({
ggplot(mtcars, aes(x=cyl, y=disp)) + geom_point()
})
}
shinyApp(ui, server)
Thanks to Stéphane Laurent, who pointed me in the right direction, I managed to create the solution I wanted. In order to keep all the HTML text in the server function I used a combination of renderUI and actionLink. The solution now looks as follows:
library(shiny)
shinyUI(fluidPage(
sidebarLayout(
mainPanel(
tabsetPanel(
type="tabs",
id = "tabset", # <- Key element 1
tabPanel("Contents", htmlOutput("contents")),
tabPanel("Plot", plotOutput("plot"))
)
)
)
))
shinyServer(function(input, output, session) {
output$contents <- renderUI({ # <- Key element 2
list(
HTML(<p>Some text..</p>),
actionLink("link", "Link to Plot") # <- Key element 3
)
})
observeEvent(input$link, {updateTabsetPanel(session, "tabset", "Plot")}) # <- Key element 4
output$plot({
some ggplot
})
})