BASE R中从两个列表提取data.frame新增列时输出错乱如何修复

问题描述 #

我跟进相关回答进行操作，该回答给出的输出效果符合预期，如下所示：

tlist.mpre tlist.sdpre tlist.n clist.mpre clist.sdpre clist.n
Dlsk_Krlr.102       81.6        10.8      73       80.5        11.2      80
Dlsk_Krlr.103       85.7        13.7      66       90.3         6.6      74
Dlsk_Krlr.104       81.4        10.9      72       80.5        11.2      80
Dlsk_Krlr.105       90.4         8.2      61       90.3         6.6      74

现在我需要从data中提取nms = c('time_wk','treats')指定的两列添加到上述输出中，但我在代码中加入nms后得到的新输出出现格式错乱（见下方R代码末尾）。
以下是我的可复现R代码，请问有什么修复方案？

data <- read.csv("https://raw.githubusercontent.com/rnorouzian/m2/main/q.csv")

nms = c('time_wk','treats')

m = split(data, data$study.name)

(mm = m["Dlsk_Krlr"])


(input <- lapply(mm, function(i) 
  rev(expand.grid(post = unique(i$post),outcome = unique(i$outcome)))))

res <- setNames(lapply(1:0, function(i) lapply(input, function(inp) Map(function(o, p)
  do.call(rbind, lapply(mm, function(x)
    x[x$control == i & x$post == p & x$outcome == o, , drop = FALSE])),
  inp$outcome, inp$post))), c("clist", "tlist"))


(aa = setNames(lapply(seq_along(res), function(i) Filter(NROW, res[[i]][[1]])), names(res)))


b <- lapply(aa, function(x)  {
  y <- do.call(rbind,  x);
  y[order(y$group), c("mpre", "sdpre", "n", nms)] }) ## 我在此处添加`nms`导致下方输出错乱

cc = do.call(cbind,rev(b))
cc_1 = cc[!duplicated(cc),]
names(cc_1)[1:6] = c('mT','sdT','nT','mC','sdC','nC')

### 添加`nms`后的错乱输出：
#                mT  sdT nT mC sdC   nC clist.sdpre clist.n clist.time_wk clist.treats
#Dlsk_Krlr.102 81.6 10.8 73  1   2 80.5        11.2      80             1            2
#Dlsk_Krlr.103 85.7 13.7 66  1   2 90.3         6.6      74             1            2
#Dlsk_Krlr.104 81.4 10.9 72  1   2 80.5        11.2      80             1            2
#Dlsk_Krlr.105 90.4  8.2 61  1   2 90.3         6.6      74             1            2

修复方案 #

格式错位的原因是clist和tlist两个分组的返回结果都包含了time_wk、treats两列，合并后重复保留了两份，同时你仅修改了前6列的命名，原本对应clist的mpre、sdpre、n列被挤到了右侧，和你手动定义的mC、sdC、nC列名错位。
调整处理逻辑，仅在其中一个分组中保留nms指定的列即可，修改后完整代码如下：

data <- read.csv("https://raw.githubusercontent.com/rnorouzian/m2/main/q.csv")

nms = c('time_wk','treats')

m = split(data, data$study.name)
mm = m["Dlsk_Krlr"]

input <- lapply(mm, function(i) 
  rev(expand.grid(post = unique(i$post),outcome = unique(i$outcome))))

res <- setNames(lapply(1:0, function(i) lapply(input, function(inp) Map(function(o, p)
  do.call(rbind, lapply(mm, function(x)
    x[x$control == i & x$post == p & x$outcome == o, , drop = FALSE])),
  inp$outcome, inp$post))), c("clist", "tlist"))

aa = setNames(lapply(seq_along(res), function(i) Filter(NROW, res[[i]][[1]])), names(res))

# 仅在tlist中保留nms列，clist只保留三个统计列，避免重复
b <- lapply(names(aa), function(nm)  {
  y <- do.call(rbind,  aa[[nm]]);
  y <- y[order(y$group), ]
  if(nm == "tlist") {
    y[, c("mpre", "sdpre", "n", nms)]
  } else {
    y[, c("mpre", "sdpre", "n")]
  }
})

cc = do.call(cbind,rev(b))
cc_1 = cc[!duplicated(cc),]
# 按列的实际含义命名
names(cc_1) = c('mT','sdT','nT', nms, 'mC','sdC','nC')

运行后输出结果如下：

mT  sdT nT time_wk treats   mC  sdC nC
Dlsk_Krlr.102 81.6 10.8 73       1      2 80.5 11.2 80
Dlsk_Krlr.103 85.7 13.7 66       1      2 90.3  6.6 74
Dlsk_Krlr.104 81.4 10.9 72       1      2 80.5 11.2 80
Dlsk_Krlr.105 90.4  8.2 61       1      2 90.3  6.6 74

内容的提问来源于stack exchange，提问作者rnorouzian