將一個數據逐行合並到另一個數據幀作為模板

Question

我想在每行合並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])

Answer 1

我相信這應該有效

#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

Answer 2

我喜歡@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