Adding tooltips to graphs

[RossKen]

Great package! Has been really useful for data exploration.

I was wondering if you guys had considered adding tooltips to graphs? I know that ggplot doesn't have this, but there are a few ways it could be incorporated into the shiny app (https://stackoverflow.com/questions/38917101/how-do-i-show-the-y-value-on-tooltip-while-hover-in-ggplot2).

Does this sound like functionality you guys would want to add? If so, I am happy to go away and put together a PR.

[rpalloni]

Sure! As I was writing in #26 it will be cool to add ggplotly() wrapper on the ggplot object.

[RossKen]

Ah ok, sorry I missed that @rpalloni

I will have a look at the code at some point in the next week and see what I can figure out .

[pvictor]

Thanks to both of you for the proposal, it would indeed be a nice faeature. I will first focus on possible bugs and integrate as many ggplot2 parameters as possible for the next release. I think I will integrate plotly in version 2.0.0.

Victor

[GitHunter0]

Yes, this would be great

[JoaoMatheusHneda]

Hello,

Is there any update about integration between esquisse and plotly? It would be good to have a button to activate the graphics interactivity!

Thanks!

[daattali]

Ping, it would be very useful to have an option for plotly. I see #114 is an attempt at that, but that seems very ambitious and includes more functionality.

Until such a huge change can be added, it might be worthwhile to simply include a checkbox for "Convert to plotly*" and all it does it wrap the plot to plotly with ggplotly(). We all know that the conversion may not retain 100% of the features, but that's fine, there can be a tooltip on the checkbox explaining this (or not). I think just having plotly support in a minimal way will already be a huge gain.

[CorneeldH]

Besidedes ggplotly, you also need the output and render functions to adapt.

I made a few very small changes to to the ggplot_output and render_plot and included an example, see below.

Of course, it could all be handed with optional arguments in the original functions that can be clicked.

@pvictor: I don't know to what requirements you have for pull requests or how stabile the API is? I think the package is fantastic, and, due to it being a shiny module extensible by default. In the coming months I will check how extensible exactly and try to fit it to some of my use-cases. I would be more than happy to contribute in some way or another.

ggplotly_output <- function(id, width = "100%", height = "400px", downloads = NULL, ...) {
  ns <- NS(id)
  tags$div(
    class = "ggplot-container",
    style = css(
      position = "relative",
      width = validateCssUnit(width),
      height = validateCssUnit(height)
    ),
    if (!is.null(downloads)) {
      e <- downloads[-1]
      e <- e[-length(e)]
      download_links <- lapply(
        X = seq_along(e),
        FUN = function(i) {
          if (is.null(e[[i]]))
            return(NULL)
          tagList(
            downloadLink(
              outputId = ns(paste0("export_", names(e)[i])),
              label = e[[i]]
            ),
            tags$br()
          )
        }
      )
      dropMenu(
        actionButton(
          inputId = ns("exports"),
          label = downloads$label,
          class = "btn-sm esquisse-export-btn",
          style = css(
            position = "absolute",
            top = 0,
            right = "5px",
            zIndex = 30
          )
        ),
        placement = "bottom-end",
        download_links,
        if (!is.null(downloads$more)) {
          tagList(
            tags$hr(style = "margin: 5px 0;"),
            actionLink(inputId = ns("more"), label = downloads$more)
          )
        }
      )
    },
    plotlyOutput(outputId = ns("plot"), width = width, height = height, ...)
  )
}

render_ggplotly <- function(id,
                          expr,
                          ...,
                          env = parent.frame(),
                          quoted = FALSE,
                          filename = "export-ggplot") {
  gg_fun <- exprToFunction(expr, env, quoted)
  moduleServer(
    id = id,
    module = function(input, output, session) {
      output$export_png <- download_plot_fun(gg_fun, "png", filename, session)
      output$export_pdf <- download_plot_fun(gg_fun, "pdf", filename, session)
      output$export_svg <- download_plot_fun(gg_fun, "svg", filename, session)
      output$export_jpeg <- download_plot_fun(gg_fun, "jpeg", filename, session)
      output$export_pptx <- downloadHandler(
        filename = function() {
          if (is.reactive(filename))
            filename <- filename()
          if (endsWith(filename, "\\.pptx"))
            filename
          else
            paste0(filename, ".pptx")
        },
        content = function(file) {
          if (requireNamespace(package = "rvg") & requireNamespace(package = "officer")) {
            gg <- gg_fun()
            ppt <- officer::read_pptx()
            ppt <- officer::add_slide(x = ppt, layout = "Blank")
            ppt <- try(officer::ph_with(
              x = ppt, rvg::dml(ggobj = gg),
              location = officer::ph_location_fullsize()
            ), silent = TRUE)
            if ("try-error" %in% class(ppt)) {
              shiny::showNotification(
                ui = i18n("Export to PowerPoint failed..."),
                type = "error",
                id = paste("esquisse", sample.int(1e6, 1), sep = "-")
              )
            } else {
              tmp <- tempfile(pattern = "esquisse", fileext = ".pptx")
              print(ppt, target = tmp)
              file.copy(from = tmp, to = file)
            }
          } else {
            warn <- "Packages 'officer' and 'rvg' are required to use this functionality."
            warning(warn, call. = FALSE)
            shiny::showNotification(
              ui = warn,
              type = "warning",
              id = paste("esquisse", sample.int(1e6, 1), sep = "-")
            )
          }
        }
      )
      rv <- reactiveValues(plot = NULL)
      output$plot <- renderPlotly({
        rv$plot <- ggplotly(gg_fun())
        rv$plot
      }, ...)
      observeEvent(input$more, {
        hideDropMenu("exports_dropmenu")
        save_ggplot_modal(
          id = session$ns("export"),
          title = i18n("Export chart")
        )
      })
      save_ggplot_server("export", plot_rv = rv)
      return(rv)
    }
  )
}

Including a test script:

library(shiny)
library(ggplot2)
library(esquisse)
library(htmltools)
library(plotly)
library(officer)


test <- list.files(path = "R")

walk(test, ~source(paste0("R/", .)))


ui <- fluidPage(
  tags$h2("ggplot output"),
  selectInput("var", "Variable:", names(economics)[-1]),
  plotlyOutput("test"),
  ggplotly_output("MYID", width = "600px")
)

server <- function(input, output, session) {

  output$test <- renderPlotly({
    ggplotly(ggplot(mtcars, aes(x = mpg, y = cyl)) + geom_point())
    })

  render_ggplotly("MYID", {
    ggplot(mtcars, aes(x = mpg, y = cyl)) + geom_point()
  })
}


shinyApp(ui, server)

[pvictor]

You can now (with GitHub version) render plots with Plotly by clicking a switch button in the interface.