Shiny flexdashboard 中的 facet_grid 给出错误“构面变量必须至少有一个值”

Posted

技术标签:

【中文标题】Shiny flexdashboard 中的 facet_grid 给出错误“构面变量必须至少有一个值”【英文标题】:facet_grid in Shiny flexdashboard giving error "Faceting variables must have at least one value" 【发布时间】:2018-12-27 20:37:52 【问题描述】:

我在让 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-

```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_wrapp &lt;- p + facet_wrap(power ~ .)。还是一样的错误。我也试过这个其他公式 p &lt;- 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),错误会更严重,因为这满嘴会导致 Shiny 崩溃:

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

【问题讨论】:

试试facet_wrap(~ power, ...)。您需要将这两个变量都明确指定为facet_grid 你也调整了公式吗? 是的,我把它改成了p &lt;- p + facet_wrap(relevance ~ .)。见编辑。 所以...不。请注意facet_wrap 中没有点。 我也尝试了这些公式:facet_wrap(~power)、facet_wrap(vars(power))、facet_wrap(vars(power,ranking))。错误仍然相同。另一个,facet_wrap(power),让 Shiny 崩溃了。请参阅上面的编辑。 【参考方案1】:

dataset() 中没有行时会发生此错误。当我运行您的代码(当前版本为facet_grid(power ~ .,)时,它实际上工作正常。当我选择一个新品牌时,它会在input$model 列表更新时显示此错误。一旦完成,brandmodel 的组合返回行,该图就会很好地显示。

您可以通过使用req 推迟绘制绘图直到满足某些要求来防止这种差距。只需在 renderPlot 顶部插入以下代码

req(nrow(dataset()) > 0)

如果dataset() 不包含至少一行,这将阻止renderPlot 运行。在这种情况下,在数据准备好使用之前,绘图将是空白的(删除可怕的错误消息)。添加该行后,您的应用程序似乎运行良好(顺便说一句,看起来相当不错)。


您可以通过在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')

情节正确渲染。当我使用不返回任何行的subset 时:

dataset <- subset(mtcars_tidy, brand == 'Honda' & model == 'Civic')

我得到了同样的错误:

Error: Faceting variables must have at least one value

【讨论】:

以上是关于Shiny flexdashboard 中的 facet_grid 给出错误“构面变量必须至少有一个值”的主要内容,如果未能解决你的问题,请参考以下文章

Flexdashboard 不适用于 Shiny URL 状态

R + Shiny 哪个锤子?直的 Shiny、flexdashboard 还是 shinydashboard? [关闭]

使用 Flexdashboard 部署 Shiny 应用程序

在 Rmarkdown 中使用 Shiny 创建响应式 selectInput - flexdashboard

selectInput 选择依赖于 R Shiny Flexdashboard 的另一个 selectInput

从 R Shiny 中的选定输入中过滤