Using ggvis layer_histogram in shiny app generates error for empty data.frame
I would like to plot a stacked histogram using ggvis in a shiny app from a filter-able set of data.
When the filters return an empty data.frame, I would like to have an empty plot displayed.
The following works as expected with a "non-stacked" histogram:
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)
When I select "Non-Existent Clarity" in the app, I get the following result:
My goal is to get this behavior in stacked histogram with the following code:
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)
Although the app will run as written, when I try to select "Non-Existent Clarity" in the "stacked" version, my app crashes with the following error and warning messages:
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
QUESTION: How can I get the same "blank plot" behavior from a stacked histogram that I am getting from a non-stacked histogram?
This really isn't a solution to what (I think) is undesirable behavior in hist_stacked, but it does solve my problem in a hackish sort of way...
As can be seen in the error/warning output above (Error: no applicable method for 'compute_stack' applied to an object of class "function" in particular), it appears that hist_stacked is getting hung-up when asked to "compute stacks" for an empty data.frame. Since ggviz will error-out by itself (i.e. before the evaluation ever makes it to group_by), I need to determine whether or not I have filtered to an empty data.frame before I ever start to pipe into ggviz.
I accomplish this by adding an additional reactive function (diamonds_sub_dim) to calculate the dimensions of the 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)
})
I then make use of this function inside an if-else statement within the hist_stacked function as shown below. If diamonds_sub_dim()[1]==0, then I plot the original unstacked histogram. The fact that the data.frame is empty will get me an empty plot. Otherwise, I calculate the stacked histogram as normal.
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)
I will happily accept a more elegant answer should anyone have a suggestion.
- rintrojs only shows first dialog in Safari
- Automatically read a column of lowercases True and False as logical
- How do I add counts to a stacked bar graph?
- Counting the number of rows between each pair of months?
- How to create a conditional panel using a reactive object that is passed from another module?
- Plot multiple normalized stock charts from different dates into a single plot
- Select columns based on string match - dplyr::select
- Looking for a more efficient way to replace matrix elements
- modelsummary modelplot: change linewidth
- custom R function with group argument does not work while using the filter
- ggsurvplot function, risk table alignment problem
- plot running average in ggplot2
- Calling variable in df within function
- How to find position of running minimum (runMin) in a vector in R?
- Using httr2::last_response() in conjunction with purrr::possibly()
- Cropping a raster using terra does not return the expected extent
- Can janitor::clean_names be used on only certain columns in a data frame?
- Efficient way of row binding time series in a data.table, with correctly sorted timestamps
- Defining optional arguments in R when more complex function
- Can I change the cursor in plotly only when hovering over points?
- Issue Loading RStoolbox: "Cannot find proj.db" Error
- Filter CSV files for specific value before importing
- Matching the same lines from 2 different files and 2 columns
- Conditional coloring and outer borders in pdf KableExtra table in R
- How can I use observe
- Posterior predictive check for GAM (mgcv in R)
- Embed images in plotly tick labels
- Product of two beta distributions
- R: how to include a character between two repeted items in R?
- Categorizing data from 7 columns into 2