是否可以在color_tile函数中使用2种以上的颜色?

时间:2018-04-17 18:33:32

标签: r shiny formattable

我有一个数据帧列,我目前正在使用formattable::color_tile函数进行格式化(下面):

color_tile( "red", "springgreen" )

我的问题是,中间附近的值是一种丑陋的棕色,我理想情况下它是一个红 - 琥珀 - 绿色渐变,但color_tile似乎只能采取min。 color和max.color参数 - 是否可以在R?

中使用具有此类或类似格式化功能的第3种颜色

5 个答案:

答案 0 :(得分:2)

确定要在颜色1和2之间的行号以及在颜色2和3之间的行号。然后两次调用color_tile。例如

formattable(x,

        list(
          area(col = 2, row = c(1,3,5,7,8,9,10,13,14,15)) ~ color_tile("red", "white"),
          area(col = 2, row = c(2,4,6,11,12,16)) ~ color_tile("white","green")
        ))

不会完美地修复它,因为它不会在任一侧保持颜色的相对强度

答案 1 :(得分:1)

该功能看起来不像是处理两种以上的颜色,但您可以在该模板上自行构建。

color_tile2 <- function (...) {
  formatter("span", style = function(x) {
    style(display = "block",
          padding = "0 4px", 
          `border-radius` = "4px", 
          `background-color` = csscolor(matrix(as.integer(colorRamp(...)(normalize(as.numeric(x)))), 
                                               byrow=TRUE, dimnames=list(c("red","blue","green"), NULL), nrow=3)))
  })}

可以像

一样使用
formattable(mtcars, list(mpg = color_tile2(c("white", "pink"))))
formattable(mtcars, list(mpg = color_tile2(c("blue", "green", "pink"))))

答案 2 :(得分:0)

在github格式表站点的问题条目中,我发现这似乎很有用,并解决了我的问题,使列颜色从负到正以连续比例编码为红色到绿色,而没有“棕色”。中间(这将实现“透明”):

library(dplyr)
library(kableExtra)
library(formattable)

x = currency(c(1000000,
                 -3000,
                400000,
                800000,
                 -1700,
                     0,
                 50000))

x = ifelse(
  x <= 0.0, 
  color_tile("red", "transparent")(x*c(x<=0)),
  color_tile("transparent", "green")(x*c(x>=0)))

x %>% 
  kable(escape = F) %>% 
  kable_styling(bootstrap_options = c("striped", "hover"), 
                full_width = F)

这是相关的链接:https://github.com/renkun-ken/formattable/issues/102#issuecomment-408649019

答案 3 :(得分:0)

利用RColorBrewer这样的方法可能会起作用

color_tile3 <- function(fun = "comma", digits = 0, palette = 'RdBu', n = 9) {
  fun <- match.fun(fun)

  stopifnot(n >= 5)
  
  return_cut <- function(y) 
    cut(y, breaks = quantile(y, probs = 0:n/n, na.rm = T),
        labels = 1:n, ordered_result = T, include.lowest = T)
  
  return_col <- function(y) 
      RColorBrewer::brewer.pal(n, palette)[as.integer(return_cut(y))]
  
  formatter("span", x ~ fun(x, digits = digits),
            style = function(y) style(
              display = "block",
              padding = "0 4px",
              "border-radius" = "4px",
              "color" = ifelse( return_cut(y) %in% c(1, 2, n-1, n),
                                csscolor("white"), csscolor("black")),
              "background-color" = return_col(y)
            )
  )
}

用例:

library(tidyverse)
library(RColorBrewer)

mtcars[, 1:5] %>%
  corrr::correlate() %>%
  formattable(., list(
    `rowname` = formatter("span", style = ~ style(color = "grey", 
                                                  font.weight = "bold")), 
    area(col = 2:6) ~ color_tile3(digits = 2)))

mtcars_color3

我还不能嵌入,但这是到输出的链接

答案 4 :(得分:0)

基于@cmilando,我重写了该函数,以便颜色可以更好地反映负数和正数,尽管使用:D

library(tidyverse)
library(RColorBrewer)
library(formattable)
library(kableExtra)
library(purrr)

# --------------------
# brewer.pal(10,"RdYlGn")

my_color_tile <- function() {
  
  return_col <- function(y) 
    map_chr(y,function(x) case_when(x > 80  ~ "#006837",
              x > 60  ~ "#1A9850",
              x > 40  ~ "#66BD63",
              x > 20  ~ "#A6D96A",
              x >= 0  ~ "#D9EF8B",
              x >= -20  ~ "#FEE08B",
              x >= -40  ~ "#FDAE61",
              x >= -60  ~ "#F46D43",
              x >= -80  ~ "#D73027",
              x >= -100  ~ "#A50026"
              ))
  
  formatter("span", 
            style = function(y) style(
              display = "block",
              padding = "0 4px",
              "border-radius" = "4px",
              "color" = ifelse( return_col(y) %in% c("#A50026","#D73027","#F46D43","#006837","#1A9850","#66BD63"),
                                csscolor("white"), csscolor("black")),
              "background-color" = return_col(y)
            )
  )
}

# --------------------
data.frame(value = c(seq(-100,100,10))) %>% 
  arrange(desc(value)) %>%  
  formattable(., list(
    area(col = 1) ~ my_color_tile()))