Pregunta Llenar una "matriz de recuento" con permutaciones de filas R data.table


(Para lo siguiente, podría usar un cuadro de datos R o un cuadro de datos R. Ambos están bien).

Tengo la siguiente tabla de datos:

library(data.table)

dt = data.table(V1=c("dog", "dog", "cat", "cat", "cat", "bird","bird","bird","bird"), 
                    V2=rep(42, 9), V3=c(1, 2, 4, 5, 7, 1, 2, 5, 8)) 

> print(dt)
     V1 V2 V3
1:  dog 42  1
2:  dog 42  2
3:  cat 42  4
4:  cat 42  5
5:  cat 42  7
6: bird 42  1
7: bird 42  2
8: bird 42  5
9: bird 42  8

Columna V3 contiene enteros del 1 al 8. Mi objetivo es rellenar una matriz de 8 por 8 cero con el recuento de cada combinación "par" dada la categoría única en la columna V1

Así, la combinación de pares para dog, caty bird son:

dog: (1, 2)
cat: (4, 5), (4, 7), (5, 7)
bird: (1, 2), (1, 5), (1, 8), (2, 5), (2, 8), (5, 8)

Para cada par, agrego +1 a la entrada correspondiente en la matriz cero. Para esta matriz, (n, m) = (m, n). La matriz dada dt sería:

   1 2 3 4 5 6 7 8
1: 0 2 0 0 1 0 0 1
2: 2 0 0 0 1 0 0 1
3: 0 0 0 0 0 0 0 0
4: 0 0 0 0 1 0 1 0
5: 1 1 0 1 0 0 1 1
6: 0 0 0 0 0 0 0 0
7: 0 0 0 1 1 0 0 0
8: 1 1 0 0 1 0 0 0

Tenga en cuenta que (1,2)=(2,1) tiene un conteo 2, de la dog combinación y la bird combinación.

(1) ¿Existe un método para calcular las combinaciones de valores en una columna R data.table / data.frame, dado el valor único en otra columna?

Quizás tendría sentido generar una lista R, con "pares" de vectores, p.

list(c(1, 2), c(2, 1), c(4, 5), c(4, 7), c(5, 7), c(5, 4), c(7, 4), c(7, 5),
    c(1, 2), c(1, 5), c(1, 8), c(2, 5), c(2, 8), c(5, 8), c(2, 1), c(5, 1),
    c(8, 1), c(5, 2), c(8, 2), c(8, 5))

Sin embargo, no estoy seguro de cómo usaría esto para poblar una matriz ...

(2) Dada la entrada data.table / data.frame, ¿cuál sería la estructura de datos más eficiente a usar para escribir una matriz, como se muestra arriba?


5
2017-08-12 18:06


origen


Respuestas:


Aquí hay una solución de data.table que parece ser eficiente. Básicamente hacemos una auto unión para crear combinaciones y luego contar. Luego, de manera similar a lo que @coldspeed hizo con Numpy, solo actualizaremos una matriz cero por ubicaciones con conteos.

# a self join
tmp <- dt[dt, 
             .(V1, id = x.V3, id2 = V3), 
             on = .(V1, V3 < V3), 
             nomatch = 0L,
             allow.cartesian = TRUE
          ][, .N, by = .(id, id2)]

## Create a zero matrix and update by locations
m <- array(0L, rep(max(dt$V3), 2L))
m[cbind(tmp$id, tmp$id2)] <- tmp$N
m + t(m)

#      [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8]
# [1,]    0    2    0    0    1    0    0    1
# [2,]    2    0    0    0    1    0    0    1
# [3,]    0    0    0    0    0    0    0    0
# [4,]    0    0    0    0    1    0    1    0
# [5,]    1    1    0    1    0    0    1    1
# [6,]    0    0    0    0    0    0    0    0
# [7,]    0    0    0    1    1    0    0    0
# [8,]    1    1    0    0    1    0    0    0

Alternativamente, podríamos crear tmp utilizando data.table::CJ pero eso podría ser (potencialmente, gracias a @Frank para la punta) menos eficiente en memoria, ya que creará todas las combinaciones posibles primero, por ejemplo.

tmp <- dt[, CJ(V3, V3)[V1 < V2], by = .(g = V1)][, .N, by = .(V1, V2)]

## Then, as previously
m <- array(0L, rep(max(dt$V3), 2L))
m[cbind(tmp$V1, tmp$V2)] <- tmp$N
m + t(m)

#      [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8]
# [1,]    0    2    0    0    1    0    0    1
# [2,]    2    0    0    0    1    0    0    1
# [3,]    0    0    0    0    0    0    0    0
# [4,]    0    0    0    0    1    0    1    0
# [5,]    1    1    0    1    0    0    1    1
# [6,]    0    0    0    0    0    0    0    0
# [7,]    0    0    0    1    1    0    0    0
# [8,]    1    1    0    0    1    0    0    0

6
2017-08-12 19:46



No estoy seguro de que este sea el enfoque más elegante, pero funciona:

myfun <- function(x, matsize=8) {
    # get all (i,j) pairs but in an unfortunate text format
    pairs_all <- outer(x, x, paste)

    # "drop" all self-pairs like (1,1)
    diag(pairs_all) <- "0 0"

    # convert these text-pairs into numeric pairs and store in matrix
    ij <- do.call(rbind, lapply(strsplit(pairs_all, " "), as.numeric))

    # create "empty" matrix of zeros
    mat <- matrix(0, nrow=matsize, ncol=matsize)

    # replace each spot of empty matrix with a 1 if that pair exists
    mat[ij] <- 1

    # return 0/1 matrix
    return(mat)
}

# split your data by group
# lapply the custom function to each group
# add each group's 0/1 matrix together for final result
Reduce('+', lapply(split(dt$V3, dt$V1), myfun))

Si alguien tiene una forma más directa de implementar las primeras 3 líneas (sin comentarios) de myfun, Felizmente los incorporaría.


2
2017-08-12 19:06