R：如何在 ggplotly 中修改图例？

Question

我有 ggPlotly 可视化的水平点图。 3个数值变量被放在图上。 一切正常：

library(ggplot2)

    df <- data.frame (origin = c("A","B","C","D","E","F","G","H","I","J"),
                  Percentage = c(23,16,32,71,3,60,15,21,44,60),
                  rate = c(10,12,20,200,-25,12,13,90,-105,23),
                  change = c(10,12,-5,12,6,8,0.5,-2,5,-2))

plt <- ggplot(df, aes(x = rate, y = factor(origin, rev(origin)))) +
  geom_segment(aes(x = (min(rate,change)-4), xend = (max(rate,change)+4),
                   y = origin, yend = origin), color = 'gray') +
  geom_vline(xintercept = 0, linetype = 2, color = 'gray') +
  #geom_vline(xintercept =17, linetype = 1, color = 'black') +
  geom_point(aes(fill = 'rate'), shape = 21, size = 10, color = NA) +
  geom_text(aes(label = rate, color = 'rate')) +
  geom_point(aes(x = change, fill = 'change'), 
             color = NA, shape = 21, size = 10) +
  geom_text(aes(label = change, x = change, color = "change")) +
  geom_point(aes(x = (max(rate,change)+5.5), fill = "Percentage"), color = "gray",
             size = 10, shape = 21) +
  geom_text(aes(x = (max(rate,change)+5.5), label = paste0(Percentage, "%")),size=3)+
  theme_minimal(base_size = 16) +
  scale_x_continuous(labels = ~paste0(.x, '%'), name = NULL) +
  scale_fill_manual(values = c('#aac7c4', '#5f9299','black')) +
  scale_color_manual(values = c("black", "white")) +
  theme(panel.grid = element_blank(),
        axis.text.y = element_text(color = 'gray50')) +
  labs(color = NULL, y = NULL, fill = NULL)+
  theme(axis.title = element_text(size=15), legend.title = element_text(size=2)) 

plt <- ggplotly(plt)

#customize legend
plt$x$data[[3]]$name <- plt$x$data[[3]]$legendgroup <-
  plt$x$data[[4]]$name <- plt$x$data[[4]]$legendgroup <- "rate"
plt$x$data[[5]]$name <- plt$x$data[[5]]$legendgroup <-
  plt$x$data[[6]]$name <- plt$x$data[[6]]$legendgroup <- "change"
plt$x$data[[7]]$name <- plt$x$data[[7]]$legendgroup <-
  plt$x$data[[8]]$name <- plt$x$data[[8]]$legendgroup <- "Percentage"

plt

但是，当我激活 (remove #) geom_vline(xintercept =17, linetype = 1, color = 'black')代码行时，为了在绘图上添加垂直线，从图例中隐藏变量无法正常工作。 例如，如果我们隐藏 'change' 变量：'rate' 的数字消失了，而其中一些仍然显示。 我认为解决方案应该在plt$x$data中找到。 另外，我想按百分比从上到下对分类变量“原点”进行排序，例如，如果J的百分比最高，它应该在顶部，而且，如果可能的话，我不这样做，但我想保留A在排名中总是垫底。

Answer 1

如果您仍然希望 A 在底部（尽管@Allan Cameron 的答案看起来很棒！），这将按百分比排序，并将 A 保持在底部。

保持你的情节和数据在你的问题中，我开始构建情节。

plt2 <- plotly_build(plt)

要按百分比重新排序值，而不是“A”，我按Percentage重新排序数据添加的行号，并对其进行排序以匹配图中的顺序。 然后我用它来重新排列图中的 y 轴。 我在这段代码中留下了我的检查和平衡，所以它可能看起来很多，但其中很多是验证。

# determine the rearrangement
nOrder = df %>% 
  filter(origin != "A") %>% 
  arrange(Percentage) %>%   # desired order (other than A*)
  mutate(rn = 2:nrow(df)) %>%
  arrange(origin)
# add A as last
nOrder = rbind(c(unlist(df[df$origin == "A", ], use.names = F),
                 1), nOrder) %>% 
  mutate(across(c(Percentage, rn), as.integer))
# take a look
str(nOrder)

# create the vector with the order modifier
gimme <- unlist(nOrder$rn, use.names = F)

# expected order
(eo = append("A", df[df$origin != "A", ] %>% arrange(Percentage) %>% 
               select(origin) %>% unlist(use.names = F)))

# validgate gimme is set correctly
plt2$x$layout$yaxis$categoryarray
# check
plt2$x$layout$yaxis$categoryarray[order(gimme)]
all.equal(plt2$x$layout$yaxis$ticktext[order(gimme)], eo) # TRUE

现在是时候重新排列 y 轴了。 由于ggplot <-> plotly翻译，有一些事情必须改变。 range （或者它会隐藏 A 并在顶部添加无用的空格）并且需要更改type以及顺序。 使用参数categoryarray设置顺序。

# finally change the plot's y-axis
plt2 %>% layout(yaxis = list(range = c(-.5, 10),
                             categoryarray = (1:10)[order(gimme)],
                             type = "category")) -> plt2
plt2

添加重新排序后，我注意到垂直线不再可见。 我再次创建了线条。 （这是由于 y 轴的变化。）

lines <- function(x = 0, dash = "solid", color = "black"){
  list(type = "line",
       x0 = x, x1 = x, y0 = 0, y1 = 1, 
       xref = "x", yref = "paper",
       layer = "below",
       line = list(color = color,
                   dash = dash))
}
plt2$x$layout$shapes <- list(plt2$x$layout$shapes,
                             lines(17), 
                             lines(dash = "longdash",
                                   color = "gray"))

现在为传奇名称。 有很多方法可以做到这一点。 我注意到你做对了，添加了一个图层，然后出现了问题。 您可以使用正则表达式，而不是挑选。 另一种选择是检查以找到要更改的痕迹。

# change the applicable traces with conditions and regex
# fixes legend regardless of where or what order the traces fall in
invisible(
  lapply(1:length(plt2$x$data),
          function(j) {
            i = plt2$x$data[[j]]$name
            if(!is.null(i)){
              i = sub(".([[:alpha:]]+).*", "\\1", i)
              plt2$x$data[[j]]$name <<- 
                plt2$x$data[[j]]$legendgroup <<- i
            }
          })
  )

# if you just wanted to investigate
invisible(
  lapply(1:length(plt2$x$data),
         function(k) {
           message(k, ' ', plt2$x$data[[k]]$name) 
         }
))

现在你只需要调用情节。

plt2

Answer 2

按百分比对origin列进行排序很简单。 这是在数据级别完成的，通过将origin转换为一个因子，其级别由Percentage的值确定：

df$origin <- factor(df$origin, df$origin[order(df$Percentage)])

您的自定义图例发生奇怪事情的原因是您在某些现有图层之前添加了一个图层，这会导致您在最后修改图例组时使用的索引无效。 最简单的解决方法是在现有图层之后画线：

plt <- ggplot(df, aes(x = rate, y = factor(origin, rev(origin)))) +
  geom_segment(aes(x = (min(rate,change)-4), xend = (max(rate,change)+4),
                   y = origin, yend = origin), color = 'gray') +
  geom_vline(xintercept = 0, linetype = 2, color = 'gray') +
  geom_point(aes(fill = 'rate'), shape = 21, size = 10, color = NA) +
  geom_text(aes(label = rate, color = 'rate')) +
  geom_point(aes(x = change, fill = 'change'), 
             color = NA, shape = 21, size = 10) +
  geom_text(aes(label = change, x = change, color = "change")) +
  geom_point(aes(x = (max(rate,change)+5.5), fill = "Percentage"), 
             color = "gray", size = 10, shape = 21) +
  geom_text(aes(x = (max(rate,change)+5.5), label = paste0(Percentage, "%")),
            size = 3)+
    geom_vline(xintercept =17, linetype = 1, color = 'black') +
  theme_minimal(base_size = 16) +
  scale_x_continuous(labels = ~paste0(.x, '%'), name = NULL) +
  scale_fill_manual(values = c('#aac7c4', '#5f9299','black')) +
  scale_color_manual(values = c("black", "white")) +
  theme(panel.grid = element_blank(),
        axis.text.y = element_text(color = 'gray50')) +
  labs(color = NULL, y = NULL, fill = NULL)+
  theme(axis.title = element_text(size=15), legend.title = element_text(size=2)) 

plt <- ggplotly(plt)

现在您可以像以前一样自定义图例组：

#customize legend
plt$x$data[[3]]$name <- plt$x$data[[3]]$legendgroup <-
  plt$x$data[[4]]$name <- plt$x$data[[4]]$legendgroup <- "rate"
plt$x$data[[5]]$name <- plt$x$data[[5]]$legendgroup <-
  plt$x$data[[6]]$name <- plt$x$data[[6]]$legendgroup <- "change"
plt$x$data[[7]]$name <- plt$x$data[[7]]$legendgroup <-
  plt$x$data[[8]]$name <- plt$x$data[[8]]$legendgroup <- "Percentage"

plt

如果您希望线条位于所有点和文本的后面，请保持现有的绘图代码不变，并增加图例分组代码中的所有索引：

#customize legend
plt$x$data[[4]]$name <- plt$x$data[[4]]$legendgroup <-
  plt$x$data[[5]]$name <- plt$x$data[[5]]$legendgroup <- "rate"
plt$x$data[[6]]$name <- plt$x$data[[6]]$legendgroup <-
  plt$x$data[[7]]$name <- plt$x$data[[7]]$legendgroup <- "change"
plt$x$data[[8]]$name <- plt$x$data[[8]]$legendgroup <-
  plt$x$data[[9]]$name <- plt$x$data[[9]]$legendgroup <- "Percentage"