regex - R:如何使用正则表达式对列表元素进行分组和聚合？

Question

我想按组汇总(汇总)以下产品列表(见下文):

prods <- list("101.2000"=data.frame(1,2,3),
              "102.2000"=data.frame(4,5,6),
              "103.2000"=data.frame(7,8,9),
              "104.2000"=data.frame(1,2,3),
              "105.2000"=data.frame(4,5,6),
              "106.2000"=data.frame(7,8,9),
              "101.2001"=data.frame(1,2,3),
              "102.2001"=data.frame(4,5,6),
              "103.2001"=data.frame(7,8,9),
              "104.2001"=data.frame(1,2,3),
              "105.2001"=data.frame(4,5,6),
              "106.2001"=data.frame(7,8,9))
test= list("100.2000"=data.frame(2,3,5),
           "100.2001"=data.frame(4,5,6))
names <- c("A", "B", "C")
prods <- lapply(prods, function (x) {colnames(x) <- names; return(x)})

产品列表(产品)的每个元素都有产品编号和年份的名称组合(例如 101.2000 --> 101 = 产品编号和 2000 = 年份)。并且这些组仅包含聚合的产品编号。

group1 <- c(101, 106)
group2 <- c(102, 104)
group3 <- c(105, 103)

我的预期结果显示了按年份汇总的产品组:

$group1.2000
  A  B  C
1 8 10 12

$group2.2000
  A B C
1 5 7 9

$group3.2000
   A  B  C
1 11 13 15

$group1.2001
  A  B  C
1 8 10 12

$group2.2001
  A B C
1 5 7 9

$group3.2001
   A  B  C
1 11 13 15

到目前为止，我尝试过这种方式:首先我将产品的名称分解为产品编号:

prodnames <- names(prods)
prodnames_sub <- gsub("\\..*.","", prodnames)

然后我尝试使用 lapply 进行聚合:

lapply(prods, function(x) aggregate( ...  , FUN = sum)

但是，我没有找到如何在聚合函数中实现以前的产品编号。想法？谢谢

Answer 1

这里有两种方法。两者都没有使用包。

1) 使用列表 从列为产品(value 列)和关联的组创建一个两列数据框 S组(ind 列)。创建要拆分的列表，By。在生成 By 的代码中，sub("\\.*", "", names(prods)) 提取产品并且 match 是然后用于查找关联的组。 sub("\\..*", "", names(prods)) 提取年份。接下来执行拆分并对其进行重叠以运行求和。 By 的两个组成部分(group 和 year)可以根据需要颠倒以更改输出顺序。

S <- stack(list(group1 = group1, group2 = group2, group3 = group3))
By <- list(group = S$ind[match(sub("\\..*", "", names(prods)), S$values)],
           year = sub(".*\\.", "", names(prods)))
lapply(split(prods, By), function(x) colSums(do.call(rbind, x)))

2) 使用 data.frames 将组和产品分别转换为数据框，合并它们，执行聚合并拆分回列表。除顺序外，输出与请求的相同。 (反转聚合公式中右侧的两个变量以获得问题中显示的顺序，但这也会反转输出列表中每个组件名称的两部分。)

S <- stack(list(group1 = group1, group2 = group2, group3 = group3))

DF0 <- do.call(rbind, prods)
DF <- cbind(do.call(rbind, strsplit(rownames(DF0), ".", fixed = TRUE)), DF0)

M <- merge(DF, S, all.x = TRUE, by = 1)
Ag <- aggregate(cbind(A, B, C) ~ ind + `2`, M, sum)
lapply(split(Ag, paste(Ag[[1]], Ag[[2]], sep = ".")), "[", 3:5)

给予:

$group1.2000
  A  B  C
1 8 10 12

$group1.2001
  A  B  C
4 8 10 12

$group2.2000
  A B C
2 5 7 9

$group2.2001
  A B C
5 5 7 9

$group3.2000
   A  B  C
3 11 13 15

$group3.2001
   A  B  C
6 11 13 15