如何根据不同的 ui 输入更改列(DT)的颜色?

How to change the color of columns (DT) according to different ui inputs?

目标: 我想根据 2 个不同的 ui 输入更改 datatable 的特定列的颜色。因此,我想根据输入 A 更改列 A 的颜色,根据输入 B 更改列 B 的颜色(在一个 table 中)。

问题: 如果我只使用一个 ui 输入,一切正常,但如果我添加第二个,则只有第二个被执行。 Shiny因此认识到另一个的价值(变化)。我尝试了很多东西,但没有任何效果。下面的示例是“最佳”代码。

这是我的例子(注意:我正在使用模块):

library(shiny)
library(DT)

输入模块

 input_ui <- function(id) {
 ns <- NS(id)
 tagList(
  radioButtons(ns("radio1"), label = "Buttons1", choices = c("red", "green")),
  radioButtons(ns("radio2"), label = "Buttons2", choices = c("yellow", "blue"))
 )
}

显示模块

 output_show <- function(id) {
 ns <- NS(id)
 tagList(
 DT::dataTableOutput(ns("test_table"))
 )
}

服务器模块

 output_server <- function(id) {
  moduleServer(
   id,
   function(input, output, session) {
  
   output$test_table <-  DT::renderDataTable({
    mtcars
    df <- mtcars

   if(input$radio1=="red") {
   DT::datatable(df) %>%
     formatStyle("mpg",
                 backgroundColor = "red")
   } else if (input$radio1=="green") {
      DT::datatable(df) %>%
       formatStyle("mpg",
                   backgroundColor = "green")
   }
 
  if(input$radio2=="yellow") {
  DT::datatable(df) %>%
    formatStyle("cyl",
                backgroundColor = "yellow")
  } else if (input$radio2=="blue") {
  DT::datatable(df) %>%
    formatStyle("cyl",
                backgroundColor = "blue")
  }
   
    })
   }
  )
 }

UI

 ui <- fluidPage(
  sidebarLayout(

   sidebarPanel(
    input_ui("test")),

   mainPanel(
    output_show("test")
   )
  )
 )

服务器

 server <- function(input, output, session) {
  output_server("test")
 }

 shinyApp(ui, server)

自己找到了一个解决方案,虽然不是很方便或优雅。

新服务器模块

output_server <- function(id) {
 moduleServer(
  id,
  function(input, output, session) {
  
  output$test_table <-  DT::renderDataTable({
    mtcars
    df <- mtcars

    
    if(input$radio1=="red" & input$radio2=="blue") {
      DT::datatable(df) %>%
        formatStyle("mpg", 
                    backgroundColor = "red")%>%
        formatStyle("cyl", 
                    backgroundColor= "blue")
    } else if (input$radio1=="red" & input$radio2=="yellow") {
      DT::datatable(df) %>%
        formatStyle("mpg", 
                    backgroundColor = "red")%>%
        formatStyle("cyl", 
                    backgroundColor= "yellow")
    }  else if (input$radio1=="green" & input$radio2=="blue") {
      DT::datatable(df) %>%
        formatStyle("mpg", 
                    backgroundColor = "green")%>%
        formatStyle("cyl", 
                    backgroundColor= "blue")
    }  else if (input$radio1=="green" & input$radio2=="yellow") {
      DT::datatable(df) %>%
        formatStyle("mpg", 
                    backgroundColor = "green")%>%
        formatStyle("cyl", 
                    backgroundColor= "yellow")
    } 

    })
   }
  )
 }

      

它无法解决您的问题 post 的原因是您在执行 if/else 语句时没有修改变量 df。 所以 DT::renderDataTable 只渲染最后一个,即由 radio2 修改的那个。但是radio1的修改被删除了。

这里有几个解决方案:

  • 一次完成所有修改(如下所示)
  • 一个一个地做你的修改,但每次都修改你的变量。这意味着不要写 DT::datatable(df) %>% formatStyle("mpg",backgroundColor = "green"),而是写类似
  • 的东西
    df <- DT::datatable(mtcars) 
    if(input$radio1=="red") {
    df <- df %>% formatStyle("mpg",backgroundColor = "red")
    }

所以我的例子: 我删除了模块以简化代码

library(shiny)
library(DT)

ui <- fluidPage(
  sidebarLayout(
    
    sidebarPanel(
      radioButtons("radio1", label = "Buttons1", choices = c("red", "green")),
      radioButtons("radio2", label = "Buttons2", choices = c("yellow", "blue"))
    ),
    
    mainPanel(
      DT::dataTableOutput("test_table")
    )
  )
)


server <- function(input, output, session) {

  output$test_table <-  DT::renderDataTable({

    req(input$radio1)
    req(input$radio2)

    DT::datatable(mtcars) %>%
      formatStyle("mpg",
                  backgroundColor = input$radio1) %>%
      formatStyle("cyl",
                  backgroundColor = input$radio2)
  })
  
}

shinyApp(ui, server)