不可能使用闪亮的ggvis

Question

有人能解释一下为什么我的闪亮应用程序在本地运行良好但不能部署到闪亮应用程序吗？

当我将它部署到服务器时，应用程序会加载并且似乎工作正常，直到它变得有点灰暗并出现警告消息“与服务器断开连接”...

我尝试了不同的数据集，但即使使用这个最小的重复性示例，我也无法使应用正常工作：/

重复性例子：

library(shiny)
library(dplyr)
library(shinydashboard)
library(tidyverse)
library(plotly)
library(ggvis)

ID <- c('A12B5', 'A12B5', 'A12B5','B45F8', 'B45F8', 'B45F8', 'G65V7', 'G65V7', 'G65V7')
YEAR <- c(2016, 2017, 2018, 2016, 2017, 2018, 2016, 2017, 2018)
Indice <- c('A', 'B', 'A', 'A', 'B', 'A', 'A', 'B', 'A')
value <- c(0.41, 0.15, 0.67, 0.12, 0.87, 0.46, 0.35, 0.54, 0.74)
df1 <- data.frame(ID, YEAR, Indice, value)
df1$YEAR<- as.factor(df1$YEAR)
df1$Indice <- as.factor(df1$Indice)

ID <- c('A12B5','B45F8','G65V7')
YEAR <- c(2016, 2017, 2018)
Indice <- c('C', 'C', 'C')
value <- c(4.1, 6.4, 1.45)
df2 <- data.frame(ID, YEAR, Indice, value)
df2$YEAR <- as.factor(df2$YEAR)


ui <- dashboardPage(
 dashboardHeader(title ="test"),
  dashboardSidebar(
    sidebarMenu(
      menuItem("test", tabName = "test"))),
  
 dashboardBody(
   tabItems(
    tabItem(tabName = "test",
      fluidRow(style="padding-top:50px;",
          column(width = 12, wellPanel(
              h4("Selection"),
               selectInput(inputId = "ID", label= "ID", choices = sort(unique(df1$ID)), 
               selected = "A12B5")),
                        
               tabBox(type="tabs", width = 12, 
               tabPanel("Panel 1", ggvisOutput("test_A"), absolutePanel(bottom = 150, right = 20,  
               radioButtons("Indice", label="variable to plot", choices = c("A", "B"), selected = "A"))),
                                
               tabPanel("Panel 2", ggvisOutput("test_B")))))))))

server <- function(input, output){
 
  test_A <- reactive({
    df1 %>%
      dplyr::filter(ID == input$ID, Indice == input$Indice) %>% 
      ggvis(~YEAR,~value, fill=~Indice) %>%
      layer_bars(width = 0.4) %>%
      add_axis("x", title = "Année", title_offset = 40) %>%
      add_axis("y", title = "value", title_offset = 60)
 })
  
  test_A %>% bind_shiny("test_A")
  

  test_B <- reactive({    
    df2 %>%
      dplyr::filter(ID == input$ID) %>%
      ggvis(~YEAR,~value, fill=~Indice) %>%
      layer_bars(width = 0.4) %>%
      add_axis("x", title = "Année", title_offset = 40) %>%
      add_axis("y", title = "value", title_offset = 60) 
  })
  
  test_B %>% bind_shiny("test_B")

}

shinyApp(ui, server)

Answer 1

只需将数据设为响应式，并在响应式外部使用ggvis，如下所示

server <- function(input, output){
  
  test_A <- reactive({
    df1 %>%
      dplyr::filter(ID == input$ID, Indice == input$Indice) 
  })
  
  test_A %>% 
    ggvis(~YEAR,~value, fill=~Indice) %>%
    layer_bars(width = 0.4) %>%
    # add_axis("x", title = "Année", title_offset = 40) %>%
    # add_axis("y", title = "value", title_offset = 60) %>% 
    bind_shiny("test_A","test_A_ui")
  
  
  test_B <- reactive({    
    df2 %>%
      dplyr::filter(ID == input$ID) 
  })
  
  test_B %>% 
    ggvis(~YEAR,~value, fill=~Indice) %>%
    layer_bars(width = 0.4) %>%
    # add_axis("x", title = "Année", title_offset = 40) %>%
    # add_axis("y", title = "value", title_offset = 60) %>% 
    bind_shiny("test_B","test_B_ui")
  
}

shinyApp(ui, server)