如何在R中使用tidyeval创建包含所有因素水平的小型预测数据集？

如何解决如何在R中使用tidyeval创建包含所有因素水平的小型预测数据集？

我正在尝试使用modelr::data_grid()函数获得一个预测网格，该函数具有模型中一个因素的所有级别，而模型中另一个因素仅具有“典型”级别。问题在于，对预测网格中保持不变的因子的调用levels()应该返回原始数据中存在的所有级别。否则，某些预测功能可能会失败并返回臭名昭著的

Error in `contrasts<-`(`*tmp*`,value = contr.funs[1 + isOF[nn]]) : 
  contrasts can be applied only to factors with 2 or more levels

---

这是我可以从modelr::data_grid()中学到的东西以及我想要的东西的证明。

library(tidyverse)

co2_mod <- slice(CO2,-1,-43)
fit <- lm(uptake ~ Type + Treatment,data = co2_mod)

grid_df <- modelr::data_grid(co2_mod,Type,.model = fit) %>%
  mutate(Treatment = factor(Treatment))
grid_df
#> # A tibble: 2 x 2
#>   Type        Treatment
#>   <fct>       <fct>    
#> 1 Quebec      chilled  
#> 2 Mississippi chilled
levels(grid_df$Treatment)
#> [1] "chilled"

我想拥有

levels(grid_df$Treatment)
[1] "nonchilled" "chilled"

数据集中只有1级的因子变量应“知道”原始数据集中的所有可能因子。例如，请参见下面的rstanarm小插曲的屏幕截图，其中显示了既需要将Male和Female都设置为水平，也可以使gender等于Female。

---

我试图编写一些函数来实现我的目标。还有一个额外的步骤，就是将数据集重复1000次，因为我将这个网格用作newdata模型拟合的后验预测分布的rstanarm。

辅助功能（有效）：

get_all_levels <- function(v,dataset){
  v <- enquo(v)
  
  a <- select(dataset,!!v) %>% as_vector()
  l <- levels(a)
  
  return(l)
}

主函数，它调用辅助函数（这不起作用）：

grid_all_levels <- function(model,variable,df){
  variable <- enquo(variable)
  grid <- expand_grid(
    rep = seq(1,1000,1),modelr::data_grid(df,!!variable,.model = model)
  ) %>%
    mutate(across(where(is.character),~factor(.,levels = get_all_levels(.,df))))
  
  return(grid)
}

这是一个小巧的代表，您可以在上面运行这些功能。

library(tidyverse)
  
get_all_levels <- function(v,dataset){
  v <- enquo(v)
  d <- as_tibble(dataset)
  a <- select(d,!!v) %>% as_vector()
  l <- levels(a)
  
  return(l)
}

grid_all_levels <- function(model,df))))
  
  return(grid)
}

co2_mod <- slice(CO2,-43)
fit <- lm(conc ~ Type + Treatment,data = co2_mod)
get_all_levels(Type,co2_mod)
#> [1] "Quebec"      "Mississippi"

grid_all_levels(fit,co2_mod)
#> Note: Using an external vector in selections is ambiguous.
#> ℹ Use `all_of(.)` instead of `.` to silence this message.
#> ℹ See <https://tidyselect.r-lib.org/reference/faq-external-vector.html>.
#> This message is displayed once per session.
#> Error: Problem with `mutate()` input `..1`.
#> x Can't subset columns that don't exist.
#> x Columns `chilled`,`chilled`,etc. don't exist.
#> ℹ Input `..1` is `across(...)`.

我非常确定问题是我在.函数的get_all_levels调用中如何使用grid_all_levels。

如何让grid_all_levels()工作？

---

更新

我按照以下答案修改了grid_all_levels()函数，使其看起来像这样：

grid_all_levels <- function(model,levels = get_all_levels(cur_column(),df))))
  
  return(grid)
}

返回

#> # A tibble: 2,000 x 3
#>      rep Type        Treatment
#>    <dbl> <fct>       <fct>    
#>  1     1 Quebec      chilled  
#>  2     1 Mississippi chilled  
#>  3     2 Quebec      chilled  
#>  4     2 Mississippi chilled  
#>  5     3 Quebec      chilled  
#>  6     3 Mississippi chilled  
#>  7     4 Quebec      chilled  
#>  8     4 Mississippi chilled  
#>  9     5 Quebec      chilled  
#> 10     5 Mississippi chilled  
#> # … with 1,990 more rows
levels(a$Treatment)
#> [1] "nonchilled" "chilled"

这正是我想要的！

解决方法

问题在于，对角线内的.是实际的列，而不是列的名称。遗憾的是，无法在across调用中获取名称，但是使用purrr::reduce可以解决：

library(tidyverse)
levelize <- function(.x,.y){
 mutate(.x,!!paste0(.y) := factor(!!sym(.y),levels =  get_all_levels(!!sym(.y),df) ) )
}

estimate_prevalence_differences_polr <- function(model,variable,df){
  variable <- enquo(variable)
  # putting the names of the factor variables inside a vector
  vars <- sapply(df,function(x) is.factor(x))
  vars <- names(vars)[vars]
  expand_grid(
    rep = 1:1000,modelr::data_grid(df,!!variable,.model = model)
  ) %>% 
### looping through the vars that are factor
## the .x argument is the one set by .init i.e the grid
## the .y argument is the element of the vars vector in the current iter
## the first iter we have .y="Type" and .x=.
## inside the levelize function
## basically mutate .x and change the variable named .y (Type) to become a factor
## with the levels returned from the original df
    reduce(intersect(vars,colnames(.)),levelize,.init=.)
}

现在调用该函数后，级别已正确设置，我们可以通过打印每个factor列的唯一值来进行检查：

estimate_prevalence_differences_polr(fit,Type,df) %>% select(where(is.factor)) %>% map(unique)
$Type
[1] Quebec      Mississippi
Levels: Quebec Mississippi

$Plant
[1] Qc2
Levels: Qn1 Qn2 Qn3 Qc1 Qc3 Qc2 Mn3 Mn2 Mn1 Mc2 Mc3 Mc1

$Treatment
[1] chilled    nonchilled
Levels: nonchilled chilled

编辑：

一种更简单的解决方案是使用cur_column，当我第一次编写答案时，我现在还没有使用此选项。因此基本上不是将.传递给get_all_levels，而是传递cur_column()即

expand_grid(
    rep = seq(1,1000,1),.model = model)
  ) %>%
    mutate(across(where(is.character),~factor(.,levels = get_all_levels(cur_column(),df))))

,

我认为您正在使它变得比所需的更为复杂。如果我删除所有的tidyeval东西，我们会得到一个更简单的东西：

mutate(across(where(is.character),~ factor(.,levels = levels(.))))

您可以将~ lambda提取到可重用的命名函数中。

该实现立即使您想到了问题。由于levels()返回带有字符向量的NULL，因此这仅适用于因子。考虑到因素，这是无人操作的。我不确定您要达到什么目标。

此外，获取所有级别的实现还有一个问题：需要选择，它可以返回多个向量，例如与starts_with()。在这种情况下，您会得到一个令人困惑的错误。