Display html widget from plumber API in shiny application

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?

Thanks for the help!

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)

Recommended topics

Hot tags