我如何在DT :: datable列中设置渐变色？

Question

我有一个闪亮的应用程序，在其中我要根据每个行值（从低到高，所有这些都填充除“主题”之外的所有颜色）填充矩阵输出的数字列空间。我看到了in this link一种使用color = styleInterval()来为空格填充颜色的方法，但是我想不出一种方法来按主题为每列填充不同的颜色（考虑到它们每次不一定都必须是相同数量的主题） ，但肯定不会超过15个主题，当然＆每列的编号都会有所不同）。重要的是要提及，我希望其他3个数字列中的每一个都具有相同的颜色，并根据各自的值进行渐变。有人可以告诉我吗？

# --------------------------------------- Global --------------------------------------- #

#1. App
if("shiny" %in% rownames(installed.packages()) == FALSE){ install.packages("shiny") }
library(shiny)

#3. Easier data handling
if("dplyr" %in% rownames(installed.packages()) == FALSE){ install.packages("dplyr") }
library(dplyr)

#8. Data Table shiny outputs 
if("DT" %in% rownames(installed.packages()) == FALSE){ install.packages("DT") }
library(DT)

#--------------------------------------- User Interface ---------------------------------------#
ui <- fluidPage( 
  DT::dataTableOutput("topic_info_table")
  )

#--------------------------------------- Server ---------------------------------------#

server <- function(input, output, session) {
# COLOR TABLE BY TOPIC

bytopic <- NULL

output$topic_info_table <- DT::renderDataTable({

  bytopic <- structure(c("Chocolate", "Pineapple", "Coconut", "Jam", "Jelly", 
                        "Soup", "Ice-Cream", "Cake", "Pudin", "Candy", "Pizza", "Rum", 
                        "Vodka", "2016", "2016", "2017", "2016", "2016", "2018", "2016", 
                        "2017", "2016", "2016", "2016", "2017", "2017", "2034", "2036", 
                        "2036", "2029", "2035", "2036", "2035", "2033", "2035", "2035", 
                        "2035", "2034", "2037", "14030.57", "13488.00", "12402.98", "16053.32", 
                        "13256.43", "11388.83", "12005.04", "13691.61", "13161.59", "12605.35", 
                        "12348.48", "12872.83", "10963.04"), .Dim = c(13L, 4L), .Dimnames = list(
                          c("1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", 
                            "12", "13"), c("topic", "year", "expiration", "cost")))

  DT::datatable(bytopic, options = list(pageLength = 15)) %>% formatCurrency(c('cost')) 
}) 
}
shinyApp(ui,server)

---

想法将得到类似：使用Excel的conditional formating轻松完成，您可以根据其值格式化单元格。在示例中，我使用了最清晰的绿色阴影作为最小值，使用了最暗的蓝色阴影作为最大值。希望有一个传说，说出最低->最高的颜色渐变。

Answer 1

这里是一个解决方案。

[基本上，我用this代码制作了一个创建一定范围颜色的函数（放置在ui之前，因为它只需要运行一次并且不需要重新加载输入）：

# General function
colfunc <- colorRampPalette(c("blue", "deepskyblue"))

然后，因为您的数据是一个矩阵，所以我将其转换为数据帧，然后对列进行了分解以使其具有数字形式（这要归功于unfactor包中的函数varhandle：]

bytopic <- as.data.frame(bytopic)
bytopic <- unfactor(bytopic)

最后，我使用these examples根据列的值对列进行着色（仅以下块中的列year：]

formatStyle("year", 
            backgroundColor = styleEqual(sort(unique(bytopic$year), 
                                              decreasing = TRUE),
                                          colfunc(length(unique(bytopic$year)))
                                         )
            )

问题是我无法将该块放入函数中（也许很容易，但是我没有成功完成），所以您必须对要着色的每一列重复此代码（希望您不要没有很多）。这不是理想的方法，但至少是可行的。

这是完整的代码：

# --------------------------------------- Global --------------------------------------- #

#1. App
if("shiny" %in% rownames(installed.packages()) == FALSE){ install.packages("shiny") }
library(shiny)

#3. Easier data handling
if("dplyr" %in% rownames(installed.packages()) == FALSE){ install.packages("dplyr") }
library(dplyr)

#8. Data Table shiny outputs 
if("DT" %in% rownames(installed.packages()) == FALSE){ install.packages("DT") }
library(DT)

# General function
colfunc <- colorRampPalette(c("blue", "deepskyblue"))

# Additional package
if("varhandle" %in% rownames(installed.packages()) == FALSE){ install.packages("varhandle") }
library(varhandle)


#--------------------------------------- User Interface ---------------------------------------#
ui <- fluidPage( 
  DT::dataTableOutput("topic_info_table")
)

#--------------------------------------- Server ---------------------------------------#

server <- function(input, output, session) {
  # COLOR TABLE BY TOPIC

  bytopic <- NULL

  output$topic_info_table <- DT::renderDataTable({

    bytopic <- structure(c("Chocolate", "Pineapple", "Coconut", "Jam", "Jelly", 
                           "Soup", "Ice-Cream", "Cake", "Pudin", "Candy", "Pizza", "Rum", 
                           "Vodka", "2016", "2016", "2017", "2016", "2016", "2018", "2016", 
                           "2017", "2016", "2016", "2016", "2017", "2017", "2034", "2036", 
                           "2036", "2029", "2035", "2036", "2035", "2033", "2035", "2035", 
                           "2035", "2034", "2037", "14030.57", "13488.00", "12402.98", "16053.32", 
                           "13256.43", "11388.83", "12005.04", "13691.61", "13161.59", "12605.35", 
                           "12348.48", "12872.83", "10963.04"), .Dim = c(13L, 4L), .Dimnames = list(
                             c("1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", 
                               "12", "13"), c("topic", "year", "expiration", "cost")))

    bytopic <- as.data.frame(bytopic)
    bytopic <- unfactor(bytopic)

    DT::datatable(bytopic, options = list(pageLength = 15)) %>% 
      formatCurrency(c('cost')) %>%
      formatStyle("year", 
                  backgroundColor = styleEqual(sort(unique(bytopic$year), 
                                                    decreasing = TRUE),
                                               colfunc(length(unique(bytopic$year)))
                                               )
      ) %>%
      formatStyle("expiration", 
                  backgroundColor = styleEqual(sort(unique(bytopic$expiration), 
                                                    decreasing = TRUE),
                                               colfunc(length(unique(bytopic$expiration)))
                  )
      ) %>%
      formatStyle("cost", 
                  backgroundColor = styleEqual(sort(unique(bytopic$cost), 
                                                    decreasing = TRUE),
                                               colfunc(length(unique(bytopic$cost)))
                  )
      ) 
  }) 
}
shinyApp(ui,server)