使用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) 

我会高兴地接受一个更优雅的答案，任何人都应该有一个建议。