Parsing html widget from plumber API for shiny

shiny
, , ,
1

I'm trying to display an interactive graph requested through a plumber API and display it in a shiny application.
I can't figure out how to make it work, using for example highcharter.
My example application with a base plot and highcharter graph using an api is below.

I have the api working but does anyone know how to parse the htmlwidget input for display?

Example api, start using

library(plumber)
r <- plumb("api.R") 
r$run(port=8000)

api.R

#' Plot out data from the iris dataset
#' @param spec If provided, filter the data to only this species (e.g. 'setosa')
#' @get /plot
#' @png
function(spec){
  myData <- iris
  title <- "All Species"
  
  # Filter if the species was specified
  if (!missing(spec)){
    title <- paste0("Only the '", spec, "' Species")
    myData <- subset(iris, Species == spec)
  }
  
  plot(myData$Sepal.Length, myData$Petal.Length,
       main=title, xlab="Sepal Length", ylab="Petal Length")
}

#' Plot the iris dataset using interactive chart
#' 
#' @param spec Species to filter
#'
#' @get /highchart
#' @serializer htmlwidget
function(spec){
  library(highcharter)

  myData <- iris
  title <- "All Species"
  
  # Filter if the species was specified
  if (!missing(spec)){
    title <- paste0("Only the '", spec, "' Species")
    myData <- subset(iris, Species == spec)
  }
  
  hchart(myData, "scatter", hcaes(x = Sepal.Length, y = Petal.Length, group = Species)) %>%
    hc_title(text = title)
}

app.R

# Application
library(shiny)
library(shinyjs)
library(shinydashboard)
library(httr)
library(grid)
library(ggplot2)

ui <- dashboardPage(
  dashboardHeader(title = "Image and Widget", titleWidth = 300),
  dashboardSidebar(disable = TRUE),
  dashboardBody(
    useShinyjs(), 
    fluidRow(
      column(width = 6, 
             shinydashboard::box(width = 12, 
                                 htmlOutput("species_selector"), 
                                 actionButton(inputId = "filter_action", label = "Filter", icon("search"), 
                                              style = "color: #fff; background-color: #337ab7; border-color: #2e6da4") 
             ) 
      ) 
    ), 
    fluidRow(
      column(width = 6, 
             shinyjs::hidden( 
               div(id = "iris_chartbox",
                   shinydashboard::tabBox(width = 12, 
                                          tabPanel(title = "Iris Base Plot", width = 12, 
                                                   imageOutput("iris_base_plot")
                                          ), 
                                          tabPanel(title = "Iris highchart", width = 12, 
                                                   uiOutput("iris_highchart")
                                          )
                   )
               ) 
             ) 
      )
    )
  )
)

server <- function(input, output) {
  
  # Make product line selector ----
  output$species_selector <- renderUI({ 
    selectInput( 
      inputId = "species_chosen",  
      label = "Species Chosen", 
      choices = c("setosa", "virginica", "versicolor")
    )
  })
  
  # Observe button click ----
  observeEvent(input$filter_action, { 
    # Make iris graph ----
    output$iris_base_plot <- renderImage({
      
      # A temp file to save the output. It will be deleted after renderImage
      # sends it, because deleteFile=TRUE.
      outfile <- tempfile(fileext = '.png')
      
      # Generate a png
      png(outfile, width = 400, height = 400)
      get_iris_base_plot(spec = input$species_chosen)
      dev.off()
      
      # Return a list
      list(src = outfile,
           alt = "This is alternate text") 
    }, deleteFile = TRUE)
    
    # Make iris highcharter graph ----
    output$iris_highchart <- renderUI({
      
      # Get the image
      interactive_graph <- get_iris_highchart(spec = isolate(input$species_chosen))
      
      return(interactive_graph)
    })
    
    shinyjs::show("iris_chartbox")
  })
}

# Function to make base plot graph ----
get_iris_base_plot <- function(spec) {
  req <- GET(URLencode(paste0("http://127.0.0.1:8000/plot?spec=", spec)))
  
  # Parse the request
  img_content <- httr::content(req, type = "image/png")
  
  # Visualise
  grid.raster(img_content) 
}

# Function to make highchart graph ----
get_iris_highchart <- function(spec) {
  my_req <- GET(URLencode(paste0("http://127.0.0.1:8000/highchart?spec=", spec)))
  
  # Parse the request
  req_content <- httr::content(my_req, type = "text/html; charset=utf-8")
  
  # Visualise
  req_content
}

shinyApp (ui, server)
2

Not sure I have the answer but I can help you by pointing out the part of your code that questioned me

  • Why using dev.off() here ? you also commented Generate a png but get_iris_highchart returns HTML if I understand correctly per the doc
  • I am not sure why you have outfile <- tempfile(fileext = '.html') and how you intend to use it.
  • as the api return html (serializer uses htmlwidgets::saveWidget()), I wonder if you should not use renderImage... I think you can include the HTML result you get from the API directly in your UI using renderUI() and HTML()

As hightchart endpoint is not visible in your api.R, I assume you use the same serializer than plotly endpoint

Hope this few comment will help you make it work ! Nice idea this plumber + shiny !

1 Like
3

Thanks @cderv, I have cleaned up my example to make it clearer, it is now just using highcharter.

I have updated to code with your comments, I'll keep trying using HTML() to display the result but it appears that the request doesn't return pure HTML, but a nested list.

I think I may need to sub set the query result to display it on the UI

4

Crossposted to SO: https://stackoverflow.com/questions/52722178/display-html-widget-from-plumber-api-in-shiny-application