Изменить заголовок renderTable на блестящий?

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)

Несколько вопросов: Полученная таблица имеет заголовок «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)