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"