在闪亮的应用程序中使用 ggvis layer_histogram 会为空 data.frame 生成错误
Using ggvis layer_histogram in shiny app generates error for empty data.frame
我想在闪亮的应用程序中使用 ggvis 从一组可过滤的数据中绘制堆叠直方图。
当过滤器 return 为空 data.frame 时，我希望显示一个空图。
以下使用 "non-stacked" 直方图按预期工作：
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)
当我在应用程序中 select "Non-Existent Clarity" 时，我得到以下结果：
我的目标是使用以下代码在堆叠直方图中获得此行为：
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)
虽然该应用程序将 运行 写入，当我尝试 select "Non-Existent Clarity" "stacked" 版本时，我的应用程序崩溃并显示以下错误和警告消息:
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
问题：如何从堆叠直方图中获得与非堆叠直方图相同的 "blank plot" 行为？
这确实不是 hist_stacked 中（我认为）不良行为的解决方案，但它确实以一种骇人听闻的方式解决了我的问题...
从上面的 error/warning 输出中可以看出（特别是 Error: no applicable method for 'compute_stack' applied to an object of class "function"），似乎 hist_stacked 在被要求 "compute stacks" 为空 data.frame。由于 ggviz 本身会 error-out（即在评估达到 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 从一组可过滤的数据中绘制堆叠直方图。
当过滤器 return 为空 data.frame 时，我希望显示一个空图。
以下使用 "non-stacked" 直方图按预期工作：
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)
当我在应用程序中 select "Non-Existent Clarity" 时，我得到以下结果：
我的目标是使用以下代码在堆叠直方图中获得此行为：
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)
虽然该应用程序将 运行 写入，当我尝试 select "Non-Existent Clarity" "stacked" 版本时，我的应用程序崩溃并显示以下错误和警告消息:
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
问题：如何从堆叠直方图中获得与非堆叠直方图相同的 "blank plot" 行为？
这确实不是 hist_stacked 中（我认为）不良行为的解决方案，但它确实以一种骇人听闻的方式解决了我的问题...
从上面的 error/warning 输出中可以看出（特别是 Error: no applicable method for 'compute_stack' applied to an object of class "function"），似乎 hist_stacked 在被要求 "compute stacks" 为空 data.frame。由于 ggviz 本身会 error-out（即在评估达到 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)
如果有人有建议，我会很乐意接受更优雅的答案。