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

R: How to group and aggregate list elements using regex?

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

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

到目前为止,我是这样尝试的:首先我将prods的名称分解为产品编号:

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

然后我尝试使用 lapply:

进行聚合
lapply(prods, function(x) aggregate( ...  , FUN = sum)

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

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

1) 使用列表 从列为产品(value 列)的组创建两列 data.frame S 和相关组(ind 列)。创建要拆分的列表,By。在生成 By 的代码中,sub("\.*", "", names(prods)) 提取产品,然后 match 用于查找关联组。 sub("\..*", "", names(prods)) 提取年份。接下来执行拆分并 lapply 对其进行 运行 求和。如果需要,Bygroupyear)的两个组件可以反转以更改输出顺序。

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