R/shiny，2色同盒，datatable包答案

【问题标题】：R/shiny, 2 colours in the same box, datatable packageR/shiny，2色同盒，datatable包
【发布时间】：2021-07-19 22:37:43
【问题描述】：

我有一个问题，我正在 R 中创建一个闪亮的应用程序，我正在使用“数据表”包来处理视觉效果。你知道是否可以为同一个盒子分配两种颜色？

library(shiny)
library(DT)
library(tidyverse)


ui <- fluidPage(
  dataTableOutput("TabFin")
)

server <- function(input,output) {
  
  output$TabFin <- renderDataTable({
    vec1 <- c("cat","dog","human","cow","monkey")
    vec2 <- c(1,2,3,4,5)
    tab <- data.frame(Nom=vec1,Num=vec2)  
    datatable(tab, class = 'cell-border stripe', filter = 'top') %>%
      formatStyle(
        'Nom', 'Num',
        backgroundColor = styleEqual(c(1, 2, 3), c('gray', 'green', 'blue')))
   
  })
}    

shinyApp(server=server,ui=ui)

例如，我们可以看到 1 是灰色，2 是绿色，3 是蓝色。但是你如何制作4个蓝色和绿色，即牛广场是半绿半蓝？

enter image description here

提前致谢！

【问题讨论】：

查看指南以创建一个工作示例，让社区参与您的询问：stackoverflow.com/help/minimal-reproducible-example

标签： r shiny datatable colors

【解决方案1】：

是的，您可以创建一个虚拟列来指定您想要的颜色，它们可以是有条件的或显式的。然后我们简单地隐藏该列，当您需要设置多个列的样式时，这种方法非常灵活

library(shiny)
library(DT)
library(tidyverse)


vec1 <- c("cat","dog","human","cow","monkey")
vec2 <- c(1,2,3,4,5)
vec3 <- c(1,2,3,4,5)
colors <- c(1,1,1,1,2)
tab <- data.frame(Colors = colors,Nom=vec1,Num=vec2,Num3 = vec3)  

ui <- fluidPage(
    dataTableOutput("TabFin")
)

server <- function(input,output) {
    
    output$TabFin <- renderDataTable({
        datatable(tab, class = 'cell-border stripe', filter = 'top',rownames = FALSE,
                  options = list(
                      columnDefs=list(
                          list(visible=FALSE, targets=c(0))
                      )
                  )
        ) %>%
            formatStyle(
                columns=c('Nom', 'Num'),
                valueColumns = 'Colors',
                backgroundColor = styleEqual(c(1, 2), c('steelblue', 'lightgreen')))
        
    })
}    

shinyApp(server=server,ui=ui)

【讨论】：

感谢您的回答，但这并不是我所需要的。我刚刚在我的问题中添加了一张图片。
我认为目前不可能

【解决方案2】：

我找到了部分解决方案！

library(shiny)
library(DT)
library(tidyverse)


ui <- fluidPage(
  DT::dataTableOutput("TabFin")
)

server <- function(input,output) {
  
  output$TabFin <- DT::renderDataTable({
    vec1 <- c("chat","chien","homme","vache","singe")
    vec2 <- c(1,2,3,4,5)
    tab <- data.frame(Nom=vec1,Num=vec2)  
    
    tab %>%
    datatable(class = 'cell-border stripe', 
              filter = 'top',
              rownames = FALSE,
              options = list(
                rowCallback = DT::JS(
                  'function(row, data) {
                            if (data[1] == 1)
                              $("td:eq(0)", row).css("background-color", "orange");
                            if (data[1] == 2)
                              $("td:eq(0)", row).css("background-color", "green");
                            if (data[1] == 3)
                              $("td:eq(0)", row).css("background", "linear-gradient(to right, skyblue, orange)");
                            if (data[1] == 4)
                              $("td:eq(0)", row).css("background", "linear-gradient(to right, skyblue, green)");
                            if (data[1] == 5)
                              $("td:eq(0)", row).css("background", "linear-gradient(to right, green, orange)");  
                  }'
                ) 
              )  
            )
  })
}    

shinyApp(server=server,ui=ui)

Image

【讨论】：