将一个数据逐行合并到另一个数据帧作为模板

时间:2014-05-16 03:19:30

标签: r merge

我想将data.frame my.samples的每一行合并到另一个data.frame my.template以获取desired.result

可以使用my.template创建模板expand.grid。因此,即使这是一个最小的示例,输出数据集desired.result仍然很大。

我在下面发布了几次无效的尝试和一次有效的尝试。但是,有效的代码似乎过于复杂。

感谢您的任何建议。我更喜欢基地R。关于合并数据帧还有很多其他帖子。我看了很多,但没有看到这个场景得到解决。对不起,如果我忽略了它。

my.samples  <- read.table(text = '
                          obs  X1 X2 X3   z
                            1   2  1  0   1
                            2   0  0  0   1
                            3   0  1  2   1
                          ', header = TRUE)

my.template <- read.table(text = '
                                  X1 X2 X3
                                   0  0  0
                                   0  0  1
                                   0  0  2
                                   0  1  0
                                   0  1  1
                                   0  1  2
                                   0  2  0
                                   0  2  1
                                   0  2  2
                                   1  0  0
                                   1  0  1
                                   1  0  2
                                   1  1  0
                                   1  1  1
                                   1  1  2
                                   1  2  0
                                   1  2  1
                                   1  2  2
                                   2  0  0
                                   2  0  1
                                   2  0  2
                                   2  1  0
                                   2  1  1
                                   2  1  2
                                   2  2  0
                                   2  2  1
                                   2  2  2
                          ', header = TRUE)

desired.result <- read.table(text = '
                             obs  X1 X2 X3  z
                               1   0  0  0  0
                               1   0  0  1  0
                               1   0  0  2  0
                               1   0  1  0  0
                               1   0  1  1  0
                               1   0  1  2  0
                               1   0  2  0  0
                               1   0  2  1  0
                               1   0  2  2  0
                               1   1  0  0  0
                               1   1  0  1  0
                               1   1  0  2  0
                               1   1  1  0  0
                               1   1  1  1  0
                               1   1  1  2  0
                               1   1  2  0  0
                               1   1  2  1  0
                               1   1  2  2  0
                               1   2  0  0  0
                               1   2  0  1  0
                               1   2  0  2  0
                               1   2  1  0  1
                               1   2  1  1  0
                               1   2  1  2  0
                               1   2  2  0  0
                               1   2  2  1  0
                               1   2  2  2  0
                               2   0  0  0  1
                               2   0  0  1  0
                               2   0  0  2  0
                               2   0  1  0  0
                               2   0  1  1  0
                               2   0  1  2  0
                               2   0  2  0  0
                               2   0  2  1  0
                               2   0  2  2  0
                               2   1  0  0  0
                               2   1  0  1  0
                               2   1  0  2  0
                               2   1  1  0  0
                               2   1  1  1  0
                               2   1  1  2  0
                               2   1  2  0  0
                               2   1  2  1  0
                               2   1  2  2  0
                               2   2  0  0  0
                               2   2  0  1  0
                               2   2  0  2  0
                               2   2  1  0  0
                               2   2  1  1  0
                               2   2  1  2  0
                               2   2  2  0  0
                               2   2  2  1  0
                               2   2  2  2  0
                               3   0  0  0  0
                               3   0  0  1  0
                               3   0  0  2  0
                               3   0  1  0  0
                               3   0  1  1  0
                               3   0  1  2  1
                               3   0  2  0  0
                               3   0  2  1  0
                               3   0  2  2  0
                               3   1  0  0  0
                               3   1  0  1  0
                               3   1  0  2  0
                               3   1  1  0  0
                               3   1  1  1  0
                               3   1  1  2  0
                               3   1  2  0  0
                               3   1  2  1  0
                               3   1  2  2  0
                               3   2  0  0  0
                               3   2  0  1  0
                               3   2  0  2  0
                               3   2  1  0  0
                               3   2  1  1  0
                               3   2  1  2  0
                               3   2  2  0  0
                               3   2  2  1  0
                               3   2  2  2  0
                          ', header = TRUE)

# this works for one obs at a time

merge(my.samples[1,], my.template, by=c('X1', 'X2', 'X3'), all=TRUE)


# this does not work

apply(my.samples, 1, function(x) merge(x, my.template, by=c('X1', 'X2', 'X3'), all=TRUE))


# this does not work

my.output <- matrix(0, nrow=(3^3 * max(my.samples$obs)), ncol=5)

for(i in 1:max(desired.result$obs)) {

     x <- merge(my.samples[i,], my.template, by=c('X1', 'X2', 'X3'), all=TRUE)

     my.output[((i-1) * 3^3 +1) : ((i-1) * 3^3 + 3^3), 1:5] <- x

}


# this works

for(i in 1:max(desired.result$obs)) {

     x <- merge(my.samples[i,], my.template, by=c('X1', 'X2', 'X3'), all=TRUE)

     x$obs <- i

     x$z[is.na(x$z)] <- 0

     if(i == 1) {my.output = x}
     if(i >  1) {my.output = rbind(my.output, x)}

}

my.output

all.equal(my.output[1:3], desired.result[,2:4])

2 个答案:

答案 0 :(得分:2)

我相信这应该有用

#expand template
full<-do.call(rbind, lapply(unique(my.samples$obs), 
    function(x) cbind(obs=x, my.template)))

#merge
result<-merge(full, my.samples, all.x=T)

#change NA's to 0
result$z[is.na(result$z)]<-0

#> all(result==desired.result)
#[1] TRUE

答案 1 :(得分:0)

我喜欢@MrFlick发布的答案但是当我向my.samples添加了另一列时,我发现我必须修改代码。以下是我提出的建议。

my.samples  <- read.table(text = '
                          obs  X1 X2 X3   z   aa
                            1   2  1  0   1   20
                            2   0  0  0   1  -10
                            3   0  1  2   1   10
                          ', header = TRUE)

my.template <- read.table(text = '
                                  X1 X2 X3
                                   0  0  0
                                   0  0  1
                                   0  0  2
                                   0  1  0
                                   0  1  1
                                   0  1  2
                                   0  2  0
                                   0  2  1
                                   0  2  2
                                   1  0  0
                                   1  0  1
                                   1  0  2
                                   1  1  0
                                   1  1  1
                                   1  1  2
                                   1  2  0
                                   1  2  1
                                   1  2  2
                                   2  0  0
                                   2  0  1
                                   2  0  2
                                   2  1  0
                                   2  1  1
                                   2  1  2
                                   2  2  0
                                   2  2  1
                                   2  2  2
                          ', header = TRUE)

obs.aa <- my.samples[, c(1, ncol(my.samples))]

my.template2 <- merge(my.template, obs.aa)

my.template3 <- merge(my.template2, my.samples, by=c('obs', 'aa', paste0('X', 1:(ncol(my.samples)-3))), all = TRUE)

my.template3$z[is.na(my.template3$z)] <- 0
my.template3