Question

我管理过构建一个简单的闪亮应用程序，从预定义列表中获取用户输入并将此输入作为向量传递给函数，然后输出该函数的结果（此处我已被替换该功能与打印）。

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)

几个问题：结果表的标题为＆＃34; print（输入$ select_1）＆＃34; - 我该如何定制？

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

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

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

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)

更改renderTable标题有光泽吗？

1 个答案:

数据框输出

应用程序自定义

延迟

总而言之