用于子图的Plotly legendgroup，因此单个图例控制所有图表

Question

我在plotly中使用r生成了许多子图。玩具示例如下所示。

library(shiny)
library(dplyr)
library(plotly)

## Toy Example
ui <- fluidPage(
  h3("Diamonds"),
  plotlyOutput("plot", height = 600)
)

server <- function(input, output, session) {

  # reduce down the dataset to make the example simpler
  dat <- diamonds %>% 
    filter(clarity %in% c("I1", "IF")) %>%
    mutate(clarity = factor(clarity, levels = c("I1", "IF")))

  output$plot <- renderPlotly({

    # Generates the chart for a single clarity
    byClarity <- function(df){

      Clarity <- df$clarity[1];

      plot_ly(df, x = ~carat, y = ~price, color = ~cut, name = ~clarity) %>%
        add_trace(
          type="bar"
          ## Also tried adding this with no success
          # legendgroup = ~cut
        ) %>%
        layout(
          barmode = "stack"
        )
    }

    dat %>% 
      split(.$clarity) %>% 
      lapply(byClarity) %>%
      subplot(nrows = NROW(.), shareX = TRUE, which_layout = "merge")
  })
} 

shinyApp(ui, server)

我想传说，点击“剪切”字样。在图例上将显示/隐藏“剪切”字样。来自两个图表，而不仅仅是与该图例相关联的图表。

我查看了图例组，但无法弄清楚如何将其与cut相关联，而不是clarity（clarity是我用来制作次要情节）。

我还需要使用解决方案来处理原始plot_ly而不是ggplotly，因为我需要的其他plot_ly功能在{{1}中不可用}。

任何帮助将不胜感激。我使用的是ggplotly，plotly_4.5.2和dplyr_0.5.0。

Answer 1

好的，这是使用ggplot2的解决方案：

library(ggplot2)
library(dplyr)
library(plotly)
dat <- diamonds %>% 
  filter(clarity %in% c("I1", "IF")) %>%
  mutate(clarity = factor(clarity, levels = c("I1", "IF")))
# Function for nice labels
k_label <- function(x) {
 c(0, paste0((x)/1000,"K")[-1])
}
# ggplot
p <- ggplot(dat,aes(x=carat, y=price, fill=cut)) + 
           geom_bar(stat="identity") + 
           facet_wrap(~clarity,nrow=2, scales = "free_y") +
           scale_y_continuous(labels = k_label) + 
           theme_minimal() + ylab("") + xlab("") +
           theme(legend.title=element_blank(),
                 panel.grid.major.x=element_blank())
# a plotly
ggplotly(p)

Answer 2

尝试将legendgroup = ~cut添加到两个跟踪中，并为其中一个设置showlegend = F。然后在布局集showlegend = T

中

像这样：

plot_ly(df, x = ~carat, y = ~price, color = ~cut, name = ~clarity, legendgroup = ~cut, showlegend = T) %>%
    add_trace( type="bar", legendgroup = ~cut, showlegend = F) %>%
    layout(
      barmode = "stack",showlegend = T
    )