r - Rshiny：在数据帧比较期间选择“两者”选项时如何显示标题？

Question

在 Select 选项中，我有 Dataframes emp.data_A 和 emp.data_B。当我选择“两者”时，我比较了列工资的两个数据框，它在整个比较过程中显示了不同的颜色值。目前效果很好。

但是当我选择“两者”时。从备选方案中，我希望出现一个标题，上面写着“emp A 和 emp B 之间的比较”。在 R Shiny 中完成它的最佳方法是什么？请有人帮助我。

library(shiny)
library(gt)

emp.data_A <- data.frame(
  emp_id = c(1:5),
  emp_name = c("Rick","Dan","Michelle","Ryan","Gary"),
  salary = c(623.3,515.2,611.0,735.0,844.25),
  credit = c(1,2,3,4,5))

emp.data_A


emp.data_B <- data.frame(
  emp_id = c(1:5),
  emp_name = c("Rick","Dan","Michelle","Ryan","Gary"),
  salary = c(623.3,515.2,611.0,729.0,843.25))
emp.data_B

shinyApp(
  ui = fluidPage(
    fluidRow(
      selectInput("dataset5", 
                  "Choose a dataset:",
                  choices = c("SelectDataSet", "both", "emp.data_A", "emp.data_B")),
      downloadButton("downloadData5", "Download")
    ),
    hr(),
    fluidRow(
      column(width = 6, gt_output("table1")),
      column(width = 6, gt_output("table2"))
    )
  ),
  server = function(input, output,session) {
    datasetInput1 <- reactive({
      if (input$dataset5 == "both" || input$dataset5 == "emp.data_A") {
        emp.data_A 
      } else if (input$dataset5 == "emp.data_B") {
        emp.data_B 
      }
    })
    datasetInput2 <- reactive({
      if (input$dataset5 == "both") {
        tbl_diffs <- dplyr::anti_join(emp.data_B, emp.data_A, by = c('emp_name', 'salary'))
        tbl_gt_B <- emp.data_B %>% gt()
        for (i in tbl_diffs$emp_id) {
          tbl_gt_B <- tbl_gt_B %>%
            tab_style(
              style = list(
                cell_fill(color = "#FFFF00")
              ),
              locations = cells_body(
                columns = 3,
                rows = match(i, emp.data_B$emp_id)
              )
            )
        }
        tbl_gt_B
      }
    })
    output$table1 <- render_gt(
      datasetInput1() 
    )
    output$table2 <- render_gt(
      datasetInput2()
    )
  }
)

标签： rshiny

Answer 1

您可以添加条件标题文本。

library(shiny)
library(gt)

emp.data_A <- data.frame(
  emp_id = c(1:5),
  emp_name = c("Rick","Dan","Michelle","Ryan","Gary"),
  salary = c(623.3,515.2,611.0,735.0,844.25),
  credit = c(1,2,3,4,5))

emp.data_A


emp.data_B <- data.frame(
  emp_id = c(1:5),
  emp_name = c("Rick","Dan","Michelle","Ryan","Gary"),
  salary = c(623.3,515.2,611.0,729.0,843.25))
emp.data_B

shinyApp(
  ui = fluidPage(
    fluidRow(
      selectInput("dataset5", 
                  "Choose a dataset:",
                  choices = c("SelectDataSet", "both", "emp.data_A", "emp.data_B")),
      downloadButton("downloadData5", "Download")
    ),
    hr(),
    uiOutput('text'),
    fluidRow(
      column(width = 6, gt_output("table1")),
      column(width = 6, gt_output("table2"))
    )
  ),
  server = function(input, output,session) {
    datasetInput1 <- reactive({
      if (input$dataset5 == "both" || input$dataset5 == "emp.data_A") {
        emp.data_A 
      } else if (input$dataset5 == "emp.data_B") {
        emp.data_B 
      }
    })
    datasetInput2 <- reactive({
      if (input$dataset5 == "both") {
        tbl_diffs <- dplyr::anti_join(emp.data_B, emp.data_A, by = c('emp_name', 'salary'))
        tbl_gt_B <- emp.data_B %>% gt()
        for (i in tbl_diffs$emp_id) {
          tbl_gt_B <- tbl_gt_B %>%
            tab_style(
              style = list(
                cell_fill(color = "#FFFF00")
              ),
              locations = cells_body(
                columns = 3,
                rows = match(i, emp.data_B$emp_id)
              )
            )
        }
        tbl_gt_B
      }
    })
    output$table1 <- render_gt(
      datasetInput1() 
    )
    output$table2 <- render_gt(
      datasetInput2()
    )
    
    output$text <- renderUI({
      if (input$dataset5 == "both") 
        h4("Comparision between emp A and emp B.", style = 'text-align: center;')
    })
  }
)

---

另一种选择是conditionalPanel在 UI 中使用而不更改服务器中的任何内容。

    conditionalPanel("input.dataset5 == 'both'", 
                     h4("Comparision between emp A and emp B."), 
                     style = 'text-align: center;')