避免使用 facet_wrap 从 ggplot 进行情节转换中的图例重复

Posted 2023-02-16

【中文标题】避免使用 facet_wrap 从 ggplot 进行情节转换中的图例重复

【英文标题】：Avoid legend duplication in plotly conversion from ggplot with facet_wrap

【发布时间】：2021-11-16 05:44:45

【问题描述】：

考虑由以下代表产生的情节。请注意，ggplot 具有合理的图例，而在 plotly 中，图例被大量重复，每次同一类别（“制造商”）出现在每个方面时都有一个条目。如何使情节图例更好地匹配 ggplot2 的图例？

library(plotly)
library(ggplot2)

p <- mpg %>% 
  ggplot(aes(year)) +
  geom_ribbon(aes(ymin=cty, ymax=hwy, fill = manufacturer), alpha=0.2) + 
  geom_line(aes(y = hwy, col=manufacturer))  +
  facet_wrap(~class)
p

plotly::ggplotly(p)

【参考方案1】：

感谢@stefan，您的出色回答既教会了我有关情节对象的知识，又启发了我进一步发展您的概念。

我创建了具有以下功能的函数：

它将您的逻辑转换为使用 plotly 对象作为输入的函数。 它应用了 purrr 库。 该函数接受允许覆盖图例条目的可选第二个参数 (.new_legend)。

代码肯定比你的代码长，尽管它被函数 assign_leg_grp 拉长了，它支持覆盖，也被我的“展开”样式。

library(plotly)
library(ggplot2)
library(purrr)
library(stringr)

p <- mpg %>% 
  ggplot(aes(year)) +
  geom_ribbon(aes(ymin=cty, ymax=hwy, fill = manufacturer), alpha=0.2) + 
  geom_line(aes(y = hwy, col=manufacturer))  +
  facet_wrap(~class)

gp <- ggplotly(p = p)

clean_pltly_legend <- function(.pltly_obj, .new_legend = c()) 
  # Cleans up a plotly object legend, particularly when ggplot is facetted
  
  assign_leg_grp <- function(.legend_group, .leg_nms) 
    # Assigns a legend group from the list of possible entries
    # Used to modify the legend settings for a plotly object
    
    leg_nms_rem <- .leg_nms
    
    parse_leg_nms <- function(.leg_options) 
      # Assigns a .leg_name, if possible
      # .leg_options is a 2-element list: 1 = original value; 2 = remaining options
      
      if (is.na(.leg_options)) 
        .leg_options
       else if(length(leg_nms_rem) == 0) 
        # No more legend names to assign
        .leg_options
       else 
        # Transfer the first element of the remaining options
        leg_nm_new <- leg_nms_rem[[1]]
        leg_nms_rem <<- leg_nms_rem[-1]
        
        leg_nm_new
      
      
    
    
    .legend_group %>% 
      map(~ parse_leg_nms(.))
    
  
  
  simplify_leg_grps <- function(.legendgroup_vec) 
    # Simplifies legend groups by removing brackets, position numbers and then de-duplicating
    
    leg_grp_cln <-
      map_chr(.legendgroup_vec, ~ str_replace_all(., c("^\\(" = "", ",\\d+\\)$" = "")))
    
    modify_if(leg_grp_cln, duplicated(leg_grp_cln), ~ NA_character_)
    
  
  
  pltly_obj_data <-
    .pltly_obj$x$data
  
  pltly_leg_grp <-
    # pltly_leg_grp is a character vector where each element represents a legend group. Element is NA if legend group not required or doesn't exist
    pltly_obj_data%>% 
    map(~ pluck(., "legendgroup")) %>% 
    map_chr(~ if (is.null(.)) NA_character_ else .) %>%
    # Elements where showlegend = FALSE have legendgroup = NULL. 
    
    simplify_leg_grps() %>% 
    
    assign_leg_grp(.new_legend) 
  
  pltly_obj_data_new <-
    pltly_obj_data %>% 
    map2(pltly_leg_grp, ~ list_modify(.x, legendgroup = .y)) %>%
    map2(pltly_leg_grp, ~ list_modify(.x, name = .y)) %>%
    map2(pltly_leg_grp, ~ list_modify(.x, showlegend = !is.na(.y)))
  # i.e. showlegend set to FALSE when is.na(pltly_leg_grp), TRUE when not is.na(pltly_leg_grp)
  
  .pltly_obj$x$data <- pltly_obj_data_new
  
  .pltly_obj
  


clean_pltly_legend(gp)

【参考方案2】：

根据您的情况调整我在this 帖子上的回答（利用此answer），一种选择是操纵plotly 对象。

问题在于，对于分面，我们最终会为存在组的每个分面创建一个图例条目，即图例条目中的数字对应于分面或面板的编号。

在plotly 中，可以通过legendgroup 参数防止重复的图例条目。使用ggplotly 时获得相同结果的一种选择是手动分配legendgroup，如下所示：

library(plotly)
library(ggplot2)

p <- mpg %>% 
  ggplot(aes(year)) +
  geom_ribbon(aes(ymin=cty, ymax=hwy, fill = manufacturer), alpha=0.2) + 
  geom_line(aes(y = hwy, col=manufacturer))  +
  facet_wrap(~class)

gp <- ggplotly(p = p)

# Get the names of the legend entries
df <- data.frame(id = seq_along(gp$x$data), legend_entries = unlist(lapply(gp$x$data, `[[`, "name")))
# Extract the group identifier
df$legend_group <- gsub("^\\((.*?),\\d+\\)", "\\1", df$legend_entries)
# Add an indicator for the first entry per group
df$is_first <- !duplicated(df$legend_group)

for (i in df$id) 
  # Is the layer the first entry of the group?
  is_first <- df$is_first[[i]]
  # Assign the group identifier to the name and legendgroup arguments
  gp$x$data[[i]]$name <- df$legend_group[[i]]
  gp$x$data[[i]]$legendgroup <- gp$x$data[[i]]$name
  # Show the legend only for the first layer of the group 
  if (!is_first) gp$x$data[[i]]$showlegend <- FALSE

gp

【讨论】：

谢谢！我注意到这不是必需的，例如，如果我放弃geom_line() 呼叫，这对我来说更像是一个错误？我在情节方面并不是特别有经验，所以不想为我自己的错误提交错误报告！

另请注意，反之亦然，注释掉 geom_ribbon 会导致线迹的单个图例项。这似乎与使用多种跟踪类型有关。此外，使用上面的代码（带有重复的图例项），线迹没有图例项。从我的角度来看，值得提出一个问题。