facet_grid 在 Shiny flexdashboard 中给出错误 "Faceting variables must have at least one value"
facet_grid in Shiny flexdashboard giving error "Faceting variables must have at least one value"
我在获取用于评估系统的 ggplot2 facet_grid 图时遇到了一些问题。该图呈现良好，但我在浏览器和控制台中收到以下错误：
错误：分面变量必须至少有一个值
每次我根据输入 input$brand 切换品牌条目时都会出现这种情况。应用程序没有崩溃，但错误消息很烦人。
我准备了这个可重现的例子：
---
title: "Power ranking for mtcars"
runtime: shiny
output:
flexdashboard::flex_dashboard:
orientation: rows
source_code: embed
---
```{r rows.print = 25}
library(dplyr)
library(ggplot2)
mtcars_tidy <- mtcars %>%
tibble::rownames_to_column() %>%
rename(model = rowname) %>%
mutate(brand = gsub( " .*$", "", model )) %>%
mutate(model = model) %>%
select(brand, model, everything()) %>%
tidyr::gather(key = 'measure', value = "value", mpg:carb) %>%
mutate(ranking = as.factor(sample(x = c(1, 2, 3), size = n(), replace = TRUE))) %>%
mutate(power = case_when(
.$measure == "hp" & value > 200 | (.$measure == "cyl" & value == 8) ~ "high",
.$measure == "hp" & value < 200 | (.$measure == "cyl" & value == 8) ~ "medium",
.$measure == "hp" & value > 100 | (.$measure == "cyl" & value == 6) ~ "high",
.$measure == "hp" & value < 100 | (.$measure == "cyl" & value == 6) ~ "medium",
.$measure == "hp" & value > 50 | (.$measure == "cyl" & value == 6) ~ "high",
.$measure == "hp" & value < 50 | (.$measure == "cyl" & value == 6) ~ "medium",
.$measure == "hp" & value > 200 | (.$measure == "carb" & value > 4) ~ "high",
.$measure == "hp" & value < 200 | (.$measure == "carb" & value <= 4) ~ "medium",
.$measure == "hp" & value > 100 | (.$measure == "carb" & value > 2.8) ~ "high",
.$measure == "hp" & value < 100 | (.$measure == "carb" & value <= 2.8) ~ "medium",
.$measure == "hp" & value > 50 | (.$measure == "carb" & value > 2) ~ "high",
.$measure == "hp" & value < 50 | (.$measure == "carb" & value <= 2) ~ "medium",
TRUE ~ "low"
))
```
# Sidebar {.sidebar data-width="350"}
```{r}
selectInput("brand", "Brand of the car",
choices = unique(mtcars_tidy$brand))
renderUI({
selectInput("model", "Car model",
choices = mtcars_tidy$model[mtcars_tidy$brand == levels(mtcars_tidy$brand)[1]])
})
br()
observe({
brand <- input$brand
updateSelectInput(session, "model",
choices = mtcars_tidy$model[mtcars_tidy$brand == brand])
})
# when switching the brand of the car, input$brand this error pops up:
# Error in : Faceting variables must have at least one value
```
# Main
##
### Plot power ranking for each measure
```{r}
nameorder <- make.unique(mtcars_tidy$measure[order(mtcars_tidy$power, mtcars_tidy$ranking)])
mtcars_tidy$measure <- factor(mtcars_tidy$measure, levels=nameorder,
ordered = TRUE)
dataset <- reactive({
subset(mtcars_tidy, brand == input$brand & model == input$model)
})
renderPlot({
ggplot(dataset(), aes(x = ranking, y = measure)) +
geom_segment(aes(yend = measure), xend=0, color = "grey50") +
geom_point(size = 3, aes(colour = power)) +
scale_colour_brewer(palette="Set1", limits = c("high","medium", "low")) +
theme_bw() +
theme(panel.grid.major.y = element_blank()) + # No horizontal grid lines
facet_grid(power ~ ., scales="free_y", space="free_y") +
ggtitle(paste0("Brand: ", input$brand, ", Model: " , input$model))
})
```
编辑 1：我将 facet_grid 更改为 facet_wrap 但错误仍然存在。
编辑 2：根据建议，我使用以下公式切换到 facet_wrap：p <- p + facet_wrap(power ~ .)。仍然是同样的错误。我也试过这个其他公式
p <- p + facet_wrap(power ~ ranking)。错误仍然存在。
编辑 3：在 facet_wrap 函数上，我也尝试使用这些公式：
facet_wrap(~power )facet_wrap(vars(power )) facet_wrap(vars(power , ranking))。
错误依旧（相同）。无变化 (Error in : Faceting variables must have at least one value)。
编辑 4：如果我尝试使用 facet_wrap(power)，错误会更糟，因为闪亮会因这一口而崩溃：
Error: Column `function (lambda = 1) \n{\n if (!is.numeric(lambda) || is.na(lambda)) \n stop("invalid argument 'lambda'")\n if (lambda <= 0) \n return(make.link("log"))\n if (lambda == 1) \n return(make.link("identity"))\n linkfun <- function(mu) mu^lambda\n linkinv <- function(eta) pmax(eta^(1/lambda), .Machine$double.eps)\n mu.eta <- function(eta) pmax((1/lambda) * eta^(1/lambda - \n 1), .Machine$double.eps)\n valideta <- function(eta) all(is.finite(eta)) && all(eta > \n 0)\n link <- paste0("mu^", round(lambda, 3))\n structure(list(linkfun = linkfun, linkinv = linkinv, mu.eta = mu.eta, \n valideta = valideta, name = link), class = "link-glm")\n}` must be a 1d atomic vector or a list
当 dataset() 中没有行时会发生此错误。当我 运行 你的代码（当前版本带有 facet_grid(power ~ .,）时，它实际上工作正常。当我选择一个新品牌时，input$model 列表更新时，它会在一小段时间显示此错误。一旦完成，以及 brand 和 model return 行的组合，绘图显示得很好。
您可以通过使用 req 延迟渲染图直到满足特定要求来防止这种差距。只需在 renderPlot
的顶部插入以下代码
req(nrow(dataset()) > 0)
如果 dataset() 不包含至少一行，这将阻止 renderPlot 运行ning。在这种情况下，在数据准备好使用之前，绘图将只是空白（删除可怕的错误消息）。添加该行后，您的应用似乎 运行 正常（顺便说一句，看起来相当不错）。
您可以通过在 shiny 上下文之外测试您的代码来查看该错误消息的来源。这是您的情节的最小示例：
ggplot(dataset, aes(x = ranking, y = measure)) +
geom_segment(aes(yend = measure), xend=0, color = "grey50") +
geom_point(size = 3, aes(colour = power)) +
facet_grid(power ~ ., scales="free_y", space="free_y")
当我使用此调用进行 dataset 时：
dataset <- subset(mtcars_tidy, brand == 'Honda' & model == 'Honda Civic')
绘图正确呈现。当我使用没有 return 任何行的 subset 时：
dataset <- subset(mtcars_tidy, brand == 'Honda' & model == 'Civic')
我遇到了同样的错误：
Error: Faceting variables must have at least one value
我在获取用于评估系统的 ggplot2 facet_grid 图时遇到了一些问题。该图呈现良好，但我在浏览器和控制台中收到以下错误：
错误：分面变量必须至少有一个值
每次我根据输入 input$brand 切换品牌条目时都会出现这种情况。应用程序没有崩溃，但错误消息很烦人。
我准备了这个可重现的例子：
---
title: "Power ranking for mtcars"
runtime: shiny
output:
flexdashboard::flex_dashboard:
orientation: rows
source_code: embed
---
```{r rows.print = 25}
library(dplyr)
library(ggplot2)
mtcars_tidy <- mtcars %>%
tibble::rownames_to_column() %>%
rename(model = rowname) %>%
mutate(brand = gsub( " .*$", "", model )) %>%
mutate(model = model) %>%
select(brand, model, everything()) %>%
tidyr::gather(key = 'measure', value = "value", mpg:carb) %>%
mutate(ranking = as.factor(sample(x = c(1, 2, 3), size = n(), replace = TRUE))) %>%
mutate(power = case_when(
.$measure == "hp" & value > 200 | (.$measure == "cyl" & value == 8) ~ "high",
.$measure == "hp" & value < 200 | (.$measure == "cyl" & value == 8) ~ "medium",
.$measure == "hp" & value > 100 | (.$measure == "cyl" & value == 6) ~ "high",
.$measure == "hp" & value < 100 | (.$measure == "cyl" & value == 6) ~ "medium",
.$measure == "hp" & value > 50 | (.$measure == "cyl" & value == 6) ~ "high",
.$measure == "hp" & value < 50 | (.$measure == "cyl" & value == 6) ~ "medium",
.$measure == "hp" & value > 200 | (.$measure == "carb" & value > 4) ~ "high",
.$measure == "hp" & value < 200 | (.$measure == "carb" & value <= 4) ~ "medium",
.$measure == "hp" & value > 100 | (.$measure == "carb" & value > 2.8) ~ "high",
.$measure == "hp" & value < 100 | (.$measure == "carb" & value <= 2.8) ~ "medium",
.$measure == "hp" & value > 50 | (.$measure == "carb" & value > 2) ~ "high",
.$measure == "hp" & value < 50 | (.$measure == "carb" & value <= 2) ~ "medium",
TRUE ~ "low"
))
```
# Sidebar {.sidebar data-width="350"}
```{r}
selectInput("brand", "Brand of the car",
choices = unique(mtcars_tidy$brand))
renderUI({
selectInput("model", "Car model",
choices = mtcars_tidy$model[mtcars_tidy$brand == levels(mtcars_tidy$brand)[1]])
})
br()
observe({
brand <- input$brand
updateSelectInput(session, "model",
choices = mtcars_tidy$model[mtcars_tidy$brand == brand])
})
# when switching the brand of the car, input$brand this error pops up:
# Error in : Faceting variables must have at least one value
```
# Main
##
### Plot power ranking for each measure
```{r}
nameorder <- make.unique(mtcars_tidy$measure[order(mtcars_tidy$power, mtcars_tidy$ranking)])
mtcars_tidy$measure <- factor(mtcars_tidy$measure, levels=nameorder,
ordered = TRUE)
dataset <- reactive({
subset(mtcars_tidy, brand == input$brand & model == input$model)
})
renderPlot({
ggplot(dataset(), aes(x = ranking, y = measure)) +
geom_segment(aes(yend = measure), xend=0, color = "grey50") +
geom_point(size = 3, aes(colour = power)) +
scale_colour_brewer(palette="Set1", limits = c("high","medium", "low")) +
theme_bw() +
theme(panel.grid.major.y = element_blank()) + # No horizontal grid lines
facet_grid(power ~ ., scales="free_y", space="free_y") +
ggtitle(paste0("Brand: ", input$brand, ", Model: " , input$model))
})
```
编辑 1：我将 facet_grid 更改为 facet_wrap 但错误仍然存在。
编辑 2：根据建议，我使用以下公式切换到 facet_wrap：p <- p + facet_wrap(power ~ .)。仍然是同样的错误。我也试过这个其他公式
p <- p + facet_wrap(power ~ ranking)。错误仍然存在。
编辑 3：在 facet_wrap 函数上，我也尝试使用这些公式：
facet_wrap(~power )facet_wrap(vars(power ))facet_wrap(vars(power , ranking))。
错误依旧（相同）。无变化 (Error in : Faceting variables must have at least one value)。
编辑 4：如果我尝试使用 facet_wrap(power)，错误会更糟，因为闪亮会因这一口而崩溃：
Error: Column `function (lambda = 1) \n{\n if (!is.numeric(lambda) || is.na(lambda)) \n stop("invalid argument 'lambda'")\n if (lambda <= 0) \n return(make.link("log"))\n if (lambda == 1) \n return(make.link("identity"))\n linkfun <- function(mu) mu^lambda\n linkinv <- function(eta) pmax(eta^(1/lambda), .Machine$double.eps)\n mu.eta <- function(eta) pmax((1/lambda) * eta^(1/lambda - \n 1), .Machine$double.eps)\n valideta <- function(eta) all(is.finite(eta)) && all(eta > \n 0)\n link <- paste0("mu^", round(lambda, 3))\n structure(list(linkfun = linkfun, linkinv = linkinv, mu.eta = mu.eta, \n valideta = valideta, name = link), class = "link-glm")\n}` must be a 1d atomic vector or a list
当 dataset() 中没有行时会发生此错误。当我 运行 你的代码（当前版本带有 facet_grid(power ~ .,）时，它实际上工作正常。当我选择一个新品牌时，input$model 列表更新时，它会在一小段时间显示此错误。一旦完成，以及 brand 和 model return 行的组合，绘图显示得很好。
您可以通过使用 req 延迟渲染图直到满足特定要求来防止这种差距。只需在 renderPlot
req(nrow(dataset()) > 0)
如果 dataset() 不包含至少一行，这将阻止 renderPlot 运行ning。在这种情况下，在数据准备好使用之前，绘图将只是空白（删除可怕的错误消息）。添加该行后，您的应用似乎 运行 正常（顺便说一句，看起来相当不错）。
您可以通过在 shiny 上下文之外测试您的代码来查看该错误消息的来源。这是您的情节的最小示例：
ggplot(dataset, aes(x = ranking, y = measure)) +
geom_segment(aes(yend = measure), xend=0, color = "grey50") +
geom_point(size = 3, aes(colour = power)) +
facet_grid(power ~ ., scales="free_y", space="free_y")
当我使用此调用进行 dataset 时：
dataset <- subset(mtcars_tidy, brand == 'Honda' & model == 'Honda Civic')
绘图正确呈现。当我使用没有 return 任何行的 subset 时：
dataset <- subset(mtcars_tidy, brand == 'Honda' & model == 'Civic')
我遇到了同样的错误：
Error: Faceting variables must have at least one value