R 绘制独立的函数图例

Question

我想通过 R 绘制具有独立图例的图，同时尊重色阶。

这就是我所拥有的：

library(plotly)

X <- data.frame(xcoord = 1:6,
                ycoord = 1:6,
                score  = 1:6,
                gender = c("M", "M", "M", "F", "F", "F"),
                age = c("young", "old", "old", "old", "young", "young"))

plot_ly(data = X, x = ~xcoord, y = ~ycoord, split = ~interaction(age, gender),
        type = "scatter", mode = "markers",
        marker = list(color = ~score,
                      colorbar = list(len = .5, y = .3)))

这就是结果：

如您所见，颜色条混乱，两个类别纠缠在一起。

我需要为age（年轻与年老）和gender（M vs F）提供单独的图例，可以相互独立地单击。这将是预期的结果：

---

编辑 1
这与 ggplot2 等效：

gg <- ggplot(X, aes(x = xcoord, y = ycoord)) +
  geom_point(aes(color = score, shape = gender, alpha = age), size = 5) +
  scale_shape_manual(values = c("M" = 19, "F" = 19)) +
  scale_alpha_manual(values = c("young" = 1, "old" = 1))

ggplotly(gg)

它在 ggplot 中正确显示，但在应用 ggplotly() 时中断。

请注意，我更喜欢使用原生 plotly 图的解决方案，而不是像其他方案中提出的事后 ggplotly() 修复方案帖子。

---

编辑2
尽管当前的答案确实解开了两个图例（age 和 gender），但它们不起作用。例如，如果您单击young级别，整个age图例将打开/关闭。这里的目标是每个图例的每个子级别都可以独立于其他级别进行切换，并且通过单击图例的级别，点将相应地显示/隐藏。

Answer 1

Plotly 似乎不容易支持这一点，因为不同的指南链接到多个跟踪。因此，取消选择“年龄”轨迹上的“旧”不会从“性别”轨迹的单独点集中删除任何内容。

这是使用crosstalk 和SharedData 数据对象的解决方法。这不是（取消）选择绘图轨迹，而是在绘图使用的数据集上使用过滤器。它在技术上实现了所请求的选择行为，但它是否是一个可行的解决方案取决于最终的应用程序。如果该机制适合您，可能有多种方法可以调整样式和布局，使其更具情节性。

library(crosstalk)

#SharedData object used for filters and plot
shared <- SharedData$new(X) 

crosstalk::bscols(
  widths = c(2, 10),
   list(
     crosstalk::filter_checkbox("Age", 
                                label = "Age",
                                sharedData = shared, 
                                group = ~age),
     crosstalk::filter_checkbox("Gender", 
                                label = "Gender",
                                sharedData = shared, 
                                group = ~gender)
   ),
   plot_ly(data = shared, x = ~xcoord, y = ~ycoord,
           type = "scatter", mode = "markers",
           marker = list(color = ~score,
                         colorbar = list(len = .5, y = .3),
                         cmin = 0, cmax = 6)) %>%
    layout(
      xaxis = list(range=c(.5,6.5)),
      yaxis = list(range=c(.5,6.5))
    )
   )

编辑：将所有复选框初始化为“已选中”

我只能通过修改输出 HTML 标签来做到这一点。这会产生相同的图，但在一开始就选中了所有框。

out <- crosstalk::bscols(...) #previous output object

library(htmltools)
out_tags <- htmltools::renderTags(out)

#check all Age and Gender checkboxes
out_tags$html <- stringr::str_replace_all(
  out_tags$html, 
  '(<input type="checkbox" name="(Age|Gender)" value=".*")/>',
  '\\1 checked="checked"/>'
)
out_tags$html <- HTML(out_tags$html)
# view in RStudio Viewer
browsable(as.tags(out_tags))
#or from Rmd chunk
as.tags(out_tags)

Answer 2

这不正是您要寻找的。不过，我能够创建一个有意义的颜色条。

我删除了对组之间交互的调用并创建了一个单独的跟踪。然后，我创建了图例组并命名它们，以便为 gender 和 age 创建单独的图例。当我将 color = 从创建颜色条的调用中拉出时，这会同步色标。

然而，它为年龄和性别标签分配颜色，这是没有意义的！有一些内容与您的要求不符，但有人可能能够根据此信息进行构建。

plot_ly(data = X, x = ~xcoord, y = ~ycoord, 
        split = ~age,
        legendgroup = 'age', # create first split and name it
        legendgrouptitle = list(text = "Age"),
        type = "scatter", mode = "markers",
        color = ~score,
        marker = list(colorbar = list(len = .5, y = .3))) %>% 
  add_trace(split = ~gender,
            legendgroup = 'gender', # create second split and name it
            color = ~score,
            legendgrouptitle = list(text = "Gender")) %>% 
    colorbar(title = 'Score')

Answer 3

我不确定这是否正是您想要的。我尝试使用两个标记来制作年龄和性别的图例。图例是独立可点击的，但我不确定这是否是您希望它们可点击的方式。也可以单击颜色栏。您可以使用以下代码：

library(tidyverse)
library(plotly)
plot_ly() %>%
  add_markers(data = X,
            x = ~xcoord, 
            y = ~ycoord, 
            type = "scatter", 
            mode = "markers",
            #name = "M",
            color = I("grey"),
            split = ~gender,
            legendgroup = 'gender', 
            legendgrouptitle = list(text = "Gender")) %>%
  add_markers(data = X,
              x = ~xcoord, 
              y = ~ycoord, 
              type = "scatter", 
              mode = "markers",
              #name = "M",
              color = I("grey"),
              split = ~age,
              legendgroup = 'age', 
              legendgrouptitle = list(text = "Age")) %>%
  add_trace(data = X,
            x = ~xcoord, 
            y = ~ycoord, 
            type = "scatter", 
            mode = "markers",
            name = "",
            marker = list(color = ~score,
                          colorbar = list(len = .5, y = .3)))

输出如下所示：