【问题标题】:Achieving a smooth color ramp实现平滑的色带
【发布时间】:2019-01-19 23:40:52
【问题描述】:

我在 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")

【问题讨论】:

  • 请注意,对于您的用例,DT package 可能更合适。

标签: r ggplot2 colors heatmap


【解决方案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" 将颜色等级添加到 recfreq
  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,非常感谢您的时间和精力,我真的很感激。看起来很棒。
  • 当我重现您的示例时,我收到以下错误: tableHTML(., rownames = FALSE, second_headers = list(c(2, 5), 中的错误:宽度必须与列
  • 好的,所以我已经用完整的数据集创建了热图(30,0000条记录,看起来不错,但是色阶完全错误。不知道如何在二级评论框中上传图片. 任何想法我如何在这些评论框中加载图片,以便您查看输出
  • 感谢您指出这一点。这是您发现的一个错误,我已将其记录在 GitHub 上并开始研究解决方案。我一有解决方法就会通知您!
  • 我已经调查了这个问题,当你说规模错误时,我不确定你的意思。你能分享你得到的结果和你期望的结果吗? (也许作为共享驱动器的链接?)
【解决方案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)

【讨论】:

  • 嗨,蒂尔,是的,这似乎有很大的不同。谢谢
猜你喜欢
  • 1970-01-01
  • 2022-07-13
  • 1970-01-01
  • 2011-05-04
  • 1970-01-01
  • 1970-01-01
  • 2013-09-13
  • 1970-01-01
  • 2014-01-30
相关资源
最近更新 更多