Rshiny : How do I show a header when the option "both" is selected during dataframe comparison?

user_15356471 0
Viewed 32

In the Select option, I have Dataframes emp.data_A and emp.data_B. When I pick "both," I compare both data frames for the column salary, and it shows the differing values in color throughout the comparison. It presently works great.

But when I choose "both." from the alternatives, I want a header to appear that says "Comparision between emp A and emp B." What is the best way to accomplish it in R shiny? Please, someone, assist me.

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()
    )
  }
)
shiny r
1 Answers

You can add a conditional heading text.

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;')
    })
  }
)

enter image description here

Another option is to use conditionalPanel in the UI without changing anything in server.

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