通过数据表中的每个列范围以编程方式为数字列设置颜色格式

时间:2019-03-01 19:12:50

标签: r shiny datatables dt

我在这里打开了一个有关如何在数据表中添加范围条的线程:Programmatically color format numeric columns in a datatable

但是,我不想基于整个数据框来拟合范围,而是想根据每个单独列的范围进行格式化。我想出了一些有效的代码,但是,这绝对是令人生畏的,而不是编程性的。

library(magrittr)
library(DT)

# Specify numeric columns
foo <- sapply(iris, is.numeric)

datatable(iris, filter = 'top', options = list(pageLength = 5, autoWidth = TRUE)) %>%
  formatStyle(names(iris)[foo][1],
              background = styleColorBar(range(iris[, 1]), 'lightblue'),
              backgroundSize = '98% 88%',
              backgroundRepeat = 'no-repeat',
              backgroundPosition = 'center') %>%
  formatStyle(names(iris)[foo][2],
              background = styleColorBar(range(iris[, 2]), 'green'),
              backgroundSize = '98% 88%',
              backgroundRepeat = 'no-repeat',
              backgroundPosition = 'center')

enter image description here

2 个答案:

答案 0 :(得分:0)

在此处创建一个起点,将其绘制到数据集中的每个数字列。您可以修改以适合特定的用例。

library(tidyverse)
library(DT)
library(RColorBrewer)

colorbarTable = function(table,colorscale){
  num = sapply(table,is.numeric) #Find which columns are numeric
  colors = brewer.pal(sum(num),colorscale) #Define the number of colors

  DT = datatable(table,filter = 'top',options = list(pageLength = 5, autoWidth = TRUE)) #Define the base data table

  for(i in seq_along(num)){
    if(num[i]){
      #If numeric add to the datatabls
      DT = DT%>%
        formatStyle(names(table)[i],
                    background = styleColorBar(range(table[,i]), colors[i]),
                    backgroundSize = '98% 88%',
                    backgroundRepeat = 'no-repeat',
                    backgroundPosition = 'center')
    }
  }

  return(DT)
}


colorbarTable(mtcars,"Pastel1")

使用irismtcars数据集进行了测试。

答案 1 :(得分:0)

通过@ Sada93为真棒答案添加更多内容。

如果要在选定的列上应用不同的颜色,请尝试此操作。

library(tidyverse)
library(DT)


colorbarTable = function(table, 
                         colorVarList){

    # TESTING
    # table = tempDf
    # vcolorVarList = list(lightblue = c('var2'), lightgreen = c('var3'), pink =  c('ID')

    index <- enframe(colorVarList) %>% 
        unnest %>%
        rename(color = name, colName = value) %>%
        as.data.frame

    dTable <- DT::datatable(table, 
              filter ='top',
              extensions = list('Buttons', 'FixedColumns'), 
              options = list(
                  list(dom = 'Bfrtip',
                             buttons = list('copy', 'print', 
                                            list(extend = 'collection', buttons = c('csv', 'excel'), text ='Download')
                                            )),
                  list(dom = 't', 
                       scrollX = F,
                       fixedColumns = list(leftColumns = 1, rightColumns = 2)))) 

  for(i in 1:nrow(index)){

      # TESTING 
      # i = 1   
  colName <- index[i,"colName"]; colorName <- index[i,"color"]
      dTable <-  dTable%>%
        formatStyle(colName,
                    background = styleColorBar(base::range(table[,colName]), colorName),
                    backgroundSize = '98% 88%',
                    backgroundRepeat = 'no-repeat',
                    backgroundPosition = 'center')

    }

  return(dTable)
}


tempDf <- data.frame(ID = c(1, 2, 3, 4, 5),
                  var1 = c('a', 'b', 'c', 'd', 'e'),
                  var2 = c(1, 1, 0, 0, 1),
                  var3 = c(1,2,3,3,5))

colorbarTable(table = tempDf,
              colorVarList = list(lightblue = c('var2'),
                                  lightgreen =  c('var3'),
                                  pink =  c('ID')))