r - 在 Shiny 的应用程序中显示来自管道工 API 的 html 小部件

Question

我正在尝试显示通过管道工 API 请求的交互式图形并将其显示在 Shiny 的应用程序中。
我不知道如何使它工作，例如使用 highcharter。
下面是我使用 api 的带有基本图和 highcharter 图的示例应用程序。

我有 api 工作，但有人知道如何解析 htmlwidget 输入以进行显示吗？

谢谢您的帮助!

示例api，开始使用

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)
}

应用程序

# 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)

Answer 1

根据这个答案的想法，我设法在 Shiny 应用程序中渲染了一个管道工制作的小部件:https://github.com/trestletech/plumber/issues/254 .所需要做的就是在 Shiny UI 中插入一个 html 对象标签:

tags$html(HTML('<object data="<LINK TO YOUR WIDGET HERE>" width="100%" height="500px" type="text/html"> </object>')

请注意，这在 RStudio 查看器中不起作用。它适用于 Chrome (v71.0.3578.98) 但不适用于 Edge 或 IE。