更改闪亮的渲染表标题？

Question

我已经设法构建了一个简单的闪亮应用程序，它从预定义列表中获取用户输入并将此输入作为向量传递给函数，然后输出该函数的结果（这里我用 print 替换了该函数）。

library(shiny)
library(shinythemes)

server <- function(input, output) {

  LIST_OF_STUFF = c("A", "B", "C", "D")

  other_select <- function(inputId) {

    reactive({
      select_ids <- grep("^select_\\d+$", names(input), value = T)
      other_select_ids <- setdiff(select_ids, inputId)
      purrr::map(other_select_ids, purrr::partial(`[[`, input))
    })

  }

  render_select <- function(i, label = "Enter selections") {

    renderUI({

      this_id <- paste0("select_", i) 
      this_input <- isolate(input[[this_id]])

      selected_elsewhere <- unlist(other_select(this_id)())
      available_choices <- setdiff(LIST_OF_STUFF, selected_elsewhere)

      selectInput(inputId = this_id, label = label, choices = available_choices, 
                  selected = this_input, multiple = TRUE)
    })

  }

  output$select_1 <- render_select(1)

  output$selected_var <- renderTable({ 
    as.data.frame(print(input$select_1))
  })

}

ui <- fluidPage(theme = "united",
                titlePanel("Title"),
                mainPanel(img(src = 'testimage.png', align = "right")),
                uiOutput("select_1"),
                tableOutput("selected_var"))

shinyApp(ui, server)

几个问题：结果表的标题是“print(input$select_1)”——我该如何自定义它？

我想应用一个主题来为应用添加一些颜色，但它似乎没有显示出来。如何使背景或标题栏着色？

结果表当前在用户选择后立即打印，但我希望它等到用户完成选择输入。我该怎么做？

这是我第一次使用闪亮或制作任何类型的交互式应用程序，如果这些是微不足道的问题，请原谅我。谢谢！

Answer 1

数据帧输出

要显示自定义名称，您可以在数据框中添加变量名称：

  output$selected_var <- renderTable({ 
    data.frame(selections = isolate(input$select_1))
  })

应用定制

由于它是一款网络应用，因此您可以（几乎）自定义应用的任何元素。您只需定位要修改的元素，例如，如果您要修改背景颜色和标题颜色，您可以在代码中添加自定义 CSS：

tags$head(
  tags$style(
    HTML("h2 {
            color: red;
          }

          body {
            background-color: grey;
          }")
    )
)

延迟

要等待用户完成选择，我建议您添加一个actionButton，用户必须按下才能呈现表格。一种方法是使用observeEvent 并隔离input 选择。

总之

总而言之，您可以拥有一个如下所示的应用：

library(shiny)
library(shinythemes)

server <- function(input, output) {

  LIST_OF_STUFF = c("A", "B", "C", "D")

  other_select <- function(inputId) {

    reactive({
      select_ids <- grep("^select_\\d+$", names(input), value = T)
      other_select_ids <- setdiff(select_ids, inputId)
      purrr::map(other_select_ids, purrr::partial(`[[`, input))
    })

  }

  render_select <- function(i, label = "Enter selections") {

    renderUI({

      this_id <- paste0("select_", i) 
      this_input <- isolate(input[[this_id]])

      selected_elsewhere <- unlist(other_select(this_id)())
      available_choices <- setdiff(LIST_OF_STUFF, selected_elsewhere)

      selectInput(inputId = this_id, label = label, choices = available_choices, 
                  selected = this_input, multiple = TRUE)
    })

  }

  output$select_1 <- render_select(1)

  observeEvent(input$run, {
    output$selected_var <- renderTable({ 
      data.frame(selections = isolate(input$select_1))
    })
  })

}

ui <- fluidPage(theme = "united",
                titlePanel("Title"),
                tags$head(
                  tags$style(
                    HTML("h2 {
                            color: red;
                          }

                         body {
                            background-color: grey;
                         }")
                  )
                ),
                mainPanel(img(src = 'testimage.png', align = "right")),
                uiOutput("select_1"),
                actionButton("run", "Run"),
                tableOutput("selected_var"))

shinyApp(ui, server)