Compute bedeuten paarweise Kovarianz zwischen den Elementen in einer Liste

Question

Ich habe folgende Datenrahmen:

# df1 
id cg_v 
1  a 
2  b 
3  a b 
4  b c 
5 b c d 
6  d 

# df2 
id cg 
1 a 
2 b 
3 a 
3 b 
4 b 
4 c 
5 b 
5 c 
5 d 
6 d 

Ich brauche eine Spalte df1 hinzuzufügen, die die Kovarianz über jedes Paar von Elementen in cg_v berechneten Mittel enthält. Wenn cg_v nur ein Element enthält, möchte ich, dass die neue Spalte ihre Varianz enthält.

Ich kann von cov(crossprod(table(df2)))

#   a   b   c   d 
a 0.9166667 0.0000000 -0.5833333 -0.6666667 
b 0.0000000 2.0000000 1.0000000 0.0000000 
c -0.5833333 1.0000000 0.9166667 0.3333333 
d -0.6666667 0.0000000 0.3333333 0.6666667 

eine Kovarianzmatrix erhalten Was kann ich tun, von hier aus?

Das Endergebnis sollte wie folgt sein:

# df1 
id cg_v  cg_cov 
1  a 0.9166667 
2  b 2.0000000 
3  a b 0.0000000 
4  b c 1.0000000 
5 b c d 0.4444444 # This is equal to (1.0000000 + 0.3333337 + 0.0000000)/3 
6  d 0.6666667 

-Code df1 und df2 zu generieren:

df1 <- structure(list(id = c(1L, 2L, 3L, 4L, 5L, 6L), 
         cg_v = c("a", "b", "a b", "b c", "b c d", "d")), 
       .Names = c("id", "cg_v"), 
       class = "data.frame", row.names = c(NA, -6L)) 

df2 <- structure(list(id = c(1L, 2L, 3L, 3L, 4L, 4L, 5L, 5L, 5L, 6L), 
         cg = c("a", "b", "a", "b", "b", "c", "b", "c", "d", "d")), 
       .Names = c("id", "cg"), 
       class = "data.frame", row.names = c(NA, -10L)) 

Answer 1

Ich denke, dass ich eine Lösung für dieses Problem gefunden data.tables verwenden und neu zu gestalten. Was willst du mit den drei Buchstaben b c d machen? Ich nahm an, dass Sie die Kovarianz der ersten beiden Buchstaben haben wollen:

 require(reshape) 
     require(data.table) 
     dt1 <- data.table(id = c(1L, 2L, 3L, 4L, 5L, 6L), 
          cg_v = c("a", "b", "a b", "b c", "b c d", "d")) 
     dt2 <- data.table(id = c(1L, 2L, 3L, 3L, 4L, 4L, 5L, 5L, 5L, 6L), 
           cg = c("a", "b", "a", "b", "b", "c", "b", "c", "d", "d")) 
     cov_dt <- data.table(melt(cov(crossprod(table(df2))))) 
     dt1 <- cbind(dt1, t(sapply(strsplit(as.character(df1$cg_v), " "), function(x)x[1:2]))) 
     #replace the na with the first colomn 
     dt1[is.na(V2), V2 := V1] 

     # Merge them on two columns 
     setkey(dt1, "V1", "V2") 
     setkey(cov_dt, "X1", "X2") 
     result <- cov_dt[dt1] 
> result[,.(id, cg_v, value)] 
    id cg_v  value 
1: 1  a 0.9166667 
2: 3 a b 0.0000000 
3: 2  b 2.0000000 
4: 4 b c 1.0000000 
5: 5 b c d 1.0000000 
6: 6  d 0.6666667 

Variante, die auch, wenn es funktioniert mehr als 2 Buchstaben sind (nicht der effizienteste Code):

require(reshape) 
require(combinat) 
df1 <- data.frame(id = c(1L, 2L, 3L, 4L, 5L, 6L), 
        cg_v = c("a", "b", "a b", "b c", "b c d", "d")) 
df2 <- data.frame(id = c(1L, 2L, 3L, 3L, 4L, 4L, 5L, 5L, 5L, 6L), 
         cg = c("a", "b", "a", "b", "b", "c", "b", "c", "d", "d")) 
cov_dt <- cov(crossprod(table(df2))) 
mat <- sapply(strsplit(as.character(df1$cg_v), " "), function(x) if(length(x) == 1){c(x,x)} else(x)) 
# Should be all minimal 2 
sapply(mat, length) > 1 
mat <- sapply(mat, function(x) matrix(combn(x,2), nrow = 2)) 
df1$cg_cov <- sapply(mat, function(x) mean(apply(x,2, function(x) cov_dt[x[1],x[2]]))) 
> df1 
    id cg_v cg_cov 
1 1  a 0.9166667 
2 2  b 2.0000000 
3 3 a b 0.0000000 
4 4 b c 1.0000000 
5 5 b c d 0.4444444 
6 6  d 0.6666667