diff --git a/R/layout.R b/R/layout.R index 4233e1719f..426d30148a 100644 --- a/R/layout.R +++ b/R/layout.R @@ -46,15 +46,17 @@ layout.plotly <- function(p, ..., data = NULL) { #' 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 start a starting value for the rangeslider's range. +#' @param end an ending value for the rangeslider's range. +#' @param xaxes xaxis ids to generate rangesliders. +#' The default adds a rangeslider to every xaxis in the plot object. #' @param ... these arguments are documented here #' \url{https://plot.ly/r/reference/#layout-xaxis-rangeslider} #' @export #' @author Carson Sievert #' @examples #' -#' plot_ly(x = time(USAccDeaths), y = USAccDeaths) %>% +#' p1 <- plot_ly(x = time(USAccDeaths), y = USAccDeaths) %>% #' add_lines() %>% #' rangeslider() #' @@ -63,22 +65,45 @@ layout.plotly <- function(p, ..., data = NULL) { #' y = rnorm(seq_along(time)) #' ) #' -#' plot_ly(d, x = ~time, y = ~y) %>% +#' p2 <- 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) +#' subplot(p1, p2, nrows = 2, margin = 0.1) +#' +#' # calling rangeslider on a plot with multiple axes +#' # generates multiple rangesliders +#' subplot(qplot(1:10), qplot(1:10, 1:10)) %>% +#' rangeslider() +#' +#' # add a rangeslider to just the 2nd xaxis +#' subplot(qplot(1:10), qplot(1:10, 1:10)) %>% +#' rangeslider(xaxes = "xaxis2") +#' +rangeslider <- function(p, start = NULL, end = NULL, xaxes = "all", ...) { + if (identical(xaxes, "all")) { + xaxes <- grep("^xaxis", names(p$x$layout), value = TRUE) + xaxes <- xaxes %||% "xaxis" } - p$x$layout$xaxis$range <- c( - to_milliseconds(start), - to_milliseconds(end) - ) + if (any(!grepl("^xaxis", xaxes))) { + stop("The `xaxes` argument must contain xaxis ids (e.g. xaxis, xaxis2, etc)") + } + + for (x in xaxes) { + if (!is.null(start) && !is.null(end)) { + p$x$layout[[x]]$range <- c( + to_milliseconds(start), + to_milliseconds(end) + ) + } else if (!is.null(start) || !is.null(end)) { + stop("Both start and end must be specified") + } + slider_old <- p$x$layout[[x]]$rangeslider + slider_new <- list(visible = TRUE, ...) + p$x$layout[[x]]$rangeslider <- modify_list(slider_old, slider_new) + } - p$x$layout$xaxis$rangeslider <- list(visible = TRUE, ...) p } diff --git a/man/rangeslider.Rd b/man/rangeslider.Rd index be1a800f84..9475112981 100644 --- a/man/rangeslider.Rd +++ b/man/rangeslider.Rd @@ -4,14 +4,17 @@ \alias{rangeslider} \title{Add a range slider to the x-axis} \usage{ -rangeslider(p, start = NULL, end = NULL, ...) +rangeslider(p, start = NULL, end = NULL, xaxes = "all", ...) } \arguments{ \item{p}{plotly object.} -\item{start}{a start date/value.} +\item{start}{a starting value for the rangeslider's range.} -\item{end}{an end date/value.} +\item{end}{an ending value for the rangeslider's range.} + +\item{xaxes}{xaxis ids to generate rangesliders. +The default adds a rangeslider to every xaxis in the plot object.} \item{...}{these arguments are documented here \url{https://plot.ly/r/reference/#layout-xaxis-rangeslider}} @@ -21,7 +24,7 @@ Add a range slider to the x-axis } \examples{ -plot_ly(x = time(USAccDeaths), y = USAccDeaths) \%>\% +p1 <- plot_ly(x = time(USAccDeaths), y = USAccDeaths) \%>\% add_lines() \%>\% rangeslider() @@ -30,11 +33,21 @@ d <- tibble::tibble( y = rnorm(seq_along(time)) ) -plot_ly(d, x = ~time, y = ~y) \%>\% +p2 <- plot_ly(d, x = ~time, y = ~y) \%>\% add_lines() \%>\% rangeslider(d$time[5], d$time[50]) +subplot(p1, p2, nrows = 2, margin = 0.1) +# calling rangeslider on a plot with multiple axes +# generates multiple rangesliders +subplot(qplot(1:10), qplot(1:10, 1:10)) \%>\% + rangeslider() + +# add a rangeslider to just the 2nd xaxis +subplot(qplot(1:10), qplot(1:10, 1:10)) \%>\% + rangeslider(xaxes = "xaxis2") + } \author{ Carson Sievert diff --git a/tests/figs/rangeslider/rangeslider-multiple-axes.svg b/tests/figs/rangeslider/rangeslider-multiple-axes.svg new file mode 100644 index 0000000000..61cf239134 --- /dev/null +++ b/tests/figs/rangeslider/rangeslider-multiple-axes.svg @@ -0,0 +1 @@ +2.55.07.510.00.000.250.500.751.002.55.07.510.02.55.07.510.0 diff --git a/tests/figs/rangeslider/rangeslider-range.svg b/tests/figs/rangeslider/rangeslider-range.svg new file mode 100644 index 0000000000..6077606c24 --- /dev/null +++ b/tests/figs/rangeslider/rangeslider-range.svg @@ -0,0 +1 @@ +Jan 102016Jan 17Jan 24Jan 31Feb 7Feb 14−3−2−10123ytime diff --git a/tests/figs/rangeslider/rangeslider-subplot.svg b/tests/figs/rangeslider/rangeslider-subplot.svg new file mode 100644 index 0000000000..4d7612b6fe --- /dev/null +++ b/tests/figs/rangeslider/rangeslider-subplot.svg @@ -0,0 +1 @@ +1973197419751976197719787k8k9k10k11kJan 102016Jan 17Jan 24Jan 31Feb 7Feb 14−202trace 0trace 1 diff --git a/tests/figs/rangeslider/rangeslider-targetted-axis.svg b/tests/figs/rangeslider/rangeslider-targetted-axis.svg new file mode 100644 index 0000000000..a69e134ad8 --- /dev/null +++ b/tests/figs/rangeslider/rangeslider-targetted-axis.svg @@ -0,0 +1 @@ +2.55.07.510.00.000.250.500.751.002.55.07.510.02.55.07.510.0 diff --git a/tests/figs/rangeslider/rangeslider.svg b/tests/figs/rangeslider/rangeslider.svg new file mode 100644 index 0000000000..45a180388d --- /dev/null +++ b/tests/figs/rangeslider/rangeslider.svg @@ -0,0 +1 @@ +1973197419751976197719787k8k9k10k11k diff --git a/tests/testthat/test-plotly-rangeslider.R b/tests/testthat/test-plotly-rangeslider.R new file mode 100644 index 0000000000..2f2af1dc4a --- /dev/null +++ b/tests/testthat/test-plotly-rangeslider.R @@ -0,0 +1,40 @@ +context("rangeslider") + +p1 <- 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)) +) + +p2 <- plot_ly(d, x = ~time, y = ~y) %>% + add_lines() %>% + rangeslider(d$time[5], d$time[50]) + +p3 <- subplot(p1, p2, nrows = 2, margin = 0.1) + +test_that("Basic rangeslider", { + expect_doppelganger(p1, "rangeslider") +}) + +test_that("Rangeslider range", { + expect_doppelganger(p2, "rangeslider-range") +}) + +test_that("Rangeslider subplot", { + expect_doppelganger(p3, "rangeslider-subplot") +}) + +test_that("Rangeslider multiple axes", { + p <- subplot(qplot(1:10), qplot(1:10, 1:10)) %>% + rangeslider() + expect_doppelganger(p, "rangeslider-multiple-axes") +}) + +test_that("Rangeslider targetted axis", { + p <- subplot(qplot(1:10), qplot(1:10, 1:10)) %>% + rangeslider(xaxes = "xaxis2") + expect_doppelganger(p, "rangeslider-targetted-axis") +})