我正在尝试显示通过管道工 API 请求的交互式图形,并将其显示在闪亮的应用程序中。我不知道如何使它工作,例如使用 highcharter。下面是我的示例应用程序,其中包含使用 api 的基本图和高级图。
我有 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)
}
应用程序.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)