Combine multiple widgets in a single htmlwidget object.

[FrancoisGuillem]

It would be nice to be able to combine multiple widgets in the single like one can combine multiple static plots in a single one using par(mfrow = c(...)), for instance to compare the same graphic generated on different datasets or to visualize different informations about the same data.

For now, to do so one has to create a complete shiny app/gadget or to create a rmarkdown document. But during analysis work, it would be be nice to be able to quickly combine widgets with a simple function.

I implemented a function that do this using htmltools and miniUI but it is very hacky and has problems of sizing (0px height on rmarkdown documents). Moreover, the function needs to perform a special processing for each kind of htmlwidget.

#' Combine several interactive plots
#'
#' This function combines different interactive plots in a unique view. It is
#' especially useful in the function \code{\link{manipulateWidget}} to have in
#' the same window several related plots that respond to the same set of
#' controls.
#'
#' @param ...
#'   Elements to combine. They should be htmlwidgets, but they can also be
#'   shiny tags or html object or text
#' @param nrow
#'   Number of rows of the layout.
#' @param ncol
#'   Number of columns of the layout.
#' @param title
#'   Title of the view
#' @param hflex
#'   This argument controls the relative size of each column. For instance, if
#'   the layout has two columns and \code{hflex = c(2,1)}, then the width of the
#'   first column will be twice the one of the second one. If a value is equal
#'   to NA, then the corresponding column will have its 'natural' width, and the
#'   remaining space will be shared between the other columns.
#' @param vflex
#'   Same as hflex but for the height of the rows of the layout.
#'
#' @return
#' Object of class 'combinedHtmlwidgets' which is an extension of 'shiny.tags'.
#'
#' @details
#' The function only allows table like layout : each row has the same number of
#' columns and reciprocally. But it is possible to create more complex layout
#' by nesting combined htmlwidgets. (see examples)
#'
#' @examples
#' if require(plotly) {
#'   data(iris)
#'
#'  combineWidgets(title = "The Iris dataset",
#'    plot_ly(iris, x = Sepal.Length, type = "histogram", nbinsx = 20),
#'    plot_ly(iris, x = Sepal.Width, type = "histogram", nbinsx = 20),
#'    plot_ly(iris, x = Petal.Length, type = "histogram", nbinsx = 20),
#'    plot_ly(iris, x = Petal.Width, type = "histogram", nbinsx = 20)
#'  )
#'
#'  # Create a more complex layout by nesting combinedWidgets
#'  combineWidgets(title = "The iris data set: sepals", ncol = 2, hflex = c(2,1),
#'    plot_ly(iris, x = Sepal.Length, y = Sepal.Width, mode = "markers", color = Species),
#'    combineWidgets(
#'      plot_ly(iris, x = Sepal.Length, type = "histogram", nbinsx = 20),
#'      plot_ly(iris, x = Sepal.Width, type = "histogram", nbinsx = 20)
#'    )
#'  )
#'
#' }
#'
#' @export
#'
combineWidgets <- function(..., nrow = NULL, ncol = NULL, title = NULL,
                           hflex = 1, vflex = 1) {

  widgets <- lapply(list(...), .processOutput)

  # Get Number of rows and columns
  nwidgets <- length(widgets)
  if (!is.null(nrow) && !is.null(ncol) && nrow * ncol < nwidgets) {
    stop("There are too much widgets compared to the number of rows and columns")
  } else if (is.null(nrow) && !is.null(ncol)) {
    nrow <- ceiling(nwidgets / ncol)
  } else if (!is.null(nrow) && is.null(ncol)) {
    ncol <- ceiling(nwidgets / nrow)
  } else {
    nrow <- ceiling(sqrt(nwidgets))
    ncol <- ceiling(nwidgets / nrow)
  }

  hflex <- rep(hflex, length.out = ncol)
  vflex <- rep(vflex, length.out = nrow)

  rows <- lapply(1:nrow, function(i) {
    args <- widgets[((i-1) * ncol + 1):(i * ncol)]

    # If vflex is NA for this row, then try to infer the height of the row.
    if (is.na(vflex[i])) {
      heights <- unlist(sapply(args, function(x) {
        if (!is.list(x)) return (NULL)
        if (!is.null(x$height)) return(x$height)
        if (!is.null(x$attribs)) return(x$attribs$height)
        NULL
      }))
      if (!is.null(heights)) {
        heights <- na.omit(heights)
        if (length(heights) > 0)  args$height <- heights[1]
      }
      if (is.null(args$height)) args$height <- 200
    }

    args$flex <- hflex
    do.call(fillRow, args)
  })

  # Title
  if(!is.null(title)) {
    vflex <- c(NA, vflex)
    title <- tags$div(style = "text-align: center;",
      tags$h1(title)
    )
    rows <- append(list(title), rows)
  }

  rows$flex <- vflex

  res <- do.call(fillCol, rows)
  class(res) <- append("combinedHtmlwidgets", class(res))
  res
}

#' @export
print.combinedHtmlwidgets <- function(x, ...) {
  htmltools:::html_print(miniPage(x))
}

#' Prepare widgets and other types of objects to be displayed in the shiny
#' gadget
#' @noRd
.processOutput <- function(x) {

  if (is(x, "plotly_hash")) {
    if(requireNamespace("plotly")) {
      x <- plotly::as.widget(x)
      x$width <- x$height <- "100%"
      return(x)
    }
    else return("Package plotly is missing")
  }

  if (is(x, "datatables")) {
    # How to set size ?
    return(tags$div(htmltools::as.tags(x),
                    style = "width:100%;max-height:100%;overflow:auto"))
  }

  if (is(x, "htmlwidget")) {
    x$width <- x$height <- "100%"
    return(x)
  }

  x
}

[cpsievert]

Great stuff @cuche27! I find arranging multiple htmlwidgets to be painful as well, and would love an official solution. BTW, in the dev version of plotly, plotly object are htmlwidget objects, so we won't be needing this in .processOutput:

if (is(x, "plotly_hash")) {
    if(requireNamespace("plotly")) {
      x <- plotly::as.widget(x)
      x$width <- x$height <- "100%"
      return(x)
    }
    else return("Package plotly is missing")
  }

[FrancoisGuillem]

Hello and happy new year,

I wanted to inform you that I have finally included my function combineWidgets in another package I have developed for a client in order to make it more sustainable: https://github.com/rte-antares-rpackage/manipulateWidget

The purpose of this package is to help users to create easily and quickly graphical interface in order to change the data or the graphical parameters of an htmlwidget. It uses shiny gadget, but the user does not have to know anything about shiny, HTML or CSS.

I have submitted it to CRAN today and I hope it will be published soon.

[ramnathv]

@FrancoisGuillem This looks really awesome! I think it would be nice to start a section on the htmlwidgets site where we can point users to packages like manipulateWidget that enhance the feature set of htmlwidgets @jjallaire @jcheng5 @timelyportfolio @yihui what do you think?

[jjallaire]

@FrancoisGuillem <https://github.com/FrancoisGuillem> one addition I'd love to see here is to make it possible to publish manipulateWidget based layouts. From what I can see now it looks like manipulateWidget is only for local interactive use in the Viewer pane. If it had the right print methods though it seems like you could include it within an R Markdown document with runtime: shiny which would allow it to be deployed directly to end users (this is sort of how ggviz works).

…

On Wed, Jan 4, 2017 at 8:31 AM, Ramnath Vaidyanathan < ***@***.***> wrote: @FrancoisGuillem <https://github.com/FrancoisGuillem> This looks really awesome! I think it would be nice to start a section on the htmlwidgets site where we can point users to packages like manipulateWidget that enhance the feature set of htmlwidgets @jjallaire <https://github.com/jjallaire> @jcheng5 <https://github.com/jcheng5> @timelyportfolio <https://github.com/timelyportfolio> @yihui <https://github.com/yihui> what do you think? — You are receiving this because you were mentioned. Reply to this email directly, view it on GitHub <#226 (comment)>, or mute the thread <https://github.com/notifications/unsubscribe-auth/AAGXx7TJJqqShOmwIRgrmzylYqkS6D7Uks5rO59IgaJpZM4JoiWl> .

[jjallaire]

@ramnathv I agree that there are a few things long overdue for the website:

1. Link to flexdashboard and manipulateWidget

2. Link to crosstalk

[FrancoisGuillem]

@jjallaire this is a very nice idea. What is the name of the method I need to write to implement it ? Is there a way to know that we are in "runtime: shiny" mode ?

[jjallaire]

I just added prominent navigational and home page links to the flexdashboard and crosstalk packages (I gave them special consideration because they are core add-ons to the htmlwidgets package created by the same authors). Next we need to figure out a way to link prominently to "third-party" add-ons (it may be that the Gallery can already accommodate this, but it seems like distinguishing between layout oriented widget aggregators and actual widgets would be useful)

[jjallaire]

@FrancoisGuillem <https://github.com/FrancoisGuillem> let me take a closer look at your implementation then I'll propose the right change.

…

On Wed, Jan 4, 2017 at 10:01 AM, François Guillem ***@***.***> wrote: @jjallaire <https://github.com/jjallaire> this is a very nice idea. What is the name of the method I need to write to implement it ? Is there a way to know that we are in "runtime: shiny" mode ? — You are receiving this because you were mentioned. Reply to this email directly, view it on GitHub <#226 (comment)>, or mute the thread <https://github.com/notifications/unsubscribe-auth/AAGXx7y8Gliz6ktodvazxIkPklrKCXa7ks5rO7RGgaJpZM4JoiWl> .

[jjallaire]

@FrancoisGuillem Here is a diff that shows what is required to support printing manipulateWidget in Rmd documents with runtime: shiny:

jjallaire/manipulateWidget@3386099?w=1

There is also a simple example which I put into inst/examples.

Note that I would have given this to you as a PR but my changes for some reason created a diff with every line changed (just whitespace) and I didn't think you'd want to merge a change with so much diff noise.

[FrancoisGuillem]

@jjallaire Wow that was fast ! Thank you :). Can you add yourself as a contributor in the DESCRIPTION file ?

[jjallaire]

I was thinking that it wouldn't be a PR (because of the whitespace issues) so you could add me in the DESCRIPTION file on your master branch. One other thing is that you'll want to import the knitr package so you can make the call to determine whether you are in runtime: shiny.

…

On Wed, Jan 4, 2017 at 11:24 AM, François Guillem ***@***.***> wrote: @jjallaire <https://github.com/jjallaire> Wow that was fast ! Thank you :). Can you add yourself as a contributor in the DESCRIPTION file ? — You are receiving this because you were mentioned. Reply to this email directly, view it on GitHub <#226 (comment)>, or mute the thread <https://github.com/notifications/unsubscribe-auth/AAGXx_AJlpLn7TflUA4uhuA2o6OihkcSks5rO8eggaJpZM4JoiWl> .

[FrancoisGuillem]

@jjallaire Ok, thank you :)