paste(x， 折叠 ", " ) 导致 R 中的 lapply 函数出错

Question

我已经将mtcars数据吐到一个列表中，每个cyl都有一个级别。

> splitCars <- split(mtcars, mtcars$cyl)

现在我想创建一个列表的年份元素的摘要。它应该包含两个元素：

1. Ngears-独特齿轮数
2. gears-所有可能档位的字符串

创建字符串，我正在使用以下内容：

> cat(paste(shQuote(levels(as.factor(splitCars$`8`$gear)), type="cmd"), collapse=", "))
"3", "5"> 

这在这里运行良好，只针对列表中的一个元素。现在我想使用lapply来总结splitCars中的所有内容

> splitCars <- lapply(splitCars, function(x){
+   x %>% summarize(Ngears = length(unique(gear)),
+                   gears = cat(paste(shQuote(levels(as.factor(gear)), type="cmd"), collapse=", ")))
+ })

但是我犯了一个错误。为什么这会导致lapply函数中出现错误？

"3", "4", "5"
Error: Problem with `summarise()` input `gears`.
x Input `gears` must be a vector, not NULL.
ℹ Input `gears` is `cat(paste(shQuote(levels(as.factor(gear)), type = "cmd"), collapse = ", "))`.

当查看R中的show trace选项时，最后几条信息是：

24.
stop(fallback) 
23.
signal_abort(cnd) 
22.
abort(bullets, class = "dplyr_error") 
21.
(function (e) 
{
local_call_step(dots = dots, .index = i, .fn = "summarise", 
.dot_data = inherits(e, "rlang_error_data_pronoun_not_found")) ... 
20.
signalCondition(cnd) 
19.
signal_abort(cnd) 
18.
(function (message = NULL, class = NULL, ..., trace = NULL, parent = NULL, 
.subclass) 
{
validate_signal_args(.subclass) ... 
17.
exec(abort, class = class, !!!.envir) 
16.
abort_glue(character(0), list(result = NULL), "dplyr:::summarise_unsupported_type") 
15.
mask$eval_all_summarise(quo) 
14.
withCallingHandlers({
for (i in seq_along(dots)) {
quo <- dots[[i]]
chunks[[i]] <- mask$eval_all_summarise(quo) ... 
13.
summarise_cols(.data, ...) 
12.
summarise.data.frame(., Ngears = length(unique(gear)), gears = cat(paste(shQuote(levels(as.factor(gear)), 
type = "cmd"), collapse = ", "))) 

如何解决此问题？或者有更好的方法吗

Answer 1

尝试这种方法单独构建价值：

#Code for list
splitCars <- split(mtcars, mtcars$cyl)
#my fun
myfun <- function(x)
{
#Ngears
v1 <- length(unique(x$gear))
v2 <- paste0(unique(levels(as.factor(x$gear))),collapse = ', ')
#Build data
y <- data.frame(Ngears=v1,gears=v2,stringsAsFactors = F)
return(y)
}
#Apply
splitCars <- lapply(splitCars,myfun)

输出：

splitCars
$`4`
Ngears   gears
1      3 3, 4, 5
$`6`
Ngears   gears
1      3 3, 4, 5
$`8`
Ngears gears
1      2  3, 5

Answer 2

cat没有return值，因为它只是用于print连接到控制台。因此，我们可以删除cat。有了tidyverse，length(unique可以是n_distinct

library(purrr)
library(dplyr)
map(splitCars, ~ .x %>%
summarize(Ngears = n_distinct(gear),
gears = toString(shQuote(levels(as.factor(gear)),
type="cmd"))))

-输出

#$`4`
#  Ngears         gears
#1      3 "3", "4", "5"
#$`6`
#  Ngears         gears
#1      3 "3", "4", "5"
#$`8`
#  Ngears    gears
#1      2 "3", "5"

---

此外，无需拆分，因为可以通过分组操作进行拆分

mtcars %>%
group_by(cyl) %>%
summarize(Ngears = n_distinct(gear),
gears = toString(shQuote(levels(as.factor(gear)),
type="cmd")), .groups = 'drop')
# A tibble: 3 x 3
#    cyl Ngears gears                
#  <dbl>  <int> <chr>                
#1     4      3 ""3", "4", "5""
#2     6      3 ""3", "4", "5""
#3     8      2 ""3", "5""