在Shining app中使用ggvis layer_直方图会为空data.frame生成错误

我想从一组可过滤的数据中，在一个闪亮的应用程序中使用

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这确实不是解决
hist\u
中（我认为）不受欢迎的行为的方法，但它确实以一种黑客的方式解决了我的问题

从上面的错误/警告输出中可以看出（
error:compute\u stack”没有适用于类“function”的对象的方法，
），当要求为空的data.frame“计算堆栈”时，
hist\u stacked
似乎被挂起。由于
ggviz
会自动出错（即，在评估通过
ggviz
进入
group_之前），我需要在开始进入
ggviz
之前确定是否已过滤到空的data.frame

我通过添加一个额外的反应函数（
diamonds\u sub\u 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)
    })

如果有人提出建议，我很乐意接受一个更优雅的回答
 @HubertL这会导致以下错误：.getReactiveEnvironment（）$currentContext（）中的
错误：如果没有活动的反应上下文，则不允许操作。（您试图做一些只能从反应式表达式或观察者内部完成的事情。）
稍微优雅一点<代码>菱形\u子\u尺寸
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

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

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)