2016-04-27 3 views
4

Ich habe Daten wie folgt aus:Count identische Zeilenwerte für jedes Paar von Spalten erstellen Netzwerk Graph

dat <- data.frame(
    music = c("classical", "jazz", "baroque", "electronic", "ambient"), 
    john = c(1,1,0,1,1), 
    jeff = c(1,0,0,1,0), 
    jane = c(0,1,1,0,0) 
) 

     music john jeff jane 
1 classical 1 1 0 
2  jazz 1 0 1 
3 baroque 0 0 1 
4 electronic 1 1 0 
5 ambient 1 0 0 

Und will die Überlappung zwischen den Individuen auf den Säulen grafisch darzustellen - Wie oft haben sie beide 1s in die gleiche Reihe? Wenn ich diese bekommen konnte data.frame:

result <- data.frame(person1 = c("john", "john", "jeff"), person2 = c("jeff", "jane", "jane"), overlap = c(2, 1, 0)) 

    person1 person2 overlap 
1 john jeff  2 
2 john jane  1 
3 jeff jane  0 

ich das Diagramm erstellen konnte ich im Sinn haben:

library(igraph) 
g <- graph.data.frame(result, directed = FALSE) 
plot(g, edge.width = result$overlap * 3) 

Aber ich kämpfen, um die Daten zu transformieren reihenweise Überlappung zwischen jedem Paar zählen von Spalten. Wie kann ich das machen?

+2

Versuchen 'm user20650

+1

@ user20650 das ist eine perfekte Antwort ist;. ich denke, man sollte es offiziell machen – Craig

Antwort

4

Wahrscheinlich ein einfacher Ansatz ist, indem das Kreuzprodukt des Adjazenzmatrix des Graphen zu erstellen. Sie können dies direkt in igraph lesen.

library(igraph) 

# Take the crossproduct: assumes unique music types in each row 
# otherwise aggregate terms 
m <- crossprod(as.matrix(dat[-1])) 

# You could remove the diagonal terms here 
# although it is useful to see the sum for each individual 
# You can also remove it in igraph, as below 
# diag(m) <- 0 

# Create graph 
# The weights are stored in E(g)$weight 
g <- graph_from_adjacency_matrix(m, mode="undirected", weighted = TRUE) 

# Remove edge loops 
g <- simplify(g) 
1

Folgende Arbeiten für Ihr Beispiel:

# build name matrix 
nameMat <- t(combn(names(dat[,-1]), 2)) 
# pre-allocate count vector 
overLap <- integer(nrow(nameMat)) 

# loop through name combos 
for(i in 1:nrow(nameMat)) { 
    overLap[i] <- sum(rowSums(dat[, nameMat[i,]]) == 2) 
} 
# construct data.frame 
df <- data.frame("person1"=nameMat[,1], "person2"=nameMat[,2], "overLap"=overLap) 

Wenn Sie for Schleifen nicht gefällt, können Sie sapply verwenden, um die Überlappungszahl zu erhalten:

overLap <- sapply(1:(nrow(nameMat)), 
        function(i) sum(rowSums(dat[, nameMat[i,]]) == 2)) 

wie von @ user20650, Sie können auch die Überlappung mit combn:

overLap <- combn(dat[-1], 2, FUN=function(i) sum(rowSums(i)==2)) 
berechnen

Ein langes Überlappung Verfahren der Berechnung ist wie folgt: OVERLAP < - sapply (1: (nRow (nameMat)), Funktion (i) Summe (rowSums (DAT [, nameMat [i]] == C (1,1)) == 2))

Diese längere Version einen Vorteil hat, dass sie auf die Situation verallgemeinert werden können, wo diese Maßnahmen auf einer Likert-Skala sind (Intensität der Affinität anzeigt). In der Situation einer 5-Punkte-Skala könnte c (1,1) zu c (3,3) geändert werden, um die Indifferenz oder c (5,5) zu untersuchen. Wenn das Interesse an Gegenpol Meinungen waren, wie zum Beispiel c (1,5), würden die nameMat haben manipulierten und kopiert werden:

newNameMat <- rbind(nameMat, cibind(nameMat[,2], nameMat[,1]) 

und Berechnungen auf dieser Matrix durchgeführt. Es wäre nicht zu schwierig, diese Operationen in eine Funktion einzubinden, die jeden paarweisen Vergleich von Likert-Skalen-Kombinationen zählen könnte.

+0

für Ihre letzte Berechnung Sie dies in combn tun können .. 'combn (dat [-1], 2, FUN = function (x) sum (rowSums (x) == 2)) ', aber man kann es vielleicht tut alles zusammen ...' t (combn (dat [-1], 2, FUN = function (x) c (Namen (x), sum (rowSums (x) == 2)))) '(obwohl im sicher, dass dies vereinfacht werden kann) – user20650

+1

Danke für den Tipp @ user20650. ich habe zuvor in dieser Art und Weise nicht verwendet' combn'. ich habe die ersten 'Kamm 'Vorschlag zu meiner Antwort. – lmo

2

Vielleicht möchten Sie mit verschiedenen Ähnlichkeit/Abstandsmaße experimentieren, wie Russel/Roa, Jaccard usw. Ich meine: 0 und 0 als Ähnlichkeit interpretiert werden, auch. Wie auch immer, hier ist ein anderer Ansatz:

library(proxy) 
m <- (1-as.matrix(dist(t(dat[, -1]), method = "Russel")))*nrow(dat) 
m[lower.tri(m, T)] <- NA 
(res <- setNames(reshape2::melt(m, na.rm=T), c("p1", "p2", "ol"))) 
#  p1 p2 ol 
# 4 john jeff 2 
# 7 john jane 1 
# 8 jeff jane 0 
Verwandte Themen