Embed ggplot output in htmlOutput

shiny
,
1

Hello, I have a Shiny app that displays a table of information where each row of that table is defined using custom HTML. Within the HTML I have a place to display a plot. Currently I am pre-generating all potential plot images I would need and serving them up as .png in the code. I would like to replace these static images with interactive ggplot outputs, but can't figure out how to embed this functionality within the HTML block. Here is a super simplified version of what I'm trying to do.

ui.R

library(shiny)
library(shinydashboard)
library(ggplot2)

menuWidth=300
header <- dashboardHeader(titleWidth=menuWidth)

sidebar <- dashboardSidebar(width=menuWidth,
  tags$head(tags$style(HTML('.content-wrapper {}'))),
  sidebarMenu(style = "position: fixed; overflow: visible;",
    uiOutput('cyl_dropbox')
  )
)
    
body <- dashboardBody(

  tabBox(width=10,
    tabPanel('Plots',

      fluidRow(
          column(width=1),
          column(width=10,
              h2('Normal plotOutput object'),
              plotOutput('car_plot1')
          ),
          column(width=1)
      ),
      fluidRow(
        br(),
        br(),
        htmlOutput('car_plot2')
      )
    )
  )  
)
                    
suppressWarnings(dashboardPage(header, sidebar, body))

server.R

html_template <- function()
{
  tags$div(class="well",
    style="margin-block-end:0.5em;",
    tags$div(class="row",
      tags$div(class="col-md-9",
        tags$div(class="row",
          tags$div(class="col-md-4",
                   tags$h5(style="margin-block-end:0em; margin-top: 0px; font-weight: bold;", "Stuff"),
                   tags$p(style="margin-block-end:0em;", "sub stuff"),
                   tags$p(style="margin-block-end:0em;", "other stuff"),
                   tags$p(style="margin-block-end:0em;", "more stuff")
          ),
          tags$div(class="col-md-2",
                   tags$h5(style="margin-block-end:0em; margin-top: 0px; font-weight: bold;", "Things"),
                   tags$p(style="margin-block-end:0em;", "that thing"),
                   tags$p(style="margin-block-end:0em;", "those things"),
                   tags$p(style="margin-block-end:0em;", "the other thing")
          )
        )
      )
    ),
    tags$div(
      tags$div(class="row",
        tags$div(class="col-md-11",
         hr(),
        
          ## This is how im currently doing it, using preprocessed static images      
          tags$img(src="http://drive.google.com/uc?export=view&id=0By6SOdXnt-LFaDhpMlg3b3FiTEU"),
          tags$h5('How do I replace this static image with the interactive ggplot output above?')
        )
      )
    )
  )
}

attach(mtcars)

shinyServer(function(input, output, session)
{

  ## ------------------------------------
  ## DROP DOWN
  ## ------------------------------------
  output$cyl_dropbox <- renderUI({
      cyl_list <- sort(unique(mtcars$cyl))
      selectInput('cyl_dropbox', 'Select Num Cylinders', cyl_list, selected=cyl_list[1])
  })
    
  
  ## ------------------------------------
  ## PLOTS
  ## ------------------------------------
  
  ## normal plot
  output$car_plot1 <- renderPlot({
      temp <- subset(mtcars, cyl == input$cyl_dropbox)
      
      p <- ggplot(data=temp, aes(x=hp, y=mpg)) + geom_point()
      return(p)
  })
    
  ## plot wrapped in custom HTML 
  output$car_plot2 <- renderUI({
    html_list <- list()
    html_list[[1]] <- html_template()
    return(html_list)
  })
    
})

Any help is appreciated, thanks!

2

Well I figured out the first step of getting a ggplot within custom HTML ... move the HTML to ui.R!

ui.R

library(shiny)
library(shinydashboard)
library(ggplot2)

HTML_template <- function(index)
{
  tags$div(class="well", style="margin-block-end:0.5em;",
    tags$div(class="row",
      tags$div(class="col-md-9",
        tags$div(class="row",
          tags$div(class="col-md-4",
                   tags$h5(style="margin-block-end:0em; margin-top: 0px; font-weight: bold;", "Stuff"),
                   tags$p(style="margin-block-end:0em;", "sub stuff"),
                   tags$div(id=paste0("text", index), class="shiny-text-output"),
                   tags$p(style="margin-block-end:0em;", "more stuff")
          ),
          tags$div(class="col-md-2",
                   tags$h5(style="margin-block-end:0em; margin-top: 0px; font-weight: bold;", "Things"),
                   tags$p(style="margin-block-end:0em;", "that thing"),
                   tags$p(style="margin-block-end:0em;", "those things"),
                   tags$p(style="margin-block-end:0em;", "the other thing")
          )
        )
      )
    ),
    tags$div(
      tags$div(class="row",
        tags$div(class="col-md-11",
          hr(),
          tags$div(id=paste0("car_plot", index), class="shiny-plot-output", style="width: 100%; height: 400px")
        )
      )
    )
  )
}


menuWidth=300
header <- dashboardHeader(titleWidth=menuWidth)

sidebar <- dashboardSidebar(width=menuWidth,
  tags$head(tags$style(HTML('.content-wrapper {}'))),
  sidebarMenu(style = "position: fixed; overflow: visible;",
    uiOutput('cyl_dropbox')
  )
)
    
body <- dashboardBody(
  tabBox(width=10,
    tabPanel('Plots',
      fluidRow( HTML_template(1) ),
      fluidRow( HTML_template(2) )
    )
  )
)
                    
suppressWarnings(dashboardPage(header, sidebar, body))

server.R


attach(mtcars)

shinyServer(function(input, output, session)
{

  ## ------------------------------------
  ## DROP DOWN
  ## ------------------------------------
  output$cyl_dropbox <- renderUI({
      cyl_list <- sort(unique(mtcars$cyl))
      selectInput('cyl_dropbox', 'Select Num Cylinders', cyl_list, selected=cyl_list[1])
  })
    
  
  ## ------------------------------------
  ## PLOTS
  ## ------------------------------------
  output$car_plot1 <- renderPlot({
      temp <- subset(mtcars, cyl == input$cyl_dropbox)
      p <- ggplot(data=temp, aes(x=hp, y=mpg)) + geom_point(color='red')
      return(p)
  })
    
  output$car_plot2 <- renderPlot({
      temp <- subset(mtcars, cyl == input$cyl_dropbox)
      p <- ggplot(data=temp, aes(x=hp, y=mpg)) + geom_point(color='blue')
      return(p)
  })
  
  ## ------------------------------------
  ## TEXT
  ## ------------------------------------  
  output$text1 <- renderText({
    return('TEXT OUTPUT UNO')
  })
    
  output$text2 <- renderText({
    return('TEXT OUTPUT ZWEI')
  })  
})

This will still be a huge pain as I need to parameterize all the content into outputs (like text1, text2, car_plot1, car_plot2 above) but I see a path forward now. Hope this helps someone.

1 Like
3

Hi,

I'm looking into it too, but it's a complex problem indeed :slight_smile: Can you explain why you' like to do this? Is there any particular reason? Also, how many interactive ggplots you expect, an will they all depend on the same input, or each have different input parameters the user can set? Just want to get an idea of the end-result :stuck_out_tongue:

PJ

4

I suspect that you are effectively rolling your own 'modules' but shiny provides a framework for that.
https://shiny.rstudio.com/articles/modules.html

1 Like
5

Hi PJ, let me describe the real product a bit more. The HTML chunk is a lot more complicated, with javasript and scss bits thrown in. It looks really nice, much fancier than a generic tableOutput or dataTables output. There are buttons within each table row (HTML chunk) with expandable/collapsible content, and one of these expandable bits is a ggplot image. The goal is not to update the plot with widgets, but to allow users to click on data points in the plot to pop up more info. There will be a max of 25 rows at any time.

6

Thanks nirgrahamuk, I will check that out!

7

HI,

That sounds interesting! In that case I indeed also recommend shiny modules. I was looking into it myself as a solution yesterday, but I'm not very familiar with them and your stuff will immediately require some advanced coding with modules :slight_smile:

Good luck

8

This topic was automatically closed 7 days after the last reply. New replies are no longer allowed.