时间戳

首页 > 解决方案 > 如何将带有 plotly 的 ggplot 嵌入到 rshiny 应用程序或 flexdashboard 中？

r - 如何将带有 plotly 的 ggplot 嵌入到 rshiny 应用程序或 flexdashboard 中？

问题描述

我有以下创建交互式绘图的脚本。我想把它嵌入到某种闪亮的应用程序或 flexdashboard 中。我该怎么做？

library(ggplot2)
library(dplyr)
library(plotly)
library(viridis)
library(hrbrthemes)

library(gapminder)
data <- gapminder %>% filter(year=="2007") %>% dplyr::select(-year)

p <- data %>%
  mutate(gdpPercap=round(gdpPercap,0)) %>%
  mutate(pop=round(pop/1000000,2)) %>%
  mutate(lifeExp=round(lifeExp,1)) %>%
  
  arrange(desc(pop)) %>%
  mutate(country = factor(country, country)) %>%
  
  mutate(text = paste("Country: ", country, "\nPopulation (M): ", pop, "\nLife Expectancy: ", lifeExp, "\nGdp per capita: ", gdpPercap, sep="")) %>%
  
  ggplot( aes(x=gdpPercap, y=lifeExp, size = pop, color = continent, text=text)) +
    geom_point(alpha=0.7) +
    scale_size(range = c(1.4, 19), name="Population (M)") +
    scale_color_viridis(discrete=TRUE, guide=FALSE) +
    theme_ipsum() +
    theme(legend.position="none")

# turn ggplot interactive with plotly
pp <- ggplotly(p, tooltip="text")
pp

# save the widget
# library(htmlwidgets)
# saveWidget(pp, file=paste0( getwd(), "/HtmlWidget/ggplotlyBubblechart.html"))

标签： rggplot2shinyplotlyflexdashboard

解决方案

一个shinydashboard例子：

library(shiny)
library(shinydashboard)
library(ggplot2)
library(dplyr)
library(plotly)
library(viridis)
library(hrbrthemes)
library(htmlwidgets)
library(gapminder)

gapminderdata <- gapminder %>% filter(year=="2007") %>% dplyr::select(-year)

ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(
    sidebarMenu(
      menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard"))
    )
  ),
  dashboardBody(
    tabItems(
      tabItem(tags$style(type = "text/css", "#myPlot {height: calc(87vh) !important;}"),
              tabName = "dashboard",
              fluidRow(
                column(12,
                       plotlyOutput("myPlot"),
                       br(),
                       downloadButton("myDownloadBtn"))
              )
      )
    )
  )
)

server <- function(input, output, session) {
  
  myData <- reactive({
    gapminderdata %>%
      mutate(gdpPercap=round(gdpPercap,0)) %>%
      mutate(pop=round(pop/1000000,2)) %>%
      mutate(lifeExp=round(lifeExp,1)) %>%
      
      arrange(desc(pop)) %>%
      mutate(country = factor(country, country)) %>%
      
      mutate(text = paste("Country: ", country, "\nPopulation (M): ", pop, "\nLife Expectancy: ", lifeExp, "\nGdp per capita: ", gdpPercap, sep=""))
  })
  
  fig <- reactiveVal(plotly_empty())
  
  output$myPlot <- renderPlotly({
    p <- ggplot(data = myData(), aes(x=gdpPercap, y=lifeExp, size = pop, color = continent, text=text)) +
      geom_point(alpha=0.7) +
      scale_size(range = c(1.4, 19), name="Population (M)") +
      scale_color_viridis(discrete=TRUE, guide=FALSE) +
      theme_ipsum() +
      theme(legend.position="none")
    fig(ggplotly(p, tooltip="text")) # pass plotly object to reactiveVal
    fig() # return plotly object 
  })
  
  output$myDownloadBtn <- downloadHandler(
    filename = function() {
      paste0(gsub(" ","_", gsub(":",".", Sys.time())),"_plotly.html")
    },
    content = function(file) {
      saveWidget(partial_bundle(fig()), file, selfcontained = TRUE)
    }
  )
}

shinyApp(ui, server)

推荐阅读