From f54daa10ac5b6e10c67122db23446bfd1f8b17a9 Mon Sep 17 00:00:00 2001
From: William Holmes <46801648+wholmes105@users.noreply.github.com>
Date: Fri, 7 Jul 2023 18:57:16 -0400
Subject: [PATCH 1/4] Delete misplaced file

layout.R was uploaded in the wrong folder initially
---
 layout.R | 408 -------------------------------------------------------
 1 file changed, 408 deletions(-)
 delete mode 100644 layout.R

diff --git a/layout.R b/layout.R
deleted file mode 100644
index 347f7bf4cc..0000000000
--- a/layout.R
+++ /dev/null
@@ -1,408 +0,0 @@
-#' Modify the layout of a plotly visualization
-#' 
-#' @param p A plotly object.
-#' @param ... Arguments to the layout object. For documentation,
-#' see \url{https://plotly.com/r/reference/#Layout_and_layout_style_objects}
-#' @param data A data frame to associate with this layout (optional). If not 
-#' provided, arguments are evaluated using the data frame in [plot_ly()].
-#' @author Carson Sievert
-#' @export
-layout <- function(p, ..., data = NULL) {
-  UseMethod("layout")
-}
-
-#' @export
-layout.matrix <- function(p, ..., data = NULL) {
-  # workaround for the popular graphics::layout() function
-  # https://github.com/ropensci/plotly/issues/464
-  graphics::layout(p, ...)
-}
-
-#' @export
-layout.shiny.tag.list <- function(p, ..., data = NULL) {
-  idx <- which(vapply(p, is.plotly, logical(1)))
-  for (i in idx) {
-    p[[i]] <- layout.plotly(p[[i]], ..., data = NULL)
-  }
-  p
-}
-
-#' @export
-layout.plotly <- function(p, ..., data = NULL) {
-  p <- add_data(p, data)
-  attrs <- list(...)
-  if (!is.null(attrs[["height"]]) || !is.null(attrs[["width"]])) {
-    warning("Specifying width/height in layout() is now deprecated.\n", 
-            "Please specify in ggplotly() or plot_ly()", call. = FALSE)
-  }
-  # similar to add_trace()
-  p$x$layoutAttrs <- c(
-    p$x$layoutAttrs %||% list(), 
-    setNames(list(attrs), p$x$cur_data)
-  )
-  p
-}
-
-#' Add a range slider to the x-axis
-#'
-#' @param p plotly object.
-#' @param start a start date/value.
-#' @param end an end date/value.
-#' @param ... these arguments are documented here 
-#' \url{https://plotly.com/r/reference/#layout-xaxis-rangeslider}
-#' @export
-#' @author Carson Sievert
-#' @examplesIf interactive() || !identical(.Platform$OS.type, "windows")
-#' 
-#' plot_ly(x = time(USAccDeaths), y = USAccDeaths) %>% 
-#'   add_lines() %>%
-#'   rangeslider()
-#'   
-#' d <- tibble::tibble(
-#'   time = seq(as.Date("2016-01-01"), as.Date("2016-08-31"), by = "days"),
-#'   y = rnorm(seq_along(time))
-#'  )
-#'  
-#' plot_ly(d, x = ~time, y = ~y) %>%
-#'   add_lines() %>%
-#'   rangeslider(d$time[5], d$time[50])
-#'   
-#' 
-rangeslider <- function(p, start = NULL, end = NULL, ...) {
-  if (sum(grepl("^xaxis", names(p$x$layout))) > 1) {
-    stop("Can only add a rangeslider to a plot with one x-axis", call. = FALSE)
-  }
-  
-  p$x$layout$xaxis$range <- c(
-    to_milliseconds(start),
-    to_milliseconds(end)
-  )
-  
-  p$x$layout$xaxis$rangeslider <- list(visible = TRUE, ...)
-  p
-}
-
-
-#' Set the default configuration for plotly
-#' 
-#' @param p a plotly object
-#' @param ... these arguments are documented at 
-#' \url{https://github.com/plotly/plotly.js/blob/master/src/plot_api/plot_config.js}
-#' @param cloud deprecated. Use `showSendToCloud` instead.
-#' @param showSendToCloud include the send data to cloud button?
-#' @param locale locale to use. See [here](https://github.com/plotly/plotly.js/tree/master/dist#to-include-localization) for more info.
-#' @param mathjax add [MathJax rendering support](https://github.com/plotly/plotly.js/tree/master/dist#to-support-mathjax).
-#' If `"cdn"`, mathjax is loaded externally (meaning an internet connection is needed for 
-#' TeX rendering). If `"local"`, the PLOTLY_MATHJAX_PATH environment variable must be
-#' set to the location (a local file path) of MathJax. IMPORTANT: **plotly** uses SVG-based 
-#' mathjax rendering which doesn't play nicely with HTML-based rendering 
-#' (e.g., **rmarkdown** documents and **shiny** apps). To leverage both types of rendering, 
-#' you must `<iframe>` your plotly graph(s) into the larger document 
-#' (see [here](https://github.com/plotly/plotly.R/blob/master/inst/examples/rmd/MathJax/index.Rmd) 
-#' for an **rmarkdown** example and 
-#' [here](https://github.com/plotly/plotly.R/blob/master/inst/examples/rmd/MathJax/index.Rmd) for a **shiny** example).
-#' @author Carson Sievert
-#' @export
-#' @examplesIf interactive() || !identical(.Platform$OS.type, "windows")
-#' 
-#' # remove the plotly logo and collaborate button from modebar
-#' config(plot_ly(), displaylogo = FALSE, collaborate = FALSE)
-#' 
-#' # enable mathjax
-#' # see more examples at https://plotly.com/r/LaTeX/
-#' plot_ly(x = c(1, 2, 3, 4), y = c(1, 4, 9, 16)) %>%
-#'   layout(title = TeX("\\text{Some mathjax: }\\alpha+\\beta x")) %>%
-#'   config(mathjax = "cdn")
-#' 
-#' # change the language used to render date axes and on-graph text 
-#' # (e.g., modebar buttons)
-#' today <- Sys.Date()
-#' x <- seq.Date(today, today + 360, by = "day")
-#' p <- plot_ly(x = x, y = rnorm(length(x))) %>%
-#'   add_lines()
-#' 
-#' # japanese
-#' config(p, locale = "ja")
-#' # german
-#' config(p, locale = "de")
-#' # spanish
-#' config(p, locale = "es")
-#' # chinese
-#' config(p, locale = "zh-CN")
-#' 
-
-config <- function(p, ..., cloud = FALSE, showSendToCloud = cloud, locale = NULL, mathjax = NULL) {
-  
-  if (!is.null(locale)) {
-    p$x$config$locale <- locale
-    # Plotly.js defaults to US English (en-US) and includes 
-    # British English (en) in the standard bundle.
-    if (!locale %in% c("en", "en-US")) {
-      p$dependencies <- c(
-        p$dependencies,
-        list(locale_dependency(locale))
-      )
-    }
-  }
-  
-  if (!is.null(mathjax)) {
-    mj <- switch(
-      match.arg(mathjax, c("cdn", "local")),
-      cdn = mathjax_cdn(),
-      local = mathjax_local()
-    )
-    # if mathjax is already supplied overwrite it; otherwise, prepend it
-    depNames <- sapply(p$dependencies, "[[", "name")
-    if (any(idx <- depNames %in% "mathjax")) {
-      p$dependencies[[which(idx)]] <- mathjax
-    } else {
-      p$dependencies <- c(list(mj), p$dependencies)
-    }
-  }
-  
-  args <- list(...)
-  if ("collaborate" %in% names(args)) warning("The collaborate button is no longer supported")
-  
-  args$modeBarButtonsToAdd <- unique(c(
-    args$modeBarButtonsToAdd, c("hoverclosest", "hovercompare")
-  ))
-  
-  p$x$config <- modify_list(p$x$config, args)
-  if (cloud) warning("The `cloud` argument is deprecated. Use `showSendToCloud` instead.")
-  p$x$config$showSendToCloud <- showSendToCloud
-
-  p
-}
-
-#' Construct a plot with a `layout.updatemenus` element programmatically
-#' 
-#' @param plot_list a named list of `plotly` objects
-#' @param ... Arguments to the layout.updatemenus object. For documentation,
-#' see \url{https://plotly.com/r/reference/layout/updatemenus/}
-#' @param show_legend Should the legend always be visible? Set to `TRUE` or `FALSE` to 
-#' always display or hide the legend, respectively. If `NA` (the default), legend visibility will mimic 
-#' plotly's default settings (for example, legends with only one trace will be hidden)
-#' @param active_plot the index of the plot from `plot_list` that is active by default. 
-#' By default, the first plot is considered active unless otherwise specified.
-#' @returns When given a named list of plotly objects, this function will return a single plotly object 
-#' with a `layout.updatemenus` element embedded within it. This plot element can be used to cycle between
-#' the plots provided by the user.
-#' @export
-#' @examplesIf interactive() || !identical(.Platform$OS.type, "windows")
-#' 
-#' plotly_merge(
-#'   plot_list = list(
-#'     Petal = iris %>% 
-#'       plot_ly(
-#'         type = 'scatter',
-#'         mode = 'markers',
-#'         x = ~Petal.Length,
-#'         y = ~Petal.Width,
-#'         color = ~Species
-#'       ),
-#'     Sepal = iris %>% 
-#'       plot_ly(
-#'         type = 'scatter',
-#'         mode = 'markers',
-#'         x = ~Sepal.Length,
-#'         y = ~Sepal.Width,
-#'         color = ~Species
-#'       ) %>% layout(yaxis = list(range = c(0, 5))),
-#'     mtbars = mtcars %>% 
-#'       group_by(cyl) %>% 
-#'       summarise(med_mpg = median(mpg)) %>% 
-#'       ungroup() %>% 
-#'       mutate(cyl = as.character(cyl)) %>% 
-#'       plot_ly(
-#'         type = 'bar',
-#'         x = ~cyl,
-#'         y = ~med_mpg
-#'       )
-#'   )
-#' )
-
-plotly_merge = function(plot_list, ..., show_legend = NA, active_plot = 1) {
-  stopifnot(
-    'plot_list must be a list of plotly objects' = is.list(plot_list),
-    'all elements of plot_list must be plotly objects' = vapply(plot_list, function(x) {
-      all(c('plotly', 'htmlwidget') %in% class(x))
-    }, logical(1)) %>% all(),
-    'show_legend must be a logical scalar; if it is NA (the default), legends with a single trace will be hidden' = 
-      is.vector(show_legend) && is.logical(show_legend) && length(show_legend) == 1,
-    'active_plot must be an integer scalar greater than zero; numerics will be truncated to integers' = is.vector(active_plot) && 
-      length(active_plot) == 1 && 
-      is.numeric(active_plot) && 
-      active_plot >= 1 &&
-      is.finite(active_plot),
-    'active_plot must be less than or equal to the length of the list of plotly objects provided' = 
-      length(active_plot) <= length(plot_list)
-  )
-  
-  # If there is only one plot in the list, return just that plot
-  if(length(plot_list) == 1) {return(plot_list[[1]])}
-  
-  # Truncate active_plot
-  active_plot = trunc(active_plot)
-  
-  # Build out the plots for manipulation
-  plot_list = lapply(plot_list, plotly_build) %>% 
-    # Examine the first trace of each plot; if legend visibility is not specified,
-    # guess whether the user wants to show the legend or not, or use show_legend if a value has been provided
-    lapply(function(p) {
-      if(is.null(p$x$data[[1]]$showlegend) && length(p$x$data) == 1) {
-        p$x$data[[1]]$showlegend = ifelse(!is.na(show_legend), show_legend, FALSE)
-      }
-      
-      return(p)
-    })
-  
-  # Note how many traces each plot contains
-  trace_count = vapply(plot_list, function(p_traces) {
-    length(p_traces$x$data)
-  }, integer(1))
-  max_trace = max(trace_count)
-  max_traces = seq_len(max_trace)
-  
-  # If necessary, increase the trace count and set the starting visibility of each plot so that there are enough traces to switch between
-  for(p in seq_along(plot_list)) {
-    trace_deficit = max_trace - trace_count[p]
-    if(trace_deficit > 0) {
-      for(traces in max_traces[! max_traces %in% seq_along(plot_list[[p]]$x$data)]) {
-        plot_list[[p]]$x$data[[traces]] = plot_list[[p]]$x$data[[1]]
-        plot_list[[p]]$x$data[[traces]]$visible = FALSE
-      }
-    }
-  }
-  
-  # Note the visibility, data, and layout settings each button in the dropdown should have
-  p_viz = seq_along(trace_count) %>% 
-    setNames(rep('visible', length(.))) %>% 
-    lapply(function(p) {
-      max_traces <= trace_count[p]
-    })
-  
-  p_data = plot_list %>% 
-    p_button_data(n_traces = max(max_traces))
-  
-  p_layout = plot_list %>% 
-    p_button_layout() %>% 
-    setNames(names(plot_list)) %>% 
-    # If no axis type is specified, assume the axis is linear
-    lapply(function(p) {
-      p$xaxis$type = ifelse(is.null(p$xaxis$type), 'linear', p$xaxis$type)
-      p$yaxis$type = ifelse(is.null(p$yaxis$type), 'linear', p$yaxis$type)
-      
-      return(p)
-    })
-  
-  # Append the `visible` element to the plot
-  p_data = seq_along(p_data) %>% 
-    setNames(names(p_data)) %>% 
-    lapply(function(p) {
-      p_data[[p]]$visible = p_viz[[p]]
-      
-      return(p_data[[p]])
-    })
-  
-  # Create the dropdown to return the final plot
-  plot_list[[active_plot]] %>% 
-    layout(
-      updatemenus = list(
-        list(
-          active = active_plot - 1,
-          ...,
-          # For each plot provided, make a button in the dropdown to switch to that plot
-          buttons = seq_along(trace_count) %>% 
-            lapply(function(p_trace) {
-              list(
-                method = 'update',
-                args = list(
-                  p_data[[p_trace]],
-                  p_layout[[p_trace]]
-                ),
-                label = names(trace_count[p_trace])
-              )
-            })
-        )
-      )
-    )
-}
-
-p_button_data = function(p_list, n_traces) {
-  stopifnot(
-    'p_list must be a list of plotly objects' = is.list(p_list),
-    'all elements of p_list must be plotly objects' = vapply(p_list, function(x) {
-      c('plotly', 'htmlwidget') %in% class(x)
-    }, logical(2)) %>% all(),
-    'All elements of p_list must be named' = !is.null(names(p_list)) && !any(names(p_list) == '')
-  )
-  
-  p_list = p_list %>% lapply(plotly_build)
-  
-  # Gather the names of the trace elements to restructure
-  p_data_elements = p_list %>% 
-    lapply(function(p) {
-      p$x$data %>% lapply(names) %>% unlist() %>% unique()
-    }) %>% 
-    unlist() %>% 
-    unique() %>% 
-    setNames(nm = .)
-  
-  # For each trace element, return the data in a format suitable for plotly update buttons
-  p_list %>% 
-    lapply(function(p) {
-      p_data_elements %>% lapply(function(d) {
-        a = p$x$data %>% lapply(function(p_data) p_data[[d]])
-        
-        if(length(a) < n_traces) {
-          a[(length(a)+1):n_traces] = NA
-          # a[(length(a)+1):n_traces] = a[1]
-        }
-        
-        return(a)
-      })
-    })
-}
-p_button_layout = function(p_list) {
-  stopifnot(
-    'p_list must be a list of plotly objects' = is.list(p_list),
-    'all elements of p_list must be plotly objects' = vapply(p_list, function(x) {
-      c('plotly', 'htmlwidget') %in% class(x)
-    }, logical(2)) %>% all(),
-    'All elements of p_list must be named' = !is.null(names(p_list)) && !any(names(p_list) == '')
-  )
-  
-  p_list = p_list %>% lapply(plotly_build)
-  
-  # Gather the names of the trace elements to restructure
-  p_data_elements = p_list %>% 
-    lapply(function(p) {
-      # p$x$layout %>% lapply(names) %>% unlist() %>% unique()
-      p$x$layout %>% names()
-    }) %>% 
-    unlist() %>% 
-    unique() %>% 
-    setNames(nm = .)
-  
-  # For each trace element, return the data in a format suitable for plotly update buttons
-  p_data_elements %>% lapply(function(l) {
-    p_list %>% unname() %>% lapply(function(p) {
-      p$x$layout[[l]]
-    })
-  })
-  
-  # For each plot, extract the layout
-  p_list %>% 
-    lapply(function(p) {
-      p_data_elements %>% lapply(function(l) {
-        p$x$layout[[l]]
-      })
-    }) %>% 
-    # Try to manually add logic to determine the axis type
-    lapply(function(p) {
-      p$xaxis$type = ifelse(is.null(p$xaxis$type), '-', p$xaxis$type)
-      p$yaxis$type = ifelse(is.null(p$yaxis$type), '-', p$yaxis$type)
-      
-      return(p)
-    })
-}

From 5e7087a62051f16c78a87253c69e45ca267d93d5 Mon Sep 17 00:00:00 2001
From: William Holmes <46801648+wholmes105@users.noreply.github.com>
Date: Fri, 7 Jul 2023 19:00:58 -0400
Subject: [PATCH 2/4] Delete misplaced file

test-plotly.R was uploaded in the wrong folder initially
---
 test-plotly.R | 429 --------------------------------------------------
 1 file changed, 429 deletions(-)
 delete mode 100644 test-plotly.R

diff --git a/test-plotly.R b/test-plotly.R
deleted file mode 100644
index 2c33145d42..0000000000
--- a/test-plotly.R
+++ /dev/null
@@ -1,429 +0,0 @@
-
-expect_traces <- function(p, n.traces, name){
-  stopifnot(is.numeric(n.traces))
-  L <- expect_doppelganger_built(p, paste0("plotly-", name))
-  expect_equivalent(length(L$data), n.traces)
-  L
-}
-
-# expect 2 plotly graphs to have the same traces
-expect_same_data <- function(p1, p2) {
-  if (!is.plotly(p1) || !is.plotly(p2)) {
-    stop("Both arguments must be plotly objects", call. = FALSE)
-  }
-  d1 <- plotly_build(p1)$x$data
-  d2 <- plotly_build(p2)$x$data
-  if (length(d1) != length(d2)) {
-    stop("Number of traces is different.", call. = FALSE)
-  }
-  # for each trace, align the names (since ordering doesn't matter)
-  d1 <- Map(function(x, y) structure(x[names(y)], class = oldClass(x)), d1, d2)
-  expect_identical(d1, d2)
-}
-
-# Create a list of plotly objects for use in plotly_merge
-plotly_merge_list = list(
-  # Naming convention is based on xaxis.type and the number of traces: AxisType_TraceCount
-  category_1 = mtcars %>% 
-    group_by(cyl) %>% 
-    summarise(med_mpg = median(mpg)) %>% 
-    ungroup() %>% 
-    mutate(cyl = as.character(cyl)) %>% 
-    plot_ly(
-      type = 'bar',
-      x = ~cyl,
-      y = ~med_mpg
-    ),
-  linear_3 = iris %>% 
-    plot_ly(
-      type = 'scatter',
-      mode = 'markers',
-      x = ~Petal.Length,
-      y = ~Petal.Width,
-      color = ~Species
-    ),
-  multicat_1 = plot_ly(
-    type = 'heatmap',
-    y = 1:10,
-    x = rbind(rep(LETTERS[1:5], each = 2), 1:10),
-    z = array(seq(from = 1, to = 100, by = 1), dim = c(10, 10))
-  ),
-  log_2 = plot_ly(
-    type = 'scatter',
-    mode = 'lines',
-    x = rep(c(1, 10, 100), 2),
-    y = c(1:3, 3:1),
-    name = rep(c('Asc', 'Desc'), 3)
-  ) %>% 
-    layout(xaxis = list(type = 'log', range = c(log10(0), log10(3)))),
-  date_1 = plot_ly(
-    type = 'scatter',
-    mode = 'lines',
-    x = seq(as.Date('1970-1-1'), as.Date('1970-12-31'), by = 'days'),
-    y = 1:365
-  )
-)
-
-plotly_merge_p = plotly_merge(
-  plot_list = plotly_merge_list,
-  show_legend = NA,
-  active_plot = 1
-) %>% plotly_build()
-
-
-test_that("vector values with repeated values are returned verbatim", {
-  p <- plot_ly(x = c(1, 2), y = c(1, 1))
-  l <- plotly_build(p)$x
-  expect_equivalent(l$data[[1]]$x, c(1, 2))
-  expect_equivalent(l$data[[1]]$y, c(1, 1))
-})
-
-test_that("plot_ly defaults to scatterplot", {
-  p1 <- plot_ly(mtcars, x = ~wt, y = ~mpg)
-  p2 <- plot_ly(mtcars, x = ~wt, y = ~mpg) %>% add_markers()
-  expect_same_data(p1, p2)
-})
-
-test_that("Variable mappings return same result regardless of where they appear", {
-  p1 <- plot_ly(mtcars, x = ~wt, y = ~mpg, size = ~disp)
-  p2 <- plot_ly(mtcars, x = ~wt, y = ~mpg) %>% add_markers(size = ~disp)
-  expect_same_data(p1, p2)
-  p1 <- plot_ly(mtcars, x = ~wt, y = ~mpg, color = ~disp)
-  p2 <- plot_ly(mtcars, x = ~wt, y = ~mpg) %>% add_markers(color = ~disp)
-  expect_same_data(p1, p2)
-  p1 <- plot_ly(mtcars, x = ~wt, y = ~mpg, symbol = ~factor(am))
-  p2 <- plot_ly(mtcars, x = ~wt, y = ~mpg) %>% add_markers(symbol = ~factor(am))
-  expect_same_data(p1, p2)
-  p1 <- plot_ly(mtcars, x = ~wt, y = ~mpg, linetype = ~factor(am))
-  p2 <- plot_ly(mtcars, x = ~wt, y = ~mpg) %>% add_markers(linetype = ~factor(am))
-  expect_message(plotly_build(p1), "Adding lines to mode")
-  expect_message(plotly_build(p2), "Adding lines to mode")
-  expect_same_data(p1, p2)
-})
-
-
-
-test_that("plot_ly() handles a simple scatterplot", {
-  d <- palmerpenguins::penguins %>% 
-    filter(!is.na(bill_length_mm))
-  p <- plot_ly(data = d, 
-               x = ~bill_length_mm, y = ~bill_depth_mm, mode = "markers")
-  l <- expect_traces(p, 1, "scatterplot")
-  expect_equivalent(l$data[[1]]$mode, "markers")
-  expect_equivalent(l$data[[1]]$x, na.omit(palmerpenguins::penguins$bill_length_mm))
-  expect_equivalent(l$data[[1]]$y, na.omit(palmerpenguins::penguins$bill_depth_mm))
-  expect_true(l$layout$xaxis$title == "bill_length_mm")
-  expect_true(l$layout$yaxis$title == "bill_depth_mm")
-  expect_true(l$layout$xaxis$automargin)
-  expect_true(l$layout$yaxis$automargin)
-})
-
-test_that("type inference + add_data + layering works as expected", {
-p <- plot_ly(palmerpenguins::penguins, x = ~species) %>% 
-  add_trace(opacity = 0.3) %>%
-  add_data(palmerpenguins::penguins[sample(nrow(palmerpenguins::penguins), 10), ]) %>% 
-  add_trace() %>%
-  layout(barmode = "overlay")
-  l <- expect_traces(p, 2, "bar-inference")
-  types <- unique(unlist(lapply(l$data, "[[", "type")))
-  expect_equivalent(types, "histogram")
-  expect_equivalent(l$data[[1]]$opacity, 0.3)
-  expect_equivalent(l$layout$barmode, "overlay")
-  expect_true(length(l$data[[1]]$x) > length(l$data[[2]]$x))
-})
-
-test_that("x/y/z properties have a class of AsIs", {
-  p <- plot_ly(x = 1, y = 1, z = 1, type = "scatter3d")
-  l <- expect_traces(p, 1, "box-data-array")
-  tr <- l$data[[1]]
-  expect_true(inherits(tr$x, "AsIs"))
-  expect_true(inherits(tr$y, "AsIs"))
-  expect_true(inherits(tr$z, "AsIs"))
-})
-
-test_that("grouping within multiples traces works", {
-  g <- expand.grid(visit = 1:2, id = 1:3, cohort = c("A", "B"))
-  g$response <- rnorm(nrow(g))
-  d <- group_by(g, id)
-  p <- plot_ly(d, x = ~visit, y = ~response, color = ~cohort, colors = c("red", "blue"))
-  l <- expect_traces(add_lines(p), 2, "group-within-trace")
-  expect_equivalent(l$data[[1]]$x, c(1, 2, NA, 1, 2, NA, 1, 2))
-  expect_equivalent(l$data[[2]]$x, c(1, 2, NA, 1, 2, NA, 1, 2))
-  expect_true(l$data[[1]]$line$color == toRGB("red"))
-  expect_true(l$data[[2]]$line$color == toRGB("blue"))
-})
-
-test_that("Alpha can be applied to both constant and scaled colors", {
-  p <- plot_ly(x = rnorm(100), y = rnorm(100), color = ~rnorm(100)) 
-  p <- add_markers(p, alpha = 0.05)
-  p <- add_lines(p, x = -1:1, y = -1:1, color = I("red"), alpha = 0.4)
-  # one trace for the colorbar
-  l <- expect_traces(p, 3, "alpha-blending")
-  # verify the correct alpha for the points
-  rgbs <- l$data[[1]]$marker$colorscale[, 2]
-  alphas <- unique(sub("\\)", "", sapply(strsplit(rgbs, ","), "[[", 4)))
-  expect_equivalent("0.05", alphas)
-  # verify the correct alpha for the lines
-  rgb <- l$data[[2]]$line$color
-  alpha <- sub("\\)", "", sapply(strsplit(rgb, ","), "[[", 4))
-  expect_equivalent("0.4", alpha)
-})
-
-
-test_that("Alpha still applies when no color is applied", {
-  p <- plot_ly(mtcars, x = ~mpg, y = ~disp, alpha = 0.5) 
-  l <- expect_traces(p, 1, "alpha-no-color")
-  # verify the correct alpha for the points
-  expect_true(l$data[[1]]$marker$color == "rgba(31,119,180,0.5)")
-})
-
-
-test_that("Factors correctly mapped to a positional axis", {
-  x <- factor(c(1, 2, 4, 8, 16, 32))
-  p <- plot_ly(x = x, y = c(1, 2, 3, 4, 5, 6)) %>% add_markers()
-  l <- expect_traces(p, 1, "factor-axis")
-  expect_equivalent(l$layout$xaxis$type, "category")
-  expect_equivalent(l$layout$xaxis$categoryorder, "array")
-  expect_equivalent(l$layout$xaxis$categoryarray, levels(x))
-})
-
-test_that("Character strings correctly mapped to a positional axis", {
-  # scramble alphabet order
-  letters <- LETTERS[as.numeric(sort(as.character(1:26)))]
-  p <- plot_ly(x = letters, y = seq_along(letters)) %>% 
-    add_bars(color = rep(c("a1", "a2"), length.out = 26))
-  l <- expect_warning(expect_traces(p, 2, "character-axis"), 
-                      regexp = "minimal value for n is 3")
-  expect_equivalent(l$layout$xaxis$type, "category")
-  expect_equivalent(l$layout$xaxis$categoryorder, "array")
-  expect_equivalent(l$layout$xaxis$categoryarray, LETTERS)
-})
-
-test_that("Histogram", {
-  p <- plot_ly(x = rnorm(100))
-  l <- expect_traces(p, 1, "histogram")
-  o <- unlist(lapply(l$data, "[[", "orientation"))
-  types <- unlist(lapply(l$data, "[[", "type"))
-  expect_null(o)
-  expect_equivalent(unique(types), "histogram")
-})
-
-test_that("Discrete variable mapped to x creates horizontal bar chart", {
-  p <- plot_ly(y = rnorm(100))
-  l <- expect_traces(p, 1, "histogram-vert")
-  o <- unlist(lapply(l$data, "[[", "orientation"))
-  types <- unlist(lapply(l$data, "[[", "type"))
-  expect_equivalent(unique(o), "h")
-  expect_equivalent(unique(types), "histogram")
-})
-
-test_that("Can avoid inheriting attributes", {
-  p <- plot_ly(mtcars, x = ~wt, y = ~mpg, color = I("red")) %>%
-    add_histogram(x = ~factor(vs), inherit = FALSE)
-  l <- expect_traces(p, 1, "inherit-FALSE")
-  expect_equivalent(l$data[[1]][["type"]], "histogram")
-  expect_equivalent(l$data[[1]][["x"]], factor(mtcars[["vs"]]))
-  expect_null(l$data[[1]][["y"]])
-  expect_true(l$data[[1]][["marker"]][["color"]] != toRGB("red"))
-})
-
-test_that("Complex example works", {
-  # note how median (the variable) doesn't exist in the second layer 
-  p <- txhousing %>%
-    plot_ly(x = ~date, y = ~median) %>%
-    group_by(city) %>%
-    add_lines(alpha = 0.2, name = "Texan Cities", hoverinfo = "none") %>%
-    group_by(date) %>% 
-    summarise(
-      q1 = quantile(median, 0.25, na.rm = TRUE),
-      m = median(median, na.rm = TRUE),
-      q3 = quantile(median, 0.75, na.rm = TRUE)
-    ) %>%
-    add_lines(y = ~m, color = I("red"), name = "median") %>%
-    add_ribbons(ymin = ~q1, ymax = ~q3, color = I("red"), name = "IQR")
-  
-  l <- expect_traces(p, 3, "time-series-summary")
-})
-
-test_that("span/size controls errorbar thickness/width", {
-  
-  p <- plot_ly(x = 1:10, y = 1:10, error_x = list(value = 3), error_y = list(value = 2), span = I(5), size = I(10), stroke = I("black"), color = I("red")) %>%
-    plotly_build()
-  
-  expect_doppelganger_built(p, "errorbar.width")
-  
-  d <- p$x$data
-  expect_length(d, 1)
-  
-  expect_true(d[[1]]$error_x$value == 3)
-  expect_true(d[[1]]$error_x$thickness == 5)
-  expect_true(d[[1]]$error_x$width == 10)
-  expect_true(d[[1]]$error_x$color == toRGB("red"))
-  
-  expect_true(d[[1]]$error_y$value == 2)
-  expect_true(d[[1]]$error_y$thickness == 5)
-  expect_true(d[[1]]$error_y$width == 10)
-  expect_true(d[[1]]$error_y$color == toRGB("red"))
-})
-
-
-test_that("Vector of redundant text is reduced to string when hoveron=fills", {
-  
-  # see https://github.com/ropensci/plotly/issues/1233
-  d <- data.frame(
-    AA = c(2,3,3,2, NA, 6,7,7,6, NA),
-    BB = c(2,2,3,2, NA, 6,6,7,6, NA),
-    CC = c(rep('abc', 5), rep('xyz', 5)),
-    LL = c(rep('A', 5), rep('B', 5))
-  )
-  
-  
-  p <- plot_ly(d) %>%
-    add_trace(x = ~AA,
-              y = ~BB,
-              text = ~paste('<br> <b>Example</b> of <em>custom</em> hover text <br>', LL, '<br>', CC, '<br>.'),
-              split = ~LL, 
-              mode = "lines", 
-              fill = "toself", 
-              hoveron = 'fills',
-              type = "scatter", 
-              color = I(c(rep(toRGB("black", 1), 5),
-                          rep(toRGB("red", 1), 5)))
-    )
-  
-  b <- plotly_build(p)
-  d <- b$x$data
-  expect_length(d, 2)
-  expect_true(d[[1]]$line$color == toRGB("black"))
-  expect_true(d[[1]]$fillcolor == toRGB("black", 0.5))
-  expect_true(d[[2]]$line$color == toRGB("red"))
-  expect_true(d[[2]]$fillcolor == toRGB("red", 0.5))
-  expect_true(
-    d[[1]]$text == '<br> <b>Example</b> of <em>custom</em> hover text <br> A <br> abc <br>.'
-  )
-  expect_true(
-    d[[2]]$text == '<br> <b>Example</b> of <em>custom</em> hover text <br> B <br> xyz <br>.'
-  )
-})
-
-
-test_that("Can map data to legendgroup", {
-  d <- data.frame(
-    x = 1:100,
-    y = runif(100),
-    group = letters[1:5]
-  )
-  
-  l <- plot_ly(data = d, x = ~x, y = ~y) %>%
-    add_bars(color = ~group,  legendgroup = ~group) %>%
-    add_markers(color = ~group, legendgroup = ~group) %>%
-    plotly_build()
-  
-  expect_length(l$x$data, 10)
-  
-  markers <- compact(lapply(l$x$data, function(tr) if (tr$type == "scatter") tr))
-  for (i in seq_along(markers)) {
-    expect_length(markers[[i]]$legendgroup, 1)
-    expect_true(markers[[i]]$legendgroup == letters[[i]])
-  }
-  
-  bars <- compact(lapply(l$x$data, function(tr) if (tr$type == "bar") tr))
-  for (i in seq_along(bars)) {
-    expect_length(bars[[i]]$legendgroup, 1)
-    expect_true(bars[[i]]$legendgroup == letters[[i]])
-  }
-})
-
-
-test_that("Axis domains aren't supplied if layout.grid exists", {
-  p <- plot_ly(type = 'scatter',mode = 'lines', y = c(5,1,3), xaxis = 'x', yaxis = 'y') %>%
-    add_trace(y = c(2,1,5), xaxis = 'x2', yaxis = 'y2') %>%
-    add_trace(y = c(2,1,5), xaxis = 'x3', yaxis = 'y3')%>%
-    add_trace(y = c(2,1,5), xaxis = 'x4', yaxis = 'y4')%>%
-    add_trace(y = c(2,1,5), xaxis = 'x5', yaxis = 'y5')%>%
-    add_trace(y = c(2,1,5), xaxis = 'x6', yaxis = 'y6')%>%
-    layout(grid = list(rows = 2, columns = 3, pattern ='independent'))
-  
-  l <- expect_doppelganger_built(p, "layout-grid")
-  expect_null(l$layout$xaxis$domain)
-  expect_null(l$layout$yaxis$domain)
-})
-
-
-test_that("Informative deprecation message for titlefont", {
-  expect_warning(config(plot_ly(), cloud = TRUE), "cloud")
-})
-
-test_that("Informative warning for invalid config attr", {
-  p <- config(plot_ly(), foobar = TRUE)
-  expect_warning(plotly_build(p), "foobar")
-})
-
-test_that("Informative deprecation message for titlefont", {
-  p <- layout(plot_ly(), title = "A title", titlefont = list(size = 30))
-  expect_warning(plotly_build(p), "titlefont")
-})
-
-test_that("toWebGL() shouldn't complain if it's already webgl", {
-  p <- plot_ly(x = 1, y = 1) %>%
-    add_trace(type = "scattergl", mode = "markers") %>%
-    toWebGL()
-  expect_silent(plotly_build(p))
-})
-
-test_that("Line breaks are properly translated (R -> HTML)", {
-  # create target labels
-  suffix <- "\n\n(third line)\n(fourth line)"
-  
-  d <- palmerpenguins::penguins %>% 
-    filter(!is.na(bill_length_mm))
-  
-  target_labels <- d$species %>%
-    unique() %>%
-    sort() %>%
-    paste0(suffix) %>%
-    gsub(pattern = "\n",
-         replacement = br(),
-         x = .,
-         fixed = TRUE)
-  
-  # test factor column
-  levels(d$species) <- paste0(levels(d$species), suffix)
-  p1 <- d %>% plot_ly(x = ~bill_length_mm,
-                      y = ~species)
-  
-  expect_equivalent(plotly_build(p1)[["x"]][["layout"]][["yaxis"]][["categoryarray"]],
-                    target_labels)
-  
-  # test character column
-  p2 <- d %>%
-    dplyr::mutate(species = as.character(species)) %>%
-    plot_ly(x = ~bill_length_mm,
-            y = ~species)
-  
-  expect_equivalent(plotly_build(p2)[["x"]][["layout"]][["yaxis"]][["categoryarray"]],
-                    target_labels)
-})
-
-test_that("group_by() on a plotly object doesn't produce warning", {
-   expect_warning(group_by(plot_ly(txhousing), city), NA)
-})
-
-test_that("The length of `updatemenus` and its elements are correct" {
-  # The length of updatemenus is 1, and the length of updatemenus[[1]]$buttons matches the length of the plot_list argument
-  length(plotly_merge_p$x$layout$updatemenus) == 1 &&
-    length(plotly_merge_p$x$layout$updatemenus[[1]]$buttons) == length(plotly_merge_list)
-})
-
-test_that("The names of the data and layout are correct for their assigned buttons", {
-  seq_along(plotly_merge_list) %>% vapply(function(p_test) {
-    all( 
-      # Data
-      unique(plotly_build(plotly_merge_list[[p_test]])$x$data %>% lapply(names) %>% unlist()) %in%
-        names(plotly_merge_p$x$layout$updatemenus[[1]]$buttons[[p_test]]$args[[1]]),
-      # Layout
-      unique(plotly_build(plotly_merge_list[[p_test]])$x$layout %>% names()) %in%
-        names(plotly_merge_p$x$layout$updatemenus[[1]]$buttons[[p_test]]$args[[2]])
-    )
-  }, logical(1)) %>% all()
-})
\ No newline at end of file

From e0938ba7ace7581cb6ec74b71abbde8d35280b96 Mon Sep 17 00:00:00 2001
From: William Holmes <46801648+wholmes105@users.noreply.github.com>
Date: Fri, 7 Jul 2023 19:02:09 -0400
Subject: [PATCH 3/4] Update layout.R

---
 R/layout.R | 233 +++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 233 insertions(+)

diff --git a/R/layout.R b/R/layout.R
index c1c225aadc..0ce0a29143 100644
--- a/R/layout.R
+++ b/R/layout.R
@@ -173,3 +173,236 @@ config <- function(p, ..., cloud = FALSE, showSendToCloud = cloud, locale = NULL
 
   p
 }
+
+#' Construct a plot with a `layout.updatemenus` element programmatically
+#' 
+#' @param plot_list a named list of `plotly` objects
+#' @param ... Arguments to the layout.updatemenus object. For documentation,
+#' see \url{https://plotly.com/r/reference/layout/updatemenus/}
+#' @param show_legend Should the legend always be visible? Set to `TRUE` or `FALSE` to 
+#' always display or hide the legend, respectively. If `NA` (the default), legend visibility will mimic 
+#' plotly's default settings (for example, legends with only one trace will be hidden)
+#' @param active_plot the index of the plot from `plot_list` that is active by default. 
+#' By default, the first plot is considered active unless otherwise specified.
+#' @returns When given a named list of plotly objects, this function will return a single plotly object 
+#' with a `layout.updatemenus` element embedded within it. This plot element can be used to cycle between
+#' the plots provided by the user.
+#' @export
+#' @examplesIf interactive() || !identical(.Platform$OS.type, "windows")
+#' 
+#' plotly_merge(
+#'   plot_list = list(
+#'     Petal = iris %>% 
+#'       plot_ly(
+#'         type = 'scatter',
+#'         mode = 'markers',
+#'         x = ~Petal.Length,
+#'         y = ~Petal.Width,
+#'         color = ~Species
+#'       ),
+#'     Sepal = iris %>% 
+#'       plot_ly(
+#'         type = 'scatter',
+#'         mode = 'markers',
+#'         x = ~Sepal.Length,
+#'         y = ~Sepal.Width,
+#'         color = ~Species
+#'       ) %>% layout(yaxis = list(range = c(0, 5))),
+#'     mtbars = mtcars %>% 
+#'       group_by(cyl) %>% 
+#'       summarise(med_mpg = median(mpg)) %>% 
+#'       ungroup() %>% 
+#'       mutate(cyl = as.character(cyl)) %>% 
+#'       plot_ly(
+#'         type = 'bar',
+#'         x = ~cyl,
+#'         y = ~med_mpg
+#'       )
+#'   )
+#' )
+
+plotly_merge = function(plot_list, ..., show_legend = NA, active_plot = 1) {
+  stopifnot(
+    'plot_list must be a list of plotly objects' = is.list(plot_list),
+    'all elements of plot_list must be plotly objects' = vapply(plot_list, function(x) {
+      all(c('plotly', 'htmlwidget') %in% class(x))
+    }, logical(1)) %>% all(),
+    'show_legend must be a logical scalar; if it is NA (the default), legends with a single trace will be hidden' = 
+      is.vector(show_legend) && is.logical(show_legend) && length(show_legend) == 1,
+    'active_plot must be an integer scalar greater than zero; numerics will be truncated to integers' = is.vector(active_plot) && 
+      length(active_plot) == 1 && 
+      is.numeric(active_plot) && 
+      active_plot >= 1 &&
+      is.finite(active_plot),
+    'active_plot must be less than or equal to the length of the list of plotly objects provided' = 
+      length(active_plot) <= length(plot_list)
+  )
+  
+  # If there is only one plot in the list, return just that plot
+  if(length(plot_list) == 1) {return(plot_list[[1]])}
+  
+  # Truncate active_plot
+  active_plot = trunc(active_plot)
+  
+  # Build out the plots for manipulation
+  plot_list = lapply(plot_list, plotly_build) %>% 
+    # Examine the first trace of each plot; if legend visibility is not specified,
+    # guess whether the user wants to show the legend or not, or use show_legend if a value has been provided
+    lapply(function(p) {
+      if(is.null(p$x$data[[1]]$showlegend) && length(p$x$data) == 1) {
+        p$x$data[[1]]$showlegend = ifelse(!is.na(show_legend), show_legend, FALSE)
+      }
+      
+      return(p)
+    })
+  
+  # Note how many traces each plot contains
+  trace_count = vapply(plot_list, function(p_traces) {
+    length(p_traces$x$data)
+  }, integer(1))
+  max_trace = max(trace_count)
+  max_traces = seq_len(max_trace)
+  
+  # If necessary, increase the trace count and set the starting visibility of each plot so that there are enough traces to switch between
+  for(p in seq_along(plot_list)) {
+    trace_deficit = max_trace - trace_count[p]
+    if(trace_deficit > 0) {
+      for(traces in max_traces[! max_traces %in% seq_along(plot_list[[p]]$x$data)]) {
+        plot_list[[p]]$x$data[[traces]] = plot_list[[p]]$x$data[[1]]
+        plot_list[[p]]$x$data[[traces]]$visible = FALSE
+      }
+    }
+  }
+  
+  # Note the visibility, data, and layout settings each button in the dropdown should have
+  p_viz = seq_along(trace_count) %>% 
+    setNames(rep('visible', length(.))) %>% 
+    lapply(function(p) {
+      max_traces <= trace_count[p]
+    })
+  
+  p_data = plot_list %>% 
+    p_button_data(n_traces = max(max_traces))
+  
+  p_layout = plot_list %>% 
+    p_button_layout() %>% 
+    setNames(names(plot_list)) %>% 
+    # If no axis type is specified, assume the axis is linear
+    lapply(function(p) {
+      p$xaxis$type = ifelse(is.null(p$xaxis$type), 'linear', p$xaxis$type)
+      p$yaxis$type = ifelse(is.null(p$yaxis$type), 'linear', p$yaxis$type)
+      
+      return(p)
+    })
+  
+  # Append the `visible` element to the plot
+  p_data = seq_along(p_data) %>% 
+    setNames(names(p_data)) %>% 
+    lapply(function(p) {
+      p_data[[p]]$visible = p_viz[[p]]
+      
+      return(p_data[[p]])
+    })
+  
+  # Create the dropdown to return the final plot
+  plot_list[[active_plot]] %>% 
+    layout(
+      updatemenus = list(
+        list(
+          active = active_plot - 1,
+          ...,
+          # For each plot provided, make a button in the dropdown to switch to that plot
+          buttons = seq_along(trace_count) %>% 
+            lapply(function(p_trace) {
+              list(
+                method = 'update',
+                args = list(
+                  p_data[[p_trace]],
+                  p_layout[[p_trace]]
+                ),
+                label = names(trace_count[p_trace])
+              )
+            })
+        )
+      )
+    )
+}
+
+p_button_data = function(p_list, n_traces) {
+  stopifnot(
+    'p_list must be a list of plotly objects' = is.list(p_list),
+    'all elements of p_list must be plotly objects' = vapply(p_list, function(x) {
+      c('plotly', 'htmlwidget') %in% class(x)
+    }, logical(2)) %>% all(),
+    'All elements of p_list must be named' = !is.null(names(p_list)) && !any(names(p_list) == '')
+  )
+  
+  p_list = p_list %>% lapply(plotly_build)
+  
+  # Gather the names of the trace elements to restructure
+  p_data_elements = p_list %>% 
+    lapply(function(p) {
+      p$x$data %>% lapply(names) %>% unlist() %>% unique()
+    }) %>% 
+    unlist() %>% 
+    unique() %>% 
+    setNames(nm = .)
+  
+  # For each trace element, return the data in a format suitable for plotly update buttons
+  p_list %>% 
+    lapply(function(p) {
+      p_data_elements %>% lapply(function(d) {
+        a = p$x$data %>% lapply(function(p_data) p_data[[d]])
+        
+        if(length(a) < n_traces) {
+          a[(length(a)+1):n_traces] = NA
+          # a[(length(a)+1):n_traces] = a[1]
+        }
+        
+        return(a)
+      })
+    })
+}
+p_button_layout = function(p_list) {
+  stopifnot(
+    'p_list must be a list of plotly objects' = is.list(p_list),
+    'all elements of p_list must be plotly objects' = vapply(p_list, function(x) {
+      c('plotly', 'htmlwidget') %in% class(x)
+    }, logical(2)) %>% all(),
+    'All elements of p_list must be named' = !is.null(names(p_list)) && !any(names(p_list) == '')
+  )
+  
+  p_list = p_list %>% lapply(plotly_build)
+  
+  # Gather the names of the trace elements to restructure
+  p_data_elements = p_list %>% 
+    lapply(function(p) {
+      # p$x$layout %>% lapply(names) %>% unlist() %>% unique()
+      p$x$layout %>% names()
+    }) %>% 
+    unlist() %>% 
+    unique() %>% 
+    setNames(nm = .)
+  
+  # For each trace element, return the data in a format suitable for plotly update buttons
+  p_data_elements %>% lapply(function(l) {
+    p_list %>% unname() %>% lapply(function(p) {
+      p$x$layout[[l]]
+    })
+  })
+  
+  # For each plot, extract the layout
+  p_list %>% 
+    lapply(function(p) {
+      p_data_elements %>% lapply(function(l) {
+        p$x$layout[[l]]
+      })
+    }) %>% 
+    # Try to manually add logic to determine the axis type
+    lapply(function(p) {
+      p$xaxis$type = ifelse(is.null(p$xaxis$type), '-', p$xaxis$type)
+      p$yaxis$type = ifelse(is.null(p$yaxis$type), '-', p$yaxis$type)
+      
+      return(p)
+    })
+}

From f74425c5974c6816338916a200df89993d5ae5a5 Mon Sep 17 00:00:00 2001
From: William Holmes <46801648+wholmes105@users.noreply.github.com>
Date: Fri, 7 Jul 2023 19:03:56 -0400
Subject: [PATCH 4/4] Update test-plotly.R

---
 tests/testthat/test-plotly.R | 69 ++++++++++++++++++++++++++++++++++++
 1 file changed, 69 insertions(+)

diff --git a/tests/testthat/test-plotly.R b/tests/testthat/test-plotly.R
index 7b10220293..68303119af 100644
--- a/tests/testthat/test-plotly.R
+++ b/tests/testthat/test-plotly.R
@@ -21,6 +21,56 @@ expect_same_data <- function(p1, p2) {
   expect_identical(d1, d2)
 }
 
+# Create a list of plotly objects for use in plotly_merge
+plotly_merge_list = list(
+  # Naming convention is based on xaxis.type and the number of traces: AxisType_TraceCount
+  category_1 = mtcars %>% 
+    group_by(cyl) %>% 
+    summarise(med_mpg = median(mpg)) %>% 
+    ungroup() %>% 
+    mutate(cyl = as.character(cyl)) %>% 
+    plot_ly(
+      type = 'bar',
+      x = ~cyl,
+      y = ~med_mpg
+    ),
+  linear_3 = iris %>% 
+    plot_ly(
+      type = 'scatter',
+      mode = 'markers',
+      x = ~Petal.Length,
+      y = ~Petal.Width,
+      color = ~Species
+    ),
+  multicat_1 = plot_ly(
+    type = 'heatmap',
+    y = 1:10,
+    x = rbind(rep(LETTERS[1:5], each = 2), 1:10),
+    z = array(seq(from = 1, to = 100, by = 1), dim = c(10, 10))
+  ),
+  log_2 = plot_ly(
+    type = 'scatter',
+    mode = 'lines',
+    x = rep(c(1, 10, 100), 2),
+    y = c(1:3, 3:1),
+    name = rep(c('Asc', 'Desc'), 3)
+  ) %>% 
+    layout(xaxis = list(type = 'log', range = c(log10(0), log10(3)))),
+  date_1 = plot_ly(
+    type = 'scatter',
+    mode = 'lines',
+    x = seq(as.Date('1970-1-1'), as.Date('1970-12-31'), by = 'days'),
+    y = 1:365
+  )
+)
+
+plotly_merge_p = plotly_merge(
+  plot_list = plotly_merge_list,
+  show_legend = NA,
+  active_plot = 1
+) %>% plotly_build()
+
+
 test_that("vector values with repeated values are returned verbatim", {
   p <- plot_ly(x = c(1, 2), y = c(1, 1))
   l <- plotly_build(p)$x
@@ -358,3 +408,22 @@ test_that("Line breaks are properly translated (R -> HTML)", {
 test_that("group_by() on a plotly object doesn't produce warning", {
    expect_warning(group_by(plot_ly(txhousing), city), NA)
 })
+
+test_that("The length of `updatemenus` and its elements are correct" {
+  # The length of updatemenus is 1, and the length of updatemenus[[1]]$buttons matches the length of the plot_list argument
+  length(plotly_merge_p$x$layout$updatemenus) == 1 &&
+    length(plotly_merge_p$x$layout$updatemenus[[1]]$buttons) == length(plotly_merge_list)
+})
+
+test_that("The names of the data and layout are correct for their assigned buttons", {
+  seq_along(plotly_merge_list) %>% vapply(function(p_test) {
+    all( 
+      # Data
+      unique(plotly_build(plotly_merge_list[[p_test]])$x$data %>% lapply(names) %>% unlist()) %in%
+        names(plotly_merge_p$x$layout$updatemenus[[1]]$buttons[[p_test]]$args[[1]]),
+      # Layout
+      unique(plotly_build(plotly_merge_list[[p_test]])$x$layout %>% names()) %in%
+        names(plotly_merge_p$x$layout$updatemenus[[1]]$buttons[[p_test]]$args[[2]])
+    )
+  }, logical(1)) %>% all()
+})