DF1, DF2 и DF3 - это три фрейма данных, которые у меня есть (в вариантах). Выбирая DF3 из второго набора данных, я хотел бы выделить значение «600.00» из столбца «Зарплата» 7-й строки зеленым цветом на заднем плане в этой конкретной ячейке. Какой самый эффективный способ сделать это в R? Поскольку я новичок в Shiny, не могли бы мне помочь?

Ниже мой код:

library(shiny)

DF1 <- 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))
DF1


DF2 <- data.frame(
  emp_id = c(1:6),
  emp_name = c("Rick","Dan","Michelle","Ryan","Gary", "Alex"),
  salary = c(623.3,515.2,611.0,729.0,843.25, 243.5))


DF3 <- data.frame(
  emp_id = c(1:7),
  emp_name = c("Rick","Dan","Michelle","Ryan","Gary", "Alex", "Christan"),
  salary = c(623.3,515.2,611.0,729.0,843.25, 243.5, 600.0))

shinyApp(
  ui = tagList(
    navbarPage(
      fluidRow(column(6, selectInput("dataset1", "Choose first dataset:",
                                     choices = c("SelectDataSet ", "DF1", "DF2", "DF3"))),
               
               column(6, selectInput("dataset2", "Choose second dataset:",
                                     choices = c("SelectDataSet ", "DF1", "DF2", "DF3")))
      ),
      # Button
      downloadButton("downloadData5", "Download")
    ),
    mainPanel(
      fluidRow(column(6,  tableOutput("table1")), 
               column(6,  tableOutput("table2"))
      )
    )
  ),
  
server = function(input, output,session) {
  datasetInput1 <- reactive({
      switch(input$dataset1,
             "DF1" = DF1,
             "DF2" = DF2,
             "DF3" = DF3)
    })
  datasetInput2 <- reactive({
      switch(input$dataset2,
             "DF1" = DF1,
             "DF2" = DF2,
             "DF3" = DF3)
    })
    
    output$table1 <- renderTable({
      datasetInput1()
    })
    
    output$table2 <- renderTable({
      datasetInput2()
    })
    
  }
)
shinyApp(ui, server)
2
Learn with Kumaran 8 Июн 2021 в 21:36

2 ответа

Лучший ответ

Вы можете использовать kableExtra, который позволяет определять каждую ячейку индивидуально с cell_spec:

library(shiny)
library(kableExtra)

DF1 <- 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))
DF1


DF2 <- data.frame(
  emp_id = c(1:6),
  emp_name = c("Rick","Dan","Michelle","Ryan","Gary", "Alex"),
  salary = c(623.3,515.2,611.0,729.0,843.25, 243.5))


DF3 <- data.frame(
  emp_id = c(1:7),
  emp_name = c("Rick","Dan","Michelle","Ryan","Gary", "Alex", "Christan"),
  salary = c(623.3,515.2,611.0,729.0,843.25, 243.5, 600.0))

# Define specific cell spec
DF3$salary <- cell_spec(DF3$salary, background = c(rep("white",6), "green"))

shinyApp(
  ui = tagList(
    navbarPage(
      fluidRow(column(6, selectInput("dataset1", "Choose first dataset:",
                                     choices = c("SelectDataSet ", "DF1", "DF2", "DF3"))),
               
               column(6, selectInput("dataset2", "Choose second dataset:",
                                     choices = c("SelectDataSet ", "DF1", "DF2", "DF3")))
      ),
      # Button
      downloadButton("downloadData5", "Download")
    ),
    mainPanel(
      fluidRow(column(6,  tableOutput("table1")), 
               column(6,  tableOutput("table2"))
      )
    )
  ),
  
  server = function(input, output,session) {
    datasetInput1 <- reactive({
      switch(input$dataset1,
             "DF1" = DF1,
             "DF2" = DF2,
             "DF3" = DF3)
    })
    datasetInput2 <- reactive({
      switch(input$dataset2,
             "DF1" = DF1,
             "DF2" = DF2,
             "DF3" = DF3)
    })
    output$table1 <- function() {
      req(datasetInput1() )
      datasetInput1() %>%
        knitr::kable("html",escape = F) %>% kable_styling()
    }
    
    output$table2 <- function() {
      req(datasetInput2() )
      datasetInput2() %>%
        knitr::kable("html",escape = F) %>% kable_styling()
    }
    
  }
)
shinyApp(ui, server)

enter image description here

2
Waldi 8 Июн 2021 в 19:43

Если вы не против использования DT, вы можете раскрасить фон этой ячейки на втором экране.

library(DT)

shinyApp(
    ui = tagList(
        navbarPage(
            fluidRow(column(6, selectInput("dataset1", "Choose first dataset:",
                                           choices = c("SelectDataSet ", "DF1", "DF2", "DF3"))),
                     
                     column(6, selectInput("dataset2", "Choose second dataset:",
                                           choices = c("SelectDataSet ", "DF1", "DF2", "DF3")))
            ),
            # Button
            downloadButton("downloadData5", "Download")
        ),
        mainPanel(
            fluidRow(column(6,  dataTableOutput("table1")), 
                     column(6,  dataTableOutput("table2"))
            )
        )
    ),
    
    server = function(input, output,session) {
        
        DF1 <- 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))
        
        
        DF2 <- data.frame(
            emp_id = c(1:6),
            emp_name = c("Rick","Dan","Michelle","Ryan","Gary", "Alex"),
            salary = c(623.3,515.2,611.0,729.0,843.25, 243.5))
        
        
        DF3 <- data.frame(
            emp_id = c(1:7),
            emp_name = c("Rick","Dan","Michelle","Ryan","Gary", "Alex", "Christan"),
            salary = c(623.3,515.2,611.0,729.0,843.25, 243.5, 600.0))
        
        datasetInput1 <- reactive({
            switch(input$dataset1,
                   "DF1" = DF1,
                   "DF2" = DF2,
                   "DF3" = DF3)
        })
        datasetInput2 <- reactive({
            switch(input$dataset2,
                   "DF1" = DF1,
                   "DF2" = DF2,
                   "DF3" = DF3)
        })
        
        output$table1 <- renderDataTable({
            datasetInput1()
        })
        
        output$table2 <- renderDataTable({
            if(input$dataset2 != "SelectDataSet ") {
                # Get the dataset
                d = datasetInput2()
                # Add a column specifying the background color: light green if
                # salary = 600; nothing otherwise
                d$background.color = ifelse(d$salary == 600, "lightgreen", NA)
                # Output the DataTable; hide the new 4th column we just created
                # but use it to specify the background color of the "salary"
                # column
                d %>%
                    datatable(options = list(columnDefs = list(list(targets = 4,
                                                                    visible = F)))) %>%
                    formatStyle("salary",
                                backgroundColor = styleEqual(d$salary,
                                                             d$background.color))
            }
        })
        
    }
)

enter image description here

Этот метод применит зеленый цвет к любой зарплате в 600. Вы можете настроить условие на то, что ему действительно нужно (например, просто зарплата Кристиана, или только последняя строка, или что-то в этом роде) . При желании можно удалить окно поиска и другие интерактивные элементы.

0
A. S. K. 8 Июн 2021 в 20:16