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

Posted 2023-02-16

【中文标题】如何将带有 plotly 的 ggplot 嵌入到 r 闪亮的应用程序或 flexdashboard 中？

【英文标题】：How do I embedd a ggplot with plotly into an rshiny app or flexdashboard?

【发布时间】：2021-12-28 02:01:46

【问题描述】：

我有下面的脚本，它创建了一个交互式情节。我想把它嵌入到某种闪亮的应用程序或 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"))

【问题讨论】：

参见例如towardsdatascience.com/… 或flexdashboard website 上的示例或

【参考方案1】：

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)

【讨论】：

这太完美了！谢谢你。你知道有没有办法在没有付费订阅的情况下私​​下发布到 shinyapps.io？

我认为这是不可能的。但你可以使用免费版和password protect it。

超级有帮助，谢谢！！