R/shiny,2色同盒,datatable包

R/shiny, 2 colours in the same box, datatable package

我有一个问题, 我正在 R 中创建一个闪亮的应用程序,我正在使用“数据表”包来处理视觉对象。您知道是否可以为同一个盒子指定 2 种颜色吗?

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

提前致谢!

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

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)  

我找到了部分解决方案!

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