无法在 R 闪亮的应用程序中显示模式警报

Question

我正在尝试在闪亮的应用程序中配置模式警报。在模态中，我想显示一个表格。为此，我在 UI 中使用 kable extra 和 tableOuput。但是由于某种原因，当我使用 tableOutput 时，模态不会打开。下面是我使用的代码。如果不是，他们在模态警报中显示表格的任何其他方式。

library(shiny)
library(shinyWidgets)
library(shinydashboard)
library(kableExtra)


sidebar <- dashboardSidebar(
  sidebarMenu(id = "tab",
              menuItem("1", tabName = "1"),
              menuItem("2", tabName = "2"),
              menuItem("3", tabName = "3"),
              menuItem("4", tabName = "4")

  )
)
body <-   ## Body content
  dashboardBody(box(width = 12,fluidRow(
    column(
      width = 3,
      pickerInput(
        inputId = "metric",
        label = h4("Metric Name"),
        choices = c(
          "alpha",
          "beta"
        ),

        width = "100%"
      ), actionButton(tableOutput("show"), "Help")
    )
  )))

ui <-   dashboardPage(dashboardHeader(title = "Scorecard"),
                      sidebar,
                      body)

# Define the server code
server <- function(input, output,session) {
  observeEvent(input$metric, {
    if (input$tab == "1"){
      choices <- c(
        "alpha",
        "beta"
      )
    }
    else if (input$tab == "2") {
      choices <- c(
        "apple",
        "orange"
      )
    }
    else {
      choices <- c(
        "foo",
        "zoo",
        "boo"
      )
    }
    updatePickerInput(session,
                      inputId = "metric",
                      choices = choices)
  })

    faq1 <- data.frame(
    Findings = c(
      "lorem ipsum"
    ))
    faq2 <- data.frame(
      Findings = c(
        "lorem ipsum bacon"
      ))

      faq3 <- data.frame(
        Findings = c(
          "lorem ipsum bacon bacon"
        ))

  observeEvent(input$show, {
    if (input$tab == "1"){
      faqtext = faq1
    }
    else if (input$tab == "2") {
      faqtext = faq2
    }
    else if (input$tab == "3") {
      faqtext = faq3
    }

    else {
      faqtext = benchmark_faq
    }
    showModal(modalDialog(
      title = "Guildlines",
      kable(faqtext) %>%
        kable_styling("striped", full_width = F) %>%
        column_spec(1, bold = T, border_right = T),
      easyClose = TRUE
    ))
  })

}
shinyApp(ui = ui, server = server)

Answer 1

因为actionButton的第一个参数应该是inputId，而且我还修改了你的pickerInput并将你的faqtext存储到一个reactive对象中，你可以使用faqtext()在任何地方调用它

试试这个：

library(shiny)
library(shinyWidgets)
library(shinydashboard)
library(kableExtra)


sidebar <- dashboardSidebar(
  sidebarMenu(id = "tab",
              menuItem("1", tabName = "1"),
              menuItem("2", tabName = "2"),
              menuItem("3", tabName = "3"),
              menuItem("4", tabName = "4")

  )
)
body <-   ## Body content
  dashboardBody(box(width = 12,fluidRow(
    column(
      width = 3,
      # pickerInput(
      #   inputId = "metric",
      #   label = h4("Metric Name"),
      #   choices = c(
      #     "alpha",
      #     "beta"
      #   ),
      #   
      #   width = "100%"
      # )
      uiOutput("metric")
      , actionButton("show", "Help")
    )
  )))

ui <-   dashboardPage(dashboardHeader(title = "Scorecard"),
                      sidebar,
                      body)

# Define the server code
server <- function(input, output,session) {

  output$metric<-renderUI({
    if (input$tab == "1"){
      choices <- c(
        "alpha",
        "beta"
      )
    }
    else if (input$tab == "2") {
      choices <- c(
        "apple",
        "orange"
      )
    }
    else {
      choices <- c(
        "foo",
        "zoo",
        "boo"
      )
    }
    pickerInput(
      inputId = "metric",
      label = h4("Metric Name"),
      choices = choices,
      width = "100%"
    )
  })

  faq1 <- data.frame(
    Findings = c(
      "lorem ipsum"
    ))
  faq2 <- data.frame(
    Findings = c(
      "lorem ipsum bacon"
    ))

  faq3 <- data.frame(
    Findings = c(
      "lorem ipsum bacon bacon"
    ))

  observeEvent(input$show, {
    showModal(modalDialog(
      title = "Guildlines",
        tableOutput("kable_table"),
      easyClose = TRUE
    ))
  })
  faqtext<-reactive({
    if (input$tab == "1"){
      return(faq1)
    }
    else if (input$tab == "2") {
      return(faq2)
    }
    else if (input$tab == "3") {
      return(faq3)
    }
    else {
      return(benchmark_faq)
    }
  })
  output$kable_table<-function(){
    kable(faqtext()) %>%
      kable_styling("striped", full_width = F) %>%
      column_spec(1, bold = T, border_right = T)%>%HTML
  }
}
shinyApp(ui = ui, server = server)