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

但是，当我激活（删除＃）geom_vline（xintercept = 17，lineType = 1，color ='black'）代码行，以便在图上添加垂直线，隐藏变量传说无法正常工作。例如，如果我们隐藏“更改”变量：“速率”的数量消失，而其中一些仍显示。我认为该解决方案应在plt $ x $ data中找到。 此外，我想订购分类变量“起源从上到下以百分比下降，例如，如果 j 具有最高的百分比，那么它应该位于顶部，而且，我也不会可能是可能

的src =“ https://i.sstatic.net/h2hu7.png” alt =“在此处输入图像说明”>

Answer 1

按百分比订购Origin列很简单。通过将Origin转换为其级别由百分比的值确定的因素，这是在数据级别完成的：

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"

Answer 2

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

保持您的情节和数据与您的问题一样，我开始构建情节。

plt2 <- plotly_build(plt)

为了通过百分比（除“ A”）重新排序该值，我通过百分比添加了行号，并订购了该数据以匹配图中的订单。然后，我用它在图中重新排序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＆lt; - ＆gt;，必须更改一些事情。 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"))

现在，对于传奇名称。有很多方法可以做到这一点。我注意到您的正确性，添加了一层，然后遇到了问题。您可以使用Regex，而不是摘录。另一个选择是检查以找到更改的轨迹。

# 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