Demonstrates how to have interactive plots with renderPlot(click, hover, doubleclick) on custom gtable objects.

shiny_gtable_interactive_app.R

#
# This is a Shiny web application. You can run the application by clicking
# the 'Run App' button above.
#
# Find out more about building applications with Shiny here:
#
#    http://shiny.rstudio.com/
#

library(shiny)

library(ggplot2)
library(grid)
library(lemon)
library(gtable)

# Define UI for application that draws a histogram
ui <- fluidPage(
   
   # Application title
   titlePanel("Old Faithful Geyser Data"),
   
    # Show a plot of the generated distribution
    mainPanel(
       plotOutput("plot1", click=clickOpts('click')),
       plotOutput("plot2", height='auto'),
       actionButton('increase','Increase!'),
       textOutput("txt")
    )
)

# custom gtable printing, same as https://github.com/rstudio/shiny/blob/master/R/render-plot.R
# line 264, see shiny issue 841
print.gtblargh <- function(x) {
  cat('BLARRGH!', file=stderr())
  grid::grid.newpage()
  grid::grid.draw(x$gtable)
  
  
  structure(list(
    build = x$build,
    gtable = x$gtable
  ), class = "ggplot_build_gtable")
}

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

  
  output$plot1 <- renderPlot({
    btn <- input$increase
    p <- ggplot(mtcars, aes(x=mpg, y=disp, colour=as.factor(cyl))) +
      geom_point() +
      geom_siderange() + 
      labs(title=btn)
    
    build <- ggplot_build(p)
    gtable <- reposition_legend(p, 'top right', offset=c(0.01, 0.01), plot=FALSE)
    # What happens if there are multiple panels -- but not from facetting?
    # Mainly because we can be jerks!  HAHAH
    gtable <- rbind(gtable_add_cols(gtable, unit(c(1,1), 'lines')), ggplot_gtable(build), size='first')
    i <- which(gtable$layout$name == 'panel')
    gtable$layout$name[i] <- paste('panel-1', seq_along(i), sep='-')
    ## It only works on the first panel, but does so flawlessly. Interesting.
    ## Absence of 'panel' in layout$name forces renderPlot (or whatever) to
    ## treat it like an image - not plot - and the clicker returns pixel positions.
    
    structure(list(build=build, gtable=gtable), class='gtblargh')
    
    #grid.draw(gtable)
    #p + labs(subtitle='nndndnd')
    
  })
  
  output$plot2 <- renderPlot({
    btn <- input$increase
    ggplot(mtcars, aes(x=mpg, y=disp, colour=as.factor(cyl))) +
      geom_point() +
      geom_siderange() +
      labs(title=btn)
  }, height=reactive({300 + input$increase * 20})) 
  
  output$txt <- renderPrint({
    input$click
  })
}

# Run the application 
shinyApp(ui = ui, server = server)