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中不良行为的问题，但它确实以一种黑客的方式解决了我的问题......

从上面的错误/警告输出中可以看出（特别是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)
    })

然后我在hist_stacked函数中的if-else语句中使用此函数，如下所示。如果是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)

如果有人提出建议，我会很乐意接受一个更优雅的答案。

在闪亮的应用程序中使用ggvis layer_histogram会为空data.frame生成错误

1 个答案: