从单独表格的行创建具有列特征的数据框

Question

我有一张描述性的辅助表格，其中行指定变量的特征，其中varCat描述变量类别，rept描述该类别稍后要实现的重复次数，而form描述它们的数据格式：

require(dplyr)
require(tidyr)
require(purrr)

descr <- tibble(
  varCat = c("a", "b"),
  rept = c(1, 3),
  form = c("text", "num")
)
descr
#> # A tibble: 2 × 3
#>   varCat  rept form 
#>   <chr>  <dbl> <chr>
#> 1 a          1 text 
#> 2 b          3 num

我想要的是以下空数据框架：

d
#> # A tibble: 0 × 4
#> # … with 4 variables: a <chr>, b_1 <dbl>, b_2 <dbl>, b_3 <dbl>

^{创建于2022-09-27，使用 reprex v2.0.2}

这个过程包括两步：

1. 辅助表的 var 和 rept 一起确定了“目标”数据框的列名。如果 rept 等于 1，则不应该应用后缀；但是如果 rept 大于 1，则需要创建带有后缀的列序列；
2. 每列的格式应从 descr$form 中读取。

我已经成功地实现了这些步骤，尽管我感觉有点笨重：

# Step 1:
tmp <- descr %>%
  uncount(rept, .id = "rept") %>%
  group_by(varCat) %>%
  mutate(
    n = n(),
    var = case_when(
      n > 1 ~ paste0(varCat, "_", rept),
      TRUE ~ varCat
    )
  ) %>%
  ungroup %>%
  select(var, form)
c <- tmp$var
d <- matrix(ncol = length(c), nrow = 0) %>%
  as_tibble(.name_repair = "unique") %>%
  set_names(c)

# Step 2:
for (i in colnames(d)) {
  for (j in seq_along(tmp$var)) {
    if (tmp$var[j] == i & tmp$form[j] == "text") d[i] <- as.character(d[i]) else
    if (tmp$var[j] == i & tmp$form[j] == "num") d[i] <- as.numeric(d[i])
  }
}
d
#> # A tibble: 0 × 4
#> # … with 4 variables: a <chr>, b_1 <dbl>, b_2 <dbl>, b_3 <dbl>

^{该内容是由于2022年9月27日使用reprex v2.0.2创建的。}

我确信一定有更简洁的方法来实现这个。非常感谢您的任何帮助。

- Turtle

Answer 1

使用自定义函数返回列表来使用 mapply ，然后使用调用 data.frame 将列表转换为 data.frame：

foo <- function(varCat, rept, form){
  f <- setNames(c("character", "numeric"), c("text", "num"))[ form ]
  x <- rep(list(vector(mode = f)), rept)
  x <- setNames(x, rep(varCat, rept))
  if(rept > 1) names(x) <- paste(names(x), seq(names(x)), sep = "_")
  x
}

out <- data.frame(mapply(foo, descr$varCat, descr$rept, descr$form,
                         USE.NAMES = FALSE))

#check the output
out
# [1] a   b_1 b_2 b_3
# <0 rows> (or 0-length row.names)
str(out)
# 'data.frame': 0 obs. of  4 variables:
# $ a  : chr 
# $ b_1: num 
# $ b_2: num 
# $ b_3: num 

- zx8754

Answer 2

类似于@zx8754的回答，但也对命名进行了修改。

as.data.frame(
    list("text"=character(0), "num"=numeric(0))[rep(descr$form, descr$rept)],
    col.names=paste0(
        rep(descr$varCat, descr$rept),
        unlist(lapply(descr$rept, \(x) if(x > 1) paste0("_", sequence(x)) else "" ))
    )
)
##[1] a   b_1 b_2 b_3
##<0 rows> (or 0-length row.names)

关键的元素是as.data.frame.list，它允许使用list()生成列类型的子集，可以通过col.names=参数直接命名。

- thelatemail

Answer 3

一个使用 purrr::pmap 和 dplyr::bind_cols 的 tidyverse 方法可能如下所示：

library(dplyr)
library(purrr)

descr <- tibble(
  varCat = c("a", "b"),
  rept = c(1, 3),
  form = c("text", "num")
)

purrr::pmap(descr, function(varCat, rept, form) {
  col_type <- switch(form,
                     "text" = character(0),
                     "num" = numeric(0)
  )
  d <- bind_cols(map(seq(rept), ~ col_type))
  names(d) <- if (rept > 1) {
    paste(varCat, seq(rept), sep = "_")    
  } else {
    varCat
  }
  d
}) %>%
  bind_cols()
#> New names:
#> • `` -> `...1`
#> New names:
#> • `` -> `...1`
#> • `` -> `...2`
#> • `` -> `...3`
#> # A tibble: 0 × 4
#> # … with 4 variables: a <chr>, b_1 <dbl>, b_2 <dbl>, b_3 <dbl>

- stefan