使用ggvis layer_histogram在光澤應用程式空data.frame

Question

我想從一個過濾器能組數據中有光澤的應用程序繪製使用ggvis堆疊直方圖生成錯誤。

當過濾器返回一個空data.frame，我想有顯示一個空的陰謀。

預期與「非堆疊」直方圖以下工作：

server <- function(input, output, session) { 

    library(shiny) 
    library(ggvis) 
    library(dplyr) 

    data(diamonds, package = "ggplot2") 

    diamonds_sub <- reactive({ 
     d <- diamonds 
     if (input$CLARITY != "All") { 
     d <- d %>% filter(clarity == input$CLARITY) 
     } 
     d <- as.data.frame(d) 
     d 
    }) 

    hist_standard <- reactive({ 
     diamonds_sub %>% 
     filter(cut == "Ideal") %>% 
     ggvis(x=~price) %>% 
     layer_histograms() 
    }) 

    hist_standard %>% bind_shiny("hist_standard") 

} 

ui <- shinyUI(
    fluidPage(
    titlePanel("Histogram test") 
    ,sidebarLayout(
     sidebarPanel(
     selectInput("CLARITY", "Clarity" 
        ,c("All", "I1", "SI2", "SI1", "VS2", "VS1", "VVS2", "VVS1", "IF" 
         ,"Non-Existent Clarity") 
     ) 
    ) 
     ,mainPanel(ggvisOutput("hist_standard")) 
    ) 
) 
) 

shinyApp(ui = ui, server = server) 

當我在應用程序中選擇「不存在的清晰度」，我得到以下結果：

我的目標是讓這種行爲在疊加柱狀圖用下面的代碼：

server <- function(input, output, session) { 

    library(shiny) 
    library(ggvis) 
    library(dplyr) 

    data(diamonds, package = "ggplot2") 

    diamonds_sub <- reactive({ 
     d <- diamonds 
     if (input$CLARITY != "All") { 
     d <- d %>% filter(clarity == input$CLARITY) 
     } 
     d <- as.data.frame(d) 
     d 
    }) 

    hist_stacked <- reactive({ 
     diamonds_sub %>% 
     filter(cut == "Ideal") %>% 
     ggvis(x=~price, prop("fill", ~color)) %>% 
     group_by(color) %>% 
     layer_histograms() 
    }) 

    hist_stacked %>% bind_shiny("hist_stacked") 
} 

ui <- shinyUI(
    fluidPage(
    titlePanel("Histogram test") 
    ,sidebarLayout(
     sidebarPanel(
     selectInput("CLARITY", "Clarity" 
        ,c("All", "I1", "SI2", "SI1", "VS2", "VS1", "VVS2", "VVS1", "IF" 
         ,"Non-Existent Clarity") 
     ) 
    ) 
     ,mainPanel(ggvisOutput("hist_stacked")) 
    ) 
) 
) 

shinyApp(ui = ui, server = server) 

雖然該應用程序將運行寫的，當我嘗試在「堆疊」版本選擇「不存在的清晰度」，我有以下錯誤應用程序崩潰和警告消息：

Listening on http://127.0.0.1:3062 
Guessing width = 500 # range/38 
Error: Length of logical index vector must be 1 or 10, got: 0 
Error: no applicable method for 'compute_stack' applied to an object of class "function" 
Warning: Error in eval: invalid 'envir' argument of type 'closure' 
Stack trace (innermost first): 
    124: eval 
    123: prop_value.prop_variable 
    122: prop_value 
    121: data_range 
    120: <reactive> 
    109: x 
    108: value.reactive 
    107: FUN 
    106: lapply 
    105: values 
    104: drop_nulls 
    103: concat 
    102: data_range 
    101: <reactive> 
    90: old_domain 
    89: expand_range 
    88: <reactive> 
    77: x 
    76: value.reactive 
    75: value 
    74: data.frame 
    73: <reactive> 
    62: data_reactive 
    61: as.vega 
    60: session$sendCustomMessage 
    59: observerFunc 
     4: <Anonymous> 
     3: do.call 
     2: print.shiny.appobj 
     1: <Promise> 
Warning: Error in eval: invalid 'envir' argument of type 'closure' 
Stack trace (innermost first): 
    124: eval 
    123: prop_value.prop_variable 
    122: prop_value 
    121: data_range 
    120: <reactive> 
    109: x 
    108: value.reactive 
    107: FUN 
    106: lapply 
    105: values 
    104: drop_nulls 
    103: concat 
    102: data_range 
    101: <reactive> 
    90: old_domain 
    89: expand_range 
    88: <reactive> 
    77: x 
    76: value.reactive 
    75: value 
    74: data.frame 
    73: <reactive> 
    62: data_reactive 
    61: as.vega 
    60: session$sendCustomMessage 
    59: observerFunc 
     4: <Anonymous> 
     3: do.call 
     2: print.shiny.appobj 
     1: <Promise> 
Warning: Error in UseMethod: no applicable method for 'apply_props' applied to an object of class "function" 
Stack trace (innermost first): 
    74: apply_props 
    73: <reactive> 
    62: data_reactive 
    61: as.vega 
    60: session$sendCustomMessage 
    59: observerFunc 
    4: <Anonymous> 
    3: do.call 
    2: print.shiny.appobj 
    1: <Promise> 
Warning: Error in eval: invalid 'envir' argument of type 'closure' 
Stack trace (innermost first): 
    111: eval 
    110: prop_value.prop_variable 
    109: prop_value 
    108: data_range 
    107: <reactive> 
    96: x 
    95: value.reactive 
    94: FUN 
    93: lapply 
    92: values 
    91: drop_nulls 
    90: concat 
    89: data_range 
    88: <reactive> 
    77: x 
    76: value.reactive 
    75: value 
    74: data.frame 
    73: <reactive> 
    62: data_reactive 
    61: as.vega 
    60: session$sendCustomMessage 
    59: observerFunc 
     4: <Anonymous> 
     3: do.call 
     2: print.shiny.appobj 
     1: <Promise> 
Warning: Error in UseMethod: no applicable method for 'apply_props' applied to an object of class "function" 
Stack trace (innermost first): 
    62: <Anonymous> 
    61: stop 
    60: data_table[[name]] 
    59: observerFunc 
    4: <Anonymous> 
    3: do.call 
    2: print.shiny.appobj 
    1: <Promise> 
ERROR: [on_request_read] connection reset by peer 

問題：如何我可以從堆疊直方圖中得到與未堆疊直方圖相同的「空白圖」行爲嗎？

Answer 1

這個真沒有什麼（我認爲）是hist_stacked不良行爲的解決方案，但它確實解決在hackish的那種感覺我的問題......

如可以在錯誤中可以看出/警告輸出（尤其是Error: no applicable method for 'compute_stack' applied to an object of class "function"）時，看起來hist_stacked在被要求爲一個空數據幀「計算堆棧」時會掛起。由於ggviz會報錯出本身（即評估過它對group_by）之前，我需要確定我是否擁有過濾空data.frame之前，我已經開始管進入ggviz。

我通過添加額外的無功函數（diamonds_sub_dim）來計算data.frame的尺寸實現這一點

diamonds_sub_dim <- reactive({ 
     d <- diamonds 
     if (input$CLARITY != "All") { 
     d <- d %>% filter(clarity == input$CLARITY) 
     } 
     d <- as.data.frame(d) 
     dim(d) 
    }) 

然後我利用這個功能的if-else語句內的hist_stacked功能內如下所示。如果diamonds_sub_dim()[1]==0，那麼我繪製原始的堆棧直方圖。 data.frame爲空的事實會給我一個空的圖。否則，我會像平常一樣計算疊加的直方圖。

server <- function(input, output, session) { 

    library(shiny) 
    library(ggvis) 
    library(dplyr) 

    data(diamonds, package = "ggplot2") 

    diamonds_sub <- reactive({ 
     d <- diamonds 
     if (input$CLARITY != "All") { 
     d <- d %>% filter(clarity == input$CLARITY) 
     } 
     d <- as.data.frame(d) 
     d 
    }) 

    diamonds_sub_dim <- reactive({ 
     d <- diamonds 
     if (input$CLARITY != "All") { 
     d <- d %>% filter(clarity == input$CLARITY) 
     } 
     d <- as.data.frame(d) 
     dim(d) 
    }) 

    hist_stacked <- reactive({ 

     if (diamonds_sub_dim()[1]==0) { 
     diamonds_sub() %>% 
      filter(cut == "Ideal") %>% 
      ggvis(x=~price) %>% 
      layer_histograms() 
     } else { 
     diamonds_sub() %>% 
      filter(cut == "Ideal") %>% 
      ggvis(x=~price, prop("fill", ~color)) %>% 
      group_by(color) %>% 
      layer_histograms() 
     } 
    }) 
    hist_stacked %>% bind_shiny("hist_stacked") 
} 

ui <- shinyUI(
    fluidPage(
    titlePanel("Histogram test") 
    ,sidebarLayout(
     sidebarPanel(
     selectInput("CLARITY", "Clarity" 
        ,c("All", "I1", "SI2", "SI1", "VS2", "VS1", "VVS2", "VVS1", "IF" 
         ,"Non-Existent Clarity") 
     ) 
    ) 
     ,mainPanel(ggvisOutput("hist_stacked") 
       ) 
    ) 
) 
) 

shinyApp(ui = ui, server = server) 

我會高興地接受一個更優雅的答案，任何人都應該有一個建議。