通过 plotly 下拉菜单切换显示的轨迹

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/）

在之前的 post ( ) 中，我学会了如何将相似的图形“粘合”在一起（例如 4 个散点图）。现在，我正在尝试使用不同的图表（2 个散点图、1 个时间序列和 1 个箱形图）来这样做。我尝试调整之前 post 中的代码以适合我的示例：

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)）单独调用每个 plotly 图形对象，将所有图形“粘合”在一起，然后添加一个“切换按钮”允许用户在它们之间切换？

（注意：我需要能够将最终结果保存为“html”文件）

谢谢

Answer 1

这只是文档中的猜测，但没有 add_data() 调用，所以也许可以在第一行尝试这样做：

fig <- plot_ly() %>% add_data(df) %>%

参见文档示例：

plot_ly() %>% add_data(economics) %>% add_trace(x = ~date, y = ~pce)

Answer 2

Rstudio 社区论坛上的一位用户提供了答案：https://community.rstudio.com/t/gluing-graphs-together-switch-toggle-between-graphs-in-r-plotly/95891/3

我仍在尝试弄清楚如何格式化轴 - 也许有人可以看看这个？

#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")


fig = plot_ly()
fig = fig %>% add_trace(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 = "timeseries")
fig = fig %>%  add_trace(data = df[which(df$x == "A"),], y = ~y, color = ~x, 
                         type = "box", name = "boxplot") 
fig = fig %>%  add_trace( data = df[which(df$x == "B"),], 
                          type = "scatter", mode = "markers", x = ~ y, y = ~z, 
                          name= "graph2")
fig = fig %>%  add_trace(data = df[which(df$x == "A"),], y = ~y, color = ~x, 
                         type = "box", name = "boxplot2") 


fig %>% 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")))))

Answer 3

首先，你应该注意添加多条轨迹的图（参见nTracesA等）

除了更改跟踪可见性之外，您还需要将分类数据和数字数据分离到单独的 x 轴和 y 轴上，并管理它们的可见性（参见 xaxis2、xaxis3、xaxis4 - 这也适用于单个 y 轴，但在这种情况下网格显示不正确）

如described in the docs:

The updatemenu method determines which plotly.js function will be used to 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/

通过 plotly 下拉菜单切换显示的轨迹

Switch displayed traces via plotly dropdown menu

r

onclick

dplyr

plotly

r-plotly