Codierung für zwei verschiedene Clustermethoden

Question

Ich habe zwei verschiedene Clustermethoden verwendet, um zwei Clusterergebnisse zu generieren, und jede Clustermethode enthält 10 verschiedene Gruppen. Sie sind jedoch unterschiedlich codiert. Das folgende Beispiel zeigt die Clusterergebnisse:

set.seed(1) 

Df <- data.frame(Var1 = sample(1:6, 100, replace =T), Var2 = sample(1:6,100, replace =T)) 

table(Df) 

Ich mag die prozentuale Übereinstimmung (oder die Anzahl der Vereinbarung) zwischen diesen beiden Methoden zu finden und neu codiert Cluster2 auf ein Niveau von Cluster1, so dass sie die maximalen Prozentsatz Vereinbarung haben (oder Zahl der Fälle). Ich habe einen Algorithmus dafür geschrieben, aber war nicht sehr erfolgreich, nachdem die Anzahl der Cluster zugenommen hat. Mein Datensatz hat über 100000 Fälle.

Answer 1

Nachdem darüber nachzudenken, ich glaube, ich eine einfache gefunden Beantworte meine Frage. Ich kann einfach eine Schleife verwenden, um es zu trimmen und die Übereinstimmungen zu finden.

set.seed (1) 
df <- data.frame(Cluster1 = sample(LETTERS[1:n], c, replace =T), Cluster2 = sample(1:n,c, replace =T)) 
findmatch <- function(df, group1 = "Cluster1", group2 = "Cluster2") { 
    n <- length(unique(df[, group1])) 
    matches <- matrix(NA, n, 2) 
    for(i in 1:n) { 
     if(i==1) { 
     table1 <- table(df[, group1], df[,group2]) 
     } else if(i<n) { 
     table1 <- table1[-maxs[1],-maxs[2]] 
     } 
     maxs <- which(table1 == max(table1), arr.ind = TRUE) 
     if(i < n) { 
     matches[i,1:2] <- c(rownames(table1)[maxs[1]], colnames(table1)[maxs[2]])  
     } else { 
     matches[i,1:2] <- c(rownames(table1)[-maxs[1]], colnames(table1)[-maxs[2]])  
    } 
    } 
    return(matches) 
} 
findmatch(df=df) 


     [,1] [,2] 
[1,] "J" "5" 
[2,] "I" "7" 
[3,] "A" "6" 
[4,] "E" "3" 
[5,] "D" "10" 
[6,] "C" "8" 
[7,] "B" "1" 
[8,] "F" "9" 
[9,] "H" "2" 
[10,] "G" "4" 

Answer 2

Dies könnte ein bisschen ein Shotgun-Ansatz sein, da ich nicht weiß, wie viele Cluster es in den realen Daten gibt. Ich versuche, hier alle möglichen Kombinationen:

df <- data.frame(Cluster1 = c("A","A", "B", "B", "C","C", "C"), 
       Cluster2 = c("1", "2", "3", "3", "2","1","3")) 

require(gtools) 
comb <- permutations(n = 3, r = 3, v = 1:3) 

#try every combination and count the matches 
nmatch <- apply(comb,1,function(x) sum(LETTERS[match(df$Cluster2,x)] == df$Cluster1)) 

#pick the best performing translation 
best <- comb[which.max(nmatch),] 
# generate translation table 
data.frame(Cluster2 = 1:3, Cluster2new = LETTERS[best]) 

Ergebnis:

Cluster2 Cluster2new 
1  1   A 
2  2   C 
3  3   B 

Ihr neues Beispieldaten:

set.seed(314) 
df <- data.frame(Cluster1 = sample(LETTERS[1:6], 100, replace =T), Cluster2 = sample(1:6,100, replace =T)) 

require(gtools) 
comb <- permutations(n = 6, r = 6, v = 1:6) 

#try every combination and count the matches 
nmatch <- apply(comb,1,function(x) sum(LETTERS[match(df$Cluster2,x)] == df$Cluster1)) 

#pick the best performing translation 
best <- comb[which.max(nmatch),] 
# generate translation table 
data.frame(Cluster2 = 1:3, Cluster2new = LETTERS[best]) 

Ergebnis:

Cluster2 Cluster2new 
1  1   B 
2  2   D 
3  3   C 
4  1   A 
5  2   E 
6  3   F 

---

scheint die Berechnung der Permutationen der limitierende Faktor zu sein. Dafür habe ich eine alternative Lösung, die zufällig nach Möglichkeiten sucht und den passenden Prozentsatz berechnet. Diese Methode ist viel schneller, wird aber wahrscheinlich nicht die beste Lösung für das Problem enthalten.

set.seed(314) 

c = 10000 
n = 10 
tries = 1000 

df <- data.frame(Cluster1 = sample(LETTERS[1:n], c, replace =T), Cluster2 = sample(1:n,c, replace =T)) 

#try every combination and count the matches 
nmatch <- sapply(1:tries,function(x) { 
    set.seed(x) 
    comb <- sample(1:n,n) 
    sum(LETTERS[match(df$Cluster2,comb)] == df$Cluster1) 
    }) 

#pick the best performing translation 
best <- which.max(nmatch) 
# generate translation table 
set.seed(best) 
data.frame(Cluster2 = 1:n, Cluster2new = LETTERS[sample(1:n,n)]) 

nmatch[best]/c 

Ergebnis:

Cluster2 Cluster2new 
1   1   B 
2   2   J 
3   3   D 
4   4   C 
5   5   A 
6   6   G 
7   7   E 
8   8   F 
9   9   I 
10  10   H 
> 
    > nmatch[best]/c 
[1] 0.1099 

---

oder eine langsamere iterative Vorarb:

solve <- function(start) 
{ 
    sol <- integer() 
    start <- sample(1:n) 
    left <- start 
    for(i in start){ 

    nmatch <- sapply(left, function(x) { 
     cl <- df[df$Cluster2==x,] 
     sum(LETTERS[cl$Cluster2] == cl$Cluster1) 
    }) 
    ix <- which.max(nmatch) 
    sol[i] <- left[ix] 
    left <- left[-ix] 
    } 
    sol 
} 

nmatch <- sapply(1:tries, function(x) { 
    set.seed(x) 
    sum(LETTERS[match(df$Cluster2,solve(sample(1:n)))] == df$Cluster1) 
}) 

best <- which.max(nmatch) 

data.frame(Cluster2 = 1:n, Cluster2new = LETTERS[sample(1:n,n)]) 

nmatch[best]/c 

Ergebnisse:

Cluster2 Cluster2new 
1   1   D 
2   2   G 
3   3   C 
4   4   I 
5   5   E 
6   6   A 
7   7   B 
8   8   J 
9   9   F 
10  10   H 
>  
    >  nmatch[best]/c 
[1] 0.1121 

Als eine Darstellung, der zweiten Zufall Vorarb, könnte besser sein, eine gute Lösung in immer, wenn Sie bei der Verteilung von nmatch pro Methode aussehen: