更改 gge 图中的标签颜色

问题描述 投票：0回答：1

我正在尝试更改标签的颜色，似乎颜色矢量的输入适用于线条而不适用于标签，并且标签颜色只是矢量列表的第一种颜色。 也许有解决方法？理想情况下，我希望根据一组拉特说“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
r
1个回答
0
投票

这是一种从 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())

1

最新问题
© www.soinside.com 2019 - 2024. All rights reserved.