我正在尝试更改标签的颜色,似乎颜色矢量的输入适用于线条而不适用于标签,并且标签颜色只是矢量列表的第一种颜色。 也许有解决方法?理想情况下,我希望根据一组拉特说“drev”有彩色标签,因此多个条目将具有相同的颜色。不确定这是否可能,但至少可以使用颜色向量来实现。
这是我尝试对 mpg 数据执行的操作的示例。
library(metan)
data <- mpg
gge_model <- gge(data,
env=cyl,
gen=manufacturer,
displ, #Choose trait
centering="environment",
scaling="none",
svp = "genotype",
by=NULL)
p <- plot(gge_model,
type = 2,
repel=TRUE,
repulsion=1,
max_overlaps = 20,
col.gen = c(
"black", "#ff7f0e", "#2ca02c", "#d62728", "#9467bd",
"#8c564b", "#e377c2", "#7f7f7f", "#bcbd22", "#17becf",
"#393b79", "#637939", "#8c6d31", "#843c39", "#7b4173"
),
col.env = "blue",
line.type = 'solid', # in the manual solid should be default but it is dotted in fact
title = FALSE,
size.text.env = 3,
size.text.gen = 3,
size.line=2,
plot_theme=theme_metan(grid = "none", col.grid = "white", color.background = "white"))+
labs(title = element_text("p"))
p
这是一种从 p 中提取绘图元素并使用它们创建带有
ggplot2
的绘图的方法。原始图的标签位置不太好,所以我使用了 ggrepel()
来确保标签不会重叠。因此,这个解决方案并不像我希望的那样具有普遍性。如果您需要定期创建这些,我建议您使用图例。
首先,加载包并创建绘图:
library(metan)
library(dplyr)
library(ggplot2)
library(ggrepel)
data <- mpg
gge_model <- gge(data,
env = cyl,
gen = manufacturer,
displ, #Choose trait
centering = "environment",
scaling = "none",
svp = "genotype",
by = NULL)
p <- plot(gge_model,
type = 2,
repel=TRUE,
repulsion=1,
max_overlaps = 20,
col.gen = c(
"black", "#ff7f0e", "#2ca02c", "#d62728", "#9467bd",
"#8c564b", "#e377c2", "#7f7f7f", "#bcbd22", "#17becf",
"#393b79", "#637939", "#8c6d31", "#843c39", "#7b4173"
),
col.env = "blue",
line.type = 'solid', # in the manual solid should be default but it is dotted in fact
title = FALSE,
size.text.env = 3,
size.text.gen = 3,
size.line=2,
plot_theme=theme_metan(grid = "none", col.grid = "white", color.background = "white"))+
labs(title = element_text("p"))
现在运行
str(p)
,这将显示构成p的各个元素。例如:
# Examine the plot text labels element
head(p[[1]], 5)
# d1 d2 type label
# 1 -0.9523347 -0.005994725 genotype audi
# 2 0.8794161 -0.492125224 genotype chevrolet
# 3 0.3250020 0.106245252 genotype dodge
# 4 0.4362054 0.512391184 genotype ford
# 5 -1.6713114 -0.042941542 genotype honda
为了使绘图更容易,请创建 p:
的本机
ggplot2
版本
# Return ggplot build object
p1 <- ggplot_build(p)
# Examine the equivalent ggplot text labels element
head(p1$data[[7]], 5)
# colour size label x y group PANEL angle hjust vjust alpha family fontface lineheight
# 1 black 3 audi -0.9523347 -0.005994725 1 1 0 0.5 0.5 NA 1 1.2
# 2 black 3 chevrolet 0.8794161 -0.492125224 1 1 0 0.5 0.5 NA 1 1.2
# 3 black 3 dodge 0.3250020 0.106245252 1 1 0 0.5 0.5 NA 1 1.2
# 4 black 3 ford 0.4362054 0.512391184 1 1 0 0.5 0.5 NA 1 1.2
# 5 black 3 honda -1.6713114 -0.042941542 1 1 0 0.5 0.5 NA 1 1.2
运行
p1
,然后查找您需要的元素。在这种情况下,为 p1$data[[1]]
、p1$data[[2]]
p1$data[[3]]
、p1$data[[4]]
、p1$data[[5]]
和 p1$data[[7]]
。组合 p1$data[[3]]
和 p1$data[[7]]
元素将使绘图更容易(部分原因是 p1$data[[7]]
没有所需的颜色值)。因为它们的长度不同,所以需要一些额外的操作:
# Return line geometry, add id for join
lines_df <- data.frame(p1$data[[3]]) |>
mutate(id = 1:n())
# Return labels data, add id for join
labels_df <- data.frame(p1$data[[7]]) |>
mutate(id = 1:n()) |>
select(-colour)
# Set colour for Xn values (based on original plot, must be distinct from all other colour values)
x_col <- "blue"
# Join and identify whether object above/below x slope
df <- left_join(labels_df,
lines_df[, c("id", "xend", "yend", "colour")],
by = "id") |>
mutate_if(is.numeric, replace_na, 0) |>
mutate(colour = if_else(is.na(colour), x_col, colour),
lab_loc = case_when(y > yend ~ "up",
y <= yend ~ "down"))
使用
ggrepel
需要大量的尝试和错误。通过添加 lab_loc 列,这将降低一些复杂性。对于此表示,使用 y 值来确定“向上”和“向下”是有意义的。必要时进行调整。下面绘制了 df 和 p 中的一些元素,例如轴标签:
# Set plot variables for lines and labels (not exhaustive, add more for greater flexibility)
hline_w <- 0.1
abline_w <- 0.5
seg_w <- 2
txt_size <- 3.5
nudge_txt <- 0.6
ggplot() +
geom_hline(data = p1$data[[1]],
aes(yintercept = yintercept),
linewidth = hline_w) +
geom_vline(data = p1$data[[2]],
aes(xintercept = xintercept),
linewidth = hline_w) +
geom_abline(data = p1$data[[4]],
aes(intercept = intercept,
slope = slope,
colour = colour),
linewidth = abline_w) +
geom_abline(data = p1$data[[5]],
aes(intercept = intercept,
slope = slope,
colour = colour),
linewidth = abline_w) +
geom_point(data = filter(df, colour == x_col),
aes(x = x, y = y, colour = colour)) +
geom_segment(data = filter(df, colour != x_col),
aes(x = x, y = y,
xend = xend, yend = yend,
colour = colour),
linewidth = seg_w) +
geom_label_repel(data = filter(df, lab_loc == "down"),
aes(x = x, y = y,
label = label,
colour = colour),
fill = "#ffffff80",
size = txt_size,
box.padding = 0.5,
point.padding = 0.5,
label.padding = 0,
label.size = NA,
nudge_y = nudge_txt * -1,
segment.size = 0.5,
segment.color = "grey85",
force = .1,
max.overlaps = Inf) +
geom_label_repel(data = filter(df, lab_loc == "up"),
aes(x = x, y = y,
label = label,
colour = colour),
fill = "#ffffff80",
size = txt_size,
box.padding = 0.5,
point.padding = 0.5,
label.padding = 0,
label.size = NA,
nudge_y = nudge_txt,
segment.size = 0.5,
segment.color = "grey85",
force = .1,
max.overlaps = Inf) +
scale_colour_identity() +
labs(title = "p",
x = p$labels$x,
y = p$labels$y) +
scale_x_continuous(limits = c(-2, 1.5),
breaks = seq(-2, 1.5, 0.5)) +
coord_cartesian(xlim = c(-2, 1.5),
ylim = c(-1.5, 1.5),
expand = FALSE) +
theme(panel.background = element_blank())