在热图的传奇连续渐变颜色条周围绘制边框
如何在连续渐变颜色条周围添加边框。默认情况下，ggplot会选择scale_fill_gradient中指定的填充颜色。
最接近的答案是，我发现这是one，但它并没有帮助我完成这项任务。
我也用传奇键尝试了这个，但没有帮助我。
legend.key = element_rect(colour = "black", size = 4)
请参阅下面的当前和预期图表。
数据：
df1 <- structure(list(go = structure(c(17L, 16L, 15L, 14L, 13L, 12L,
11L, 10L, 9L, 8L, 7L, 6L, 5L, 4L, 3L, 2L, 1L, 17L, 16L, 15L,
14L, 13L, 12L, 11L, 10L, 9L, 8L, 7L, 6L, 5L, 4L, 3L, 2L, 1L,
17L, 16L, 15L, 14L, 13L, 12L, 11L, 10L, 9L, 8L, 7L, 6L, 5L, 4L,
3L, 2L, 1L, 17L, 16L, 15L, 14L, 13L, 12L, 11L, 10L, 9L, 8L, 7L,
6L, 5L, 4L, 3L, 2L, 1L),
.Label = c("q", "p", "o", "n", "m", "l", "k", "j", "i", "h", "g", "f", "e", "d", "c", "b", "a"),
class = c("ordered", "factor")),
variable = structure(c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L,
2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 3L, 3L, 3L, 3L, 3L,
3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 4L, 4L, 4L, 4L,
4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L),
class = "factor", .Label = c("a", "b", "c", "d")),
value = c(-0.626453810742332, 0.183643324222082, -0.835628612410047, 1.59528080213779, 0.329507771815361,
-0.820468384118015, 0.487429052428485, 0.738324705129217, 0.575781351653492,
-0.305388387156356, 1.51178116845085, 0.389843236411431, -0.621240580541804,
-2.2146998871775, 1.12493091814311, -0.0449336090152309, -0.0161902630989461,
0.943836210685299, 0.821221195098089, 0.593901321217509, 0.918977371608218,
0.782136300731067, 0.0745649833651906, -1.98935169586337, 0.61982574789471,
-0.0561287395290008, -0.155795506705329, -1.47075238389927, -0.47815005510862,
0.417941560199702, 1.35867955152904, -0.102787727342996, 0.387671611559369,
-0.0538050405829051, -1.37705955682861, -0.41499456329968, -0.394289953710349,
-0.0593133967111857, 1.10002537198388, 0.763175748457544, -0.164523596253587,
-0.253361680136508, 0.696963375404737, 0.556663198673657, -0.68875569454952,
-0.70749515696212, 0.36458196213683, 0.768532924515416, -0.112346212150228,
0.881107726454215, 0.398105880367068, -0.612026393250771, 0.341119691424425,
-1.12936309608079, 1.43302370170104, 1.98039989850586, -0.367221476466509,
-1.04413462631653, 0.569719627442413, -0.135054603880824, 2.40161776050478,
-0.0392400027331692, 0.689739362450777, 0.0280021587806661, -0.743273208882405,
0.188792299514343, -1.80495862889104, 1.46555486156289)),
.Names = c("go", "variable", "value"), row.names = c(NA, -68L), class = "data.frame")
代码：
library('ggplot2')
ggplot( data = df1, mapping = aes( x = variable, y = go ) ) + # draw heatmap
geom_tile( aes( fill = value ), colour = "white") +
scale_fill_gradient( low = "white", high = "black",
guide = guide_colorbar(label = TRUE,
draw.ulim = TRUE,
draw.llim = TRUE,
ticks = TRUE,
nbin = 10,
label.position = "bottom",
barwidth = 13,
barheight = 1.3,
direction = 'horizontal')) +
scale_y_discrete(position = "right") +
scale_x_discrete(position = "top") +
coord_flip() +
theme(axis.text.x = element_text(),
axis.title = element_blank(),
axis.ticks = element_blank(),
axis.line = element_blank(),
legend.position = 'bottom',
legend.title = element_blank(),
legend.key = element_rect(colour = "black", size = 4)
)
当前图表：
预期图表
3 个答案:
答案 0 :(得分：13)
现在可以在github版本的ggplot2中使用，截至2018年5月2日，它将成为ggplot2 2.3的一部分：
# devtools::install_github("tidyverse/ggplot2") # do this once, to install github version
library(ggplot2)
ggplot( data = df1, mapping = aes( x = variable, y = go ) ) + # draw heatmap
geom_tile( aes( fill = value ), colour = "white") +
scale_fill_gradient( low = "white", high = "black",
guide = guide_colorbar(label = TRUE,
draw.ulim = TRUE,
draw.llim = TRUE,
# here comes the code change:
frame.colour = "black",
ticks = TRUE,
nbin = 10,
label.position = "bottom",
barwidth = 13,
barheight = 1.3,
direction = 'horizontal')) +
scale_y_discrete(position = "right") +
scale_x_discrete(position = "top") +
coord_flip() +
theme(axis.text.x = element_text(),
axis.title = element_blank(),
axis.ticks = element_blank(),
axis.line = element_blank(),
legend.position = 'bottom',
legend.title = element_blank()
)
具体而言，以下参数已添加到guide_colorbar()：
-
frame.colour颜色条周围框架的颜色。如果NULL，则不会绘制任何框架。 -
frame.linewidth框架的线宽。 -
frame.linetype框架的线型。 -
ticks.colour绘制的刻度线的颜色。 -
ticks.linewidth刻度线的宽度。
这五个参数应该允许最常见的样式。在我看来，更复杂的风格（如外面的刻度线）需要对导游的主题进行一般性的重新思考。
答案 1 :(得分：6)
更新：此答案现已过时。请改用this one。我之所以留下过时的答案只是因为同样的原则适用于其他问题。
ggplot2图例绘图代码有点乱，而且不是很容易定制。我认为获得此效果的唯一方法是对guide_colorbar()进行修改。不幸的是，这需要复制很多ggplot2代码。
我目前正在运行ggplot2的开发版本，因此我发布的确切代码只能保证与之一起运行。 （我今天使用github上的内容，4/27/201）。但该原则也适用于已发布的版本。
一旦我们定义了新的图例函数，首先是绘图代码：
ggplot(data = df1, mapping = aes(x = variable, y = go)) + # draw heatmap
geom_tile(aes(fill = value), colour = "white") +
scale_fill_gradient(low = "white", high = "black",
guide = guide_colorbar2(label = TRUE,
draw.ulim = TRUE,
draw.llim = TRUE,
ticks = TRUE,
nbin = 10,
label.position = "bottom",
barwidth = 13,
barheight = 1.3,
direction = 'horizontal')) +
scale_y_discrete(position = "right") +
scale_x_discrete(position = "top") +
coord_flip() +
theme(axis.text.x = element_text(),
axis.title = element_blank(),
axis.ticks = element_blank(),
axis.line = element_blank(),
legend.position = 'bottom',
legend.title = element_blank(),
legend.key = element_rect(colour = "black", size = 4),
# the following corresponds to 4pt due to current bug
# in legend code; this will hopefully be fixed before
# the next ggplot2 release
legend.spacing.y = grid::unit(40, "pt")
)
您的代码有两处更改。我写了guide_colorbar2而不是guide_colorbar，我在主题代码中添加了legend.spacing.y行，以便将标签从彩条中移开。结果如下：
现在复制的colorbar代码。这主要是来自ggplot2的逐字副本。对于正在使用的所有内部ggplot2函数，我们必须在函数调用前加ggplot:::，例如ggplot2:::width_cm代替width_cm。绘制轮廓的实际更改只有两行代码，并且清楚地标有注释。
# the code below uses functions from these libraries
library(rlang)
library(grid)
library(gtable)
library(scales)
# this is a verbatim copy, with colorbar replaced by colorbar2
# (note also the class statement at the very end of this function)
guide_colorbar2 <- function(
# title
title = waiver(),
title.position = NULL,
title.theme = NULL,
title.hjust = NULL,
title.vjust = NULL,
# label
label = TRUE,
label.position = NULL,
label.theme = NULL,
label.hjust = NULL,
label.vjust = NULL,
# bar
barwidth = NULL,
barheight = NULL,
nbin = 20,
raster = TRUE,
# ticks
ticks = TRUE,
draw.ulim= TRUE,
draw.llim = TRUE,
# general
direction = NULL,
default.unit = "line",
reverse = FALSE,
order = 0,
...) {
if (!is.null(barwidth) && !is.unit(barwidth)) barwidth <- unit(barwidth, default.unit)
if (!is.null(barheight) && !is.unit(barheight)) barheight <- unit(barheight, default.unit)
structure(list(
# title
title = title,
title.position = title.position,
title.theme = title.theme,
title.hjust = title.hjust,
title.vjust = title.vjust,
# label
label = label,
label.position = label.position,
label.theme = label.theme,
label.hjust = label.hjust,
label.vjust = label.vjust,
# bar
barwidth = barwidth,
barheight = barheight,
nbin = nbin,
raster = raster,
# ticks
ticks = ticks,
draw.ulim = draw.ulim,
draw.llim = draw.llim,
# general
direction = direction,
default.unit = default.unit,
reverse = reverse,
order = order,
# parameter
available_aes = c("colour", "color", "fill"), ..., name = "colorbar"),
class = c("guide", "colorbar2")
)
}
# this saves us from copying the code over. Just call the ggplot2
# version of the function
guide_train.colorbar2 <- function(...) {
ggplot2:::guide_train.colorbar(...)
}
# this saves us from copying the code over. Just call the ggplot2
# version of the function
guide_merge.colorbar2 <- function(...) {
ggplot2:::guide_merge.colorbar(...)
}
# this saves us from copying the code over. Just call the ggplot2
# version of the function
guide_geom.colorbar2 <- function(...) {
ggplot2:::guide_geom.colorbar(...)
}
# this is the function that does the actual legend drawing
# and that we have to modify
guide_gengrob.colorbar2 <- function(guide, theme) {
# settings of location and size
switch(guide$direction,
"horizontal" = {
label.position <- guide$label.position %||% "bottom"
if (!label.position %in% c("top", "bottom")) stop("label position \"", label.position, "\" is invalid")
barwidth <- convertWidth(guide$barwidth %||% (theme$legend.key.width * 5), "mm")
barheight <- convertHeight(guide$barheight %||% theme$legend.key.height, "mm")
},
"vertical" = {
label.position <- guide$label.position %||% "right"
if (!label.position %in% c("left", "right")) stop("label position \"", label.position, "\" is invalid")
barwidth <- convertWidth(guide$barwidth %||% theme$legend.key.width, "mm")
barheight <- convertHeight(guide$barheight %||% (theme$legend.key.height * 5), "mm")
})
barwidth.c <- c(barwidth)
barheight.c <- c(barheight)
barlength.c <- switch(guide$direction, "horizontal" = barwidth.c, "vertical" = barheight.c)
nbreak <- nrow(guide$key)
grob.bar <-
if (guide$raster) {
image <- switch(guide$direction, horizontal = t(guide$bar$colour), vertical = rev(guide$bar$colour))
rasterGrob(image = image, width = barwidth.c, height = barheight.c, default.units = "mm", gp = gpar(col = NA), interpolate = TRUE)
} else {
switch(guide$direction,
horizontal = {
bw <- barwidth.c / nrow(guide$bar)
bx <- (seq(nrow(guide$bar)) - 1) * bw
rectGrob(x = bx, y = 0, vjust = 0, hjust = 0, width = bw, height = barheight.c, default.units = "mm",
gp = gpar(col = NA, fill = guide$bar$colour))
},
vertical = {
bh <- barheight.c / nrow(guide$bar)
by <- (seq(nrow(guide$bar)) - 1) * bh
rectGrob(x = 0, y = by, vjust = 0, hjust = 0, width = barwidth.c, height = bh, default.units = "mm",
gp = gpar(col = NA, fill = guide$bar$colour))
})
}
# ********************************************************
# here is the change to draw a border around the color bar
grob.bar <- grobTree(grob.bar,
rectGrob(width = barwidth.c, height = barheight.c, default.units = "mm", gp = gpar(col = "black", fill = NA)))
# ********************************************************
# tick and label position
tic_pos.c <- rescale(guide$key$.value, c(0.5, guide$nbin - 0.5), guide$bar$value[c(1, nrow(guide$bar))]) * barlength.c / guide$nbin
label_pos <- unit(tic_pos.c, "mm")
if (!guide$draw.ulim) tic_pos.c <- tic_pos.c[-1]
if (!guide$draw.llim) tic_pos.c <- tic_pos.c[-length(tic_pos.c)]
# title
grob.title <- ggplot2:::ggname("guide.title",
element_grob(
guide$title.theme %||% calc_element("legend.title", theme),
label = guide$title,
hjust = guide$title.hjust %||% theme$legend.title.align %||% 0,
vjust = guide$title.vjust %||% 0.5
)
)
title_width <- convertWidth(grobWidth(grob.title), "mm")
title_width.c <- c(title_width)
title_height <- convertHeight(grobHeight(grob.title), "mm")
title_height.c <- c(title_height)
# gap between keys etc
hgap <- ggplot2:::width_cm(theme$legend.spacing.x %||% unit(0.3, "line"))
vgap <- ggplot2:::height_cm(theme$legend.spacing.y %||% (0.5 * unit(title_height, "cm")))
# label
label.theme <- guide$label.theme %||% calc_element("legend.text", theme)
grob.label <- {
if (!guide$label)
zeroGrob()
else {
hjust <- x <- guide$label.hjust %||% theme$legend.text.align %||%
if (any(is.expression(guide$key$.label))) 1 else switch(guide$direction, horizontal = 0.5, vertical = 0)
vjust <- y <- guide$label.vjust %||% 0.5
switch(guide$direction, horizontal = {x <- label_pos; y <- vjust}, "vertical" = {x <- hjust; y <- label_pos})
label <- guide$key$.label
# If any of the labels are quoted language objects, convert them
# to expressions. Labels from formatter functions can return these
if (any(vapply(label, is.call, logical(1)))) {
label <- lapply(label, function(l) {
if (is.call(l)) substitute(expression(x), list(x = l))
else l
})
label <- do.call(c, label)
}
g <- element_grob(element = label.theme, label = label,
x = x, y = y, hjust = hjust, vjust = vjust)
ggplot2:::ggname("guide.label", g)
}
}
label_width <- convertWidth(grobWidth(grob.label), "mm")
label_width.c <- c(label_width)
label_height <- convertHeight(grobHeight(grob.label), "mm")
label_height.c <- c(label_height)
# ticks
grob.ticks <-
if (!guide$ticks) zeroGrob()
else {
switch(guide$direction,
"horizontal" = {
x0 = rep(tic_pos.c, 2)
y0 = c(rep(0, nbreak), rep(barheight.c * (4/5), nbreak))
x1 = rep(tic_pos.c, 2)
y1 = c(rep(barheight.c * (1/5), nbreak), rep(barheight.c, nbreak))
},
"vertical" = {
x0 = c(rep(0, nbreak), rep(barwidth.c * (4/5), nbreak))
y0 = rep(tic_pos.c, 2)
x1 = c(rep(barwidth.c * (1/5), nbreak), rep(barwidth.c, nbreak))
y1 = rep(tic_pos.c, 2)
})
segmentsGrob(x0 = x0, y0 = y0, x1 = x1, y1 = y1,
default.units = "mm", gp = gpar(col = "white", lwd = 0.5, lineend = "butt"))
}
# layout of bar and label
switch(guide$direction,
"horizontal" = {
switch(label.position,
"top" = {
bl_widths <- barwidth.c
bl_heights <- c(label_height.c, vgap, barheight.c)
vps <- list(bar.row = 3, bar.col = 1,
label.row = 1, label.col = 1)
},
"bottom" = {
bl_widths <- barwidth.c
bl_heights <- c(barheight.c, vgap, label_height.c)
vps <- list(bar.row = 1, bar.col = 1,
label.row = 3, label.col = 1)
})
},
"vertical" = {
switch(label.position,
"left" = {
bl_widths <- c(label_width.c, vgap, barwidth.c)
bl_heights <- barheight.c
vps <- list(bar.row = 1, bar.col = 3,
label.row = 1, label.col = 1)
},
"right" = {
bl_widths <- c(barwidth.c, vgap, label_width.c)
bl_heights <- barheight.c
vps <- list(bar.row = 1, bar.col = 1,
label.row = 1, label.col = 3)
})
})
# layout of title and bar+label
switch(guide$title.position,
"top" = {
widths <- c(bl_widths, max(0, title_width.c - sum(bl_widths)))
heights <- c(title_height.c, vgap, bl_heights)
vps <- with(vps,
list(bar.row = bar.row + 2, bar.col = bar.col,
label.row = label.row + 2, label.col = label.col,
title.row = 1, title.col = 1:length(widths)))
},
"bottom" = {
widths <- c(bl_widths, max(0, title_width.c - sum(bl_widths)))
heights <- c(bl_heights, vgap, title_height.c)
vps <- with(vps,
list(bar.row = bar.row, bar.col = bar.col,
label.row = label.row, label.col = label.col,
title.row = length(heights), title.col = 1:length(widths)))
},
"left" = {
widths <- c(title_width.c, hgap, bl_widths)
heights <- c(bl_heights, max(0, title_height.c - sum(bl_heights)))
vps <- with(vps,
list(bar.row = bar.row, bar.col = bar.col + 2,
label.row = label.row, label.col = label.col + 2,
title.row = 1:length(heights), title.col = 1))
},
"right" = {
widths <- c(bl_widths, hgap, title_width.c)
heights <- c(bl_heights, max(0, title_height.c - sum(bl_heights)))
vps <- with(vps,
list(bar.row = bar.row, bar.col = bar.col,
label.row = label.row, label.col = label.col,
title.row = 1:length(heights), title.col = length(widths)))
})
# background
grob.background <- ggplot2:::element_render(theme, "legend.background")
# padding
padding <- convertUnit(theme$legend.margin %||% margin(), "mm")
widths <- c(padding[4], widths, padding[2])
heights <- c(padding[1], heights, padding[3])
gt <- gtable(widths = unit(widths, "mm"), heights = unit(heights, "mm"))
gt <- gtable_add_grob(gt, grob.background, name = "background", clip = "off",
t = 1, r = -1, b = -1, l = 1)
gt <- gtable_add_grob(gt, grob.bar, name = "bar", clip = "off",
t = 1 + min(vps$bar.row), r = 1 + max(vps$bar.col),
b = 1 + max(vps$bar.row), l = 1 + min(vps$bar.col))
gt <- gtable_add_grob(gt, grob.label, name = "label", clip = "off",
t = 1 + min(vps$label.row), r = 1 + max(vps$label.col),
b = 1 + max(vps$label.row), l = 1 + min(vps$label.col))
gt <- gtable_add_grob(gt, grob.title, name = "title", clip = "off",
t = 1 + min(vps$title.row), r = 1 + max(vps$title.col),
b = 1 + max(vps$title.row), l = 1 + min(vps$title.col))
gt <- gtable_add_grob(gt, grob.ticks, name = "ticks", clip = "off",
t = 1 + min(vps$bar.row), r = 1 + max(vps$bar.col),
b = 1 + max(vps$bar.row), l = 1 + min(vps$bar.col))
gt
}
答案 2 :(得分：5)
我不确定您是否可以自动执行此操作，但这是使用grid.rect绘制方框的手动方式。您可以更改x，y，width或height以满足您的需求
library(grid)
grid.rect(x= 0.5, y = 0.075, width = 0.355, height = 0.05,
gp = gpar(lwd = 1, col = "black", fill = NA))
查看ggplot2源代码，我猜您可以修改draw_key_rect以获取边框颜色
draw_key_rect <- function(data, params, size) {
rectGrob(gp = gpar(
col = NA,
fill = alpha(data$fill, data$alpha),
lty = data$linetype
))
}
由reprex package（v0.2.0）创建于2018-04-27。
相关问题
最新问题
- 我写了这段代码，但我无法理解我的错误
- 我无法从一个代码实例的列表中删除 None 值，但我可以在另一个实例中。为什么它适用于一个细分市场而不适用于另一个细分市场？
- 是否有可能使 loadstring 不可能等于打印？卢阿
- java中的random.expovariate()
- Appscript 通过会议在 Google 日历中发送电子邮件和创建活动
- 为什么我的 Onclick 箭头功能在 React 中不起作用？
- 在此代码中是否有使用“this”的替代方法？
- 在 SQL Server 和 PostgreSQL 上查询，我如何从第一个表获得第二个表的可视化
- 每千个数字得到
- 更新了城市边界 KML 文件的来源？