r - 在导航栏页面右侧添加操作按钮

Question

我正在使用 auth0 包在 shiny 中进行身份验证。该包包含 auth0::logoutButton()。我想将这些按钮放在 Shiny 应用程序中 NavbarPage 的右侧。这是一个简单的应用程序:

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)

您可以尝试使用 actionbutton 而不是 loginButton。解决方案将是相同的。

Answer 1

我不确定 auth0:logoutButton() 的 HTML 到底是什么，但是您可以在 navbarPage 的右上角添加一个操作按钮通过在最后一个 tabPanel 之后添加 HTML 脚本，如下所示:

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)
  })
}

注意:这段代码调用了一个未定义的 signIn() 函数，因此您需要更改 onclick 行为以匹配您正在尝试执行的操作。