实现平滑的颜色渐变

Question

我有一个在Excel中的热力图，我正在尝试在R中重新创建它。它基本上是RFM分割的数据，在Excel中颜色范围很棒，但我无法在R中得到如此漂亮的平滑颜色渐变，并且已经尝试了很多方法，但无法达到相同的平滑渐变效果。

我的Excel热力图如下所示：

我的 R 热图如下所示：

我的 R 代码是：

cols <- brewer.pal(9, 'RdYlGn')

ggplot(xxx)+
  geom_tile(aes(x= mon, y = reorder(freq, desc(freq)), fill = n)) + 

facet_grid(rec~.) +
#  geom_text(aes(label=n)) +

# scale_fill_gradient2(midpoint = (max(xxx$n)/2), low = "red", mid = 
"yellow", high = "darkgreen") +
# scale_fill_gradient(low = "red", high = "blue") +
scale_fill_gradientn(colours = cols) +
# scale_fill_brewer() +

labs(x = "monetary", y= "frequency") +
scale_x_discrete(expand = c(0,0)) + 
scale_y_discrete(expand = c(0,0)) +
coord_fixed(ratio= 0.5) +
theme(legend.position = "none") 

如何使用ColorRampPalette来实现与Excel中相同的平滑颜色渐变，或者其他任何可以给我更平滑渐变的方法？R中的渐变不太好看。

我无法在此处发布我的数据集，因为它有30,000条记录。我正在使用dput(head(df))将我的数据集头部转储如下：

structure(list(rfm_score = c(111, 112, 113, 114, 115, 121), n = c(2624L, 
160L, 270L, 23L, 5L, 650L), rec = structure(c(1L, 1L, 1L, 1L, 
1L, 1L), .Label = c("1", "2", "3", "4", "5"), class = "factor"), 
    freq = structure(c(1L, 1L, 1L, 1L, 1L, 2L), .Label = c("1", 
    "2", "3", "4", "5"), class = "factor"), mon = structure(c(1L, 
    2L, 3L, 4L, 5L, 1L), .Label = c("1", "2", "3", "4", "5"), class = 
"factor")), row.names = c(NA, 
6L), class = "data.frame")

- Heinrich Muller

---

只是一点提醒，对于您的用例，DT包可能更加合适。 - zx8754

Answer 1

你可以使用 tableHTML 包：

这是我使用的数据：

df <- structure(list(rfm_score = c(111, 112, 113, 114, 115, 121), n = c(2624L, 
                                                                  160L, 270L, 23L, 5L, 650L), rec = structure(c(1L, 1L, 1L, 1L, 
                                                                                                                1L, 1L), .Label = c("1", "2", "3", "4", "5"), class = "factor"), 
               freq = structure(c(1L, 1L, 1L, 1L, 1L, 2L), .Label = c("1", 
                                                                      "2", "3", "4", "5"), class = "factor"), mon = structure(c(1L, 
                                                                                                                                2L, 3L, 4L, 5L, 1L), .Label = c("1", "2", "3", "4", "5"), class = 
                                                                                                                                "factor")), row.names = c(NA, 
                                                                                                                                                          6L), class = "data.frame")

加载该软件包：

library(tableHTML)

重新塑造data.frame以反映您拥有的结构：

df <- data.table::dcast(df, 
                        rec + freq ~ mon,
                        value.var = "rfm_score",
                        fill = "")

  rec freq   1   2   3   4   5
1   1    1 111 112 113 114 115
2   1    2 121   

您可以创建一个tableHTML对象，并对其应用CSS以调整样式： 步骤如下：

1. 创建带有第二个标题和标题的tableHTML对象
2. 为标题添加背景颜色和边框
3. 更改第二个标题"Mon."的背景颜色
4. 使用RColorbrewer调色板"Blues"为rec和freq列添加颜色等级
5. 确保缺失值（即""）为白色
6. 将RAG（红、琥珀、绿）颜色等级应用于Mon.列
7. 在Mon.下面的标题中应用不同深浅的蓝色

\

df %>% 
  tableHTML(rownames = FALSE, 
            second_headers = list(c(2, 5),
                                  c("", "Mon.")),
            caption = "<br>RFM Segmentation <br> Count of Cust in each Segment",
            widths = c(rep(80, 2), rep(100, 5))) %>% 
  add_css_caption(css = list(c("background-color", "border"),
                             c("#F9E9DC", "1px solid black"))) %>% 
  add_css_second_header(css = list("background-color",
                                   "lightgray"),
                        second_headers = 2) %>% 
  add_css_conditional_column(conditional = "colour_rank",
                             colour_rank_css = make_css_colour_rank_theme(list(rec = df$rec),
                                                                          RColorBrewer::brewer.pal(5, "Blues")),
                             columns = 1) %>% 
  add_css_conditional_column(conditional = "colour_rank",
                             colour_rank_css = make_css_colour_rank_theme(list(freq = df$freq),
                                                                          RColorBrewer::brewer.pal(5, "Blues")),
                             columns = 2) %>% 
  add_css_conditional_column(conditional = "==",
                             value = "",
                             css = list(c("background-color", "color"),
                                        c("white", "white")),
                             columns = 3:7) %>% 
  add_css_conditional_column(conditional = "colour_rank",
                             colour_rank_theme = "RAG",
                             columns = 3:7,
                             decreasing = TRUE) %>% 
  add_css_header(css = list("background-color",
                            "#EFF3FF"),
                 header = 3) %>% 
  add_css_header(css = list("background-color",
                            "#BDD7E7"),
                 header = 4) %>% 
  add_css_header(css = list("background-color",
                            "#6BAED6"),
                 header = 5) %>% 
  add_css_header(css = list("background-color",
                            "#3182BD"),
                 header = 6) %>% 
  add_css_header(css = list("background-color",
                            "#08519C"),
                 header = 7)

结果看起来像这样：

。该图片展示了输出结果。

- clemens

---

嗨Clemens，非常感谢您的时间和努力，我真的很感激。看起来太棒了。 - Heinrich Muller

当我复制您的示例时，出现以下错误：tableHTML（。 ，rownames = FALSE，second_headers = list（c（2,5），：widths必须与列的长度相同。 - Heinrich Muller

好的，我已经使用完整数据集（30,0000条记录）创建了热力图，看起来不错，但是颜色比例完全错误。不知道如何在次要评论框中上传图片。有什么想法可以让我在这些评论框中加载图片，以便您可以查看输出结果？ - Heinrich Muller

谢谢你指出这个问题。这是一个小漏洞，我已经在 GitHub 上做了记录并开始解决它。一旦我有了解决方法，会尽快通知你！ - clemens

我已经调查了这个问题，但不确定你所说的“比例尺错误”是什么意思。你能否分享一下你得到的结果和期望的结果？（可以作为共享驱动器上的链接） - clemens

让我们在聊天中继续这个讨论。 - clemens

Answer 2

主要问题是gradientn()会生成一个线性的颜色比例尺。看你在Excel中的示例，1的值显示为红色，200为黄色，2000为绿色。我不知道Excel是如何缩放的（我猜是百分位数？），但它绝对不是线性的。

如果线性值很重要，而转换这些数据是不合适的，那么Excel中的颜色比例尺就是误导性的。看起来有相当广泛的值分布，但实际上，大多数值都是相似的，因此相当低，如ggplot2颜色比例尺所示。

如果对值进行对数变换是合理或适当的，则可以这样做。这将给您一个类似于Excel的比例尺，但对观察者来说更清晰明了。

以下是一个例子：

library(ggplot2)
library(RColorBrewer)

set.seed(123) ; rn = rnorm(25, mean = 5, sd = 2)

df = data.frame(monetary = rep(seq(5),5),
                frequency = sort(rep(seq(5),5)),
                val = 10^rn)

pal = brewer.pal(9, "RdYlGn")

# mostly red, a few green (very high) values
ggplot(df, aes(monetary, frequency)) +
  geom_tile(aes(fill = val)) +
  scale_fill_gradientn(colors = pal)

# log transforming evens out scale
ggplot(df, aes(monetary, frequency)) +
  geom_tile(aes(fill = log10(val))) +
  scale_fill_gradientn(colors = pal)

- Tyr Wiesner-Hanks

---

嗨Tyr，是的，这似乎有很大的影响。谢谢你。 - Heinrich Muller