r - 通过绘图下拉菜单切换显示的轨迹

Question

我正在使用 R 编程语言。我正在尝试将本教程复制到我自己的数据中:https://plotly.com/r/dropdowns/
我创建了一些假数据并绘制了 4 个图:

#load libraries 

library(plotly)
library(MASS)
library(dplyr)


# create data

x <- sample( LETTERS[1:4], 731, replace=TRUE, prob=c(0.25, 0.25, 0.25, 0.25) )
y <- rnorm(731,10,10)
z <- rnorm(731,5,5)
date= seq(as.Date("2014/1/1"), as.Date("2016/1/1"),by="day")
    
    df <- data.frame(x,y, z, date)
df$x = as.factor(df$x)



# plot 1 : time series

 aggregate = df %>%
        mutate(date = as.Date(date)) %>%
        group_by(month = format(date, "%Y-%m")) %>%
        summarise( mean = mean(y))

ts_1 <- ggplot(aggregate) + geom_line(aes(x = month, y = mean, group = 1)) +  theme(axis.text.x = element_text(angle = 90)) + ggtitle("time series 1")

plot_1 = ggplotly(ts_1)



#plot 2 : box plot

plot_2 <- plot_ly(df, y = ~y, color = ~x, type = "box") %>% layout(title = "boxplot")



#plot 3, 4 : scatter plots

df_1 <- df[which(df$x == "A"),]
df_2 <- df[which(df$x == "B"),]


plot_3 <- plot_ly( data = df_1, type = "scatter", mode = "markers", x = ~ y, y = ~z) %>% layout(title = "graph 3")

plot_4 <- plot_ly( data = df_2, type = "scatter", mode = "markers", x = ~ y, y = ~z) %>% layout(title = "graph 4")

创建这 4 个图后，我知道如何将它们保存在一起:

sub = subplot(plot_1, plot_2, plot_3, plot_4, nrows = 2)
#view result
sub

现在我要做的是让用户在这些图表之间“切换”(切换)(如下所示: https://plotly.com/r/dropdowns/ )
在上一篇文章 ( R: Switching Between Graphs ) 中，我学习了如何将相似的图形“粘合”在一起(例如 4 个散点图)。现在，我正在尝试使用不同的图表(2 个散点图、1 个时间序列和 1 个箱线图)。我尝试修改上一篇文章中的代码以适合我的示例:

fig <- df %>% 
  add_trace(name = "A", plot_1) %>% 
  add_trace (name = "B" , df, y = ~y, color = ~x, type = "box") %>% layout(title = "boxplot")
  add_trace (name = "C" , data = df_1, type = "scatter", mode = "markers", x = ~ y, y = ~z) %>% layout(title = "graph 3") %>%
  add_trace( name = "D", data = df_2, type = "scatter", mode = "markers", x = ~ y, y = ~z) %>% layout(title = "graph 4") %>% 
  layout(xaxis = list(domain = c(0.1, 1)),
         yaxis = list(title = "y"),
         updatemenus = list(
           list(
             y = 0.7,
             buttons = list(
               list(method = "restyle",
                    args = list("visible", list(TRUE, FALSE, FALSE, FALSE)),
                    label = "A"),
               list(method = "restyle",
                    args = list("visible", list(FALSE, TRUE, FALSE, FALSE)),
                    label = "B"),
               list(method = "restyle",
                    args = list("visible", list(FALSE, FALSE, TRUE, FALSE)),
                    label = "C"),
               list(method = "restyle",
                    args = list("visible", list(FALSE, FALSE, FALSE, TRUE)),
                    label = "D")))))

但这会产生以下错误:

Error: $ operator is invalid for atomic vectors
Error in add_data(p, data) : argument "p" is missing, with no default

有人可以告诉我是否可以解决这个问题吗？而不是使用 "add_trace"方法，是否可以通过名称(例如 subplot(plot_1, plot_2, plot_3, plot_4, nrows = 2) )单独调用每个绘图对象，将所有图形“粘合”在一起，然后添加一个“切换按钮”，让用户在它们之间切换？
(注意:我需要能够将最终结果保存为“html”文件)
谢谢

Answer 1

首先，您应该注意添加多条轨迹的图(参见 nTracesA 等)
除了更改轨迹可见性之外，您还需要将分类和数值数据分离到单独的 x 轴和 y 轴上并管理它们的可见性(参见 xaxis2 、 xaxis3 、 xaxis4 - 这也适用于单个 y-轴，但在这种情况下，网格未正确显示)
如 described in the docs :

The updatemenu method determines which plotly.js function will be usedto modify the chart. There are 4 possible methods:

“restyle”:修改数据或数据属性

“relayout”:修改布局属性

“更新”:修改数据和 布局属性

“animate”:开始或暂停动画(仅离线可用)

因此，以下是使用 更新方法 (这里有很多重复 - 需要一些清理，但我认为最好这样理解):

# load libraries
library(dplyr)
library(plotly)

# create data
x <- sample(LETTERS[1:4],
            731,
            replace = TRUE,
            prob = c(0.25, 0.25, 0.25, 0.25))
y <- rnorm(731, 10, 10)
z <- rnorm(731, 5, 5)
date <- seq(as.Date("2014/1/1"), as.Date("2016/1/1"), by = "day")

df <- data.frame(x, y, z, date)
df$x = as.factor(df$x)

nTracesA <- nTracesC <- nTracesD <- 1
nTracesB <- length(unique(df$x))

plotA <- plot_ly(data = df %>%
                   mutate(date = as.Date(date)) %>%
                   group_by(month = format(date, "%Y-%m")) %>%
                   summarise(mean = mean(y)),
                 type = 'scatter', mode = 'lines', x= ~ month, y= ~ mean, name = "plotA", visible = TRUE, xaxis = "x", yaxis = "y")

plotAB <- add_trace(plotA, data = df, x = ~x, y = ~y, color = ~ x, name = ~ paste0("plotB_", x), 
                    type = "box", xaxis = "x2", yaxis = "y2", visible = FALSE, inherit = FALSE)

plotABC <- add_trace(plotAB, data = df[which(df$x == "A"),], 
                     type = "scatter", mode = "markers", x = ~ y, y = ~ z, 
                     name = "plotC", xaxis = "x3", yaxis = "y3", visible = FALSE, inherit = FALSE)

plotABCD <- add_trace(plotABC, data = df[which(df$x == "B"),], x = ~ y, y = ~ z,
                      type = "scatter", mode = "markers", name = "plotD", xaxis = "x4", yaxis = "y4", visible = FALSE, inherit = FALSE)

fig <- layout(plotABCD, title = "Initial Title",
              xaxis = list(domain = c(0.1, 1), visible = TRUE, type = "date"),
              xaxis2 = list(overlaying = "x", visible = FALSE),
              xaxis3 = list(overlaying = "x", visible = FALSE), 
              xaxis4 = list(overlaying = "x", visible = FALSE),
              yaxis = list(title = "y"),
              yaxis2 = list(overlaying = "y", visible = FALSE),
              yaxis3 = list(overlaying = "y", visible = FALSE),
              yaxis4 = list(overlaying = "y", visible = FALSE),
              updatemenus = list(
                list(
                  y = 0.7,
                  buttons = list(
                    list(label = "A",
                         method = "update",
                         args = list(list(name = paste0("new_trace_name_", 1:7), visible = unlist(Map(rep, x = c(TRUE, FALSE, FALSE, FALSE), each = c(nTracesA, nTracesB, nTracesC, nTracesD)))),
                                     list(title = "title A",
                                          xaxis = list(visible = TRUE),
                                          xaxis2 = list(overlaying = "x", visible = FALSE),
                                          xaxis3 = list(overlaying = "x", visible = FALSE),
                                          xaxis4 = list(overlaying = "x", visible = FALSE),
                                          yaxis = list(visible = TRUE),
                                          yaxis2 = list(overlaying = "y", visible = FALSE),
                                          yaxis3 = list(overlaying = "y", visible = FALSE),
                                          yaxis4 = list(overlaying = "y", visible = FALSE)))
                    ),
                    list(label = "B",
                         method = "update",
                         args = list(list(visible = unlist(Map(rep, x = c(FALSE, TRUE, FALSE, FALSE), each = c(nTracesA, nTracesB, nTracesC, nTracesD)))),
                                     list(title = "title B",
                                          xaxis = list(visible = FALSE),
                                          xaxis2 = list(overlaying = "x", visible = TRUE),
                                          xaxis3 = list(overlaying = "x", visible = FALSE),
                                          xaxis4 = list(overlaying = "x", visible = FALSE),
                                          yaxis = list(visible = FALSE),
                                          yaxis2 = list(overlaying = "y", visible = TRUE),
                                          yaxis3 = list(overlaying = "y", visible = FALSE),
                                          yaxis4 = list(overlaying = "y", visible = FALSE)))),
                    list(label = "C",
                         method = "update",
                         args = list(list(visible = unlist(Map(rep, x = c(FALSE, FALSE, TRUE, FALSE), each = c(nTracesA, nTracesB, nTracesC, nTracesD)))),
                                     list(title = "title C",
                                          xaxis = list(visible = FALSE),
                                          xaxis2 = list(overlaying = "x", visible = FALSE),
                                          xaxis3 = list(overlaying = "x", visible = TRUE),
                                          xaxis4 = list(overlaying = "x", visible = FALSE),
                                          yaxis = list(visible = FALSE),
                                          yaxis2 = list(overlaying = "y", visible = FALSE),
                                          yaxis3 = list(overlaying = "y", visible = TRUE),
                                          yaxis4 = list(overlaying = "y", visible = FALSE)))),
                    list(label = "D",
                         method = "update",
                         args = list(list(visible = unlist(Map(rep, x = c(FALSE, FALSE, FALSE, TRUE), each = c(nTracesA, nTracesB, nTracesC, nTracesD)))),
                                     list(title = "title D",
                                          xaxis = list(visible = FALSE),
                                          xaxis2 = list(overlaying = "x", visible = FALSE),
                                          xaxis3 = list(overlaying = "x", visible = FALSE),
                                          xaxis4 = list(overlaying = "x", visible = TRUE),
                                          yaxis = list(visible = FALSE),
                                          yaxis2 = list(overlaying = "y", visible = FALSE),
                                          yaxis3 = list(overlaying = "y", visible = FALSE),
                                          yaxis4 = list(overlaying = "y", visible = TRUE))))
                  ))))

print(fig)

# htmlwidgets::saveWidget(partial_bundle(fig), file = "fig.html", selfcontained = TRUE)
# utils::browseURL("fig.html")

一些相关资料:
https://plotly.com/r/custom-buttons/
https://plotly.com/r/multiple-axes/