Umkodierung Werte in einem Vektor, der die Anzahl der Paare von der gleichen Anzahl in einem anderen Vektor

Question

I haben die folgende Tabelle zu maximieren, original_table die aus dem Vergleich der Häufigkeit der Zahlenpaare über den gleichen Indizes von vector_1 und vector_2 ergibt:

vector_1 <- c(5, 6, 5, 4, 6, 6, 4, 1, 6, 7, 5, 3, 3, 4, 4, 7, 7, 7, 2, 7, 2, 6, 1) 
vector_2 <- c(1, 2, 1, 3, 4, 4, 4, 2, 4, 7, 2, 5, 5, 3, 3, 6, 7, 7, 6, 3, 6, 7, 2) 
original_table <- table(vector_1, vector_2) 
str(original_table) 

     vector_2 
vector_1 1 2 3 4 5 6 7 
     1 0 2 0 0 0 0 0 
     2 0 0 0 0 0 2 0 
     3 0 0 0 0 2 0 0 
     4 0 0 3 1 0 0 0 
     5 2 1 0 0 0 0 0 
     6 0 1 0 3 0 0 1 
     7 0 0 1 0 0 1 3 

Ich versuche, die Werte von vector_1 zu rekodieren, um die Anzahl der Paare der gleichen Anzahl für Werte mit dem gleichen Index in vector_2 zu maximieren. Ich versuche schließlich, diese zu rekodieren, um die Doppelspaltüberkreuzung zu verwenden, die durch Breckenridge (2000) beschrieben wird.

Die einzige „Regel“ ist, dass jeder Wert mit einem eindeutigen Wert umcodiert werden muss, so dass beide 1 und 2 können nicht beide als 3 umcodiert werden, zum Beispiel.

Ich habe diese mehr oder weniger manuell auf diese Weise durchgeführt unter Verwendung von car::recode:

vector_1 <- car::recode(vector_1, "6 = 4; 7 = 7; 4 = 3; 5 = 1; 3 = 5; 2 = 6; 1 = 2") 
optimized_table <- table(vector_1, vector_2) 
str(optimized_table) 

     vector_2 
vector_1 1 2 3 4 5 6 7 
     1 2 1 0 0 0 0 0 
     2 0 2 0 0 0 0 0 
     3 0 0 3 1 0 0 0 
     4 0 1 0 3 0 0 1 
     5 0 0 0 0 2 0 0 
     6 0 0 0 0 0 2 0 
     7 0 0 1 0 0 1 3 

Es gibt mindestens ein paar Probleme mit ihm auf diese Weise tun: Ich habe es eyeballed, also bin ich nicht sicher ist der optimale Weg, um die Gesamtzahl der Paare von Vektoren zwischen den Vektoren zu maximieren, und es ist nicht einfach mit einem anderen Datensatz zu reproduzieren. Ich suche nach einer Möglichkeit, dies besser/automatisch zu tun, aber ich kann nicht leicht einen programmatischen oder intelligenten Ansatz dafür finden.

Answer 1

Dies ist bekannt als assignment problem. Eine Möglichkeit, es zu lösen, ist die Ganzzahlprogrammierung; Sie können lpSolve::lp.assign verwenden:

library(lpSolve) 
res <- lp.assign(-original_table) 
l <- apply(res$solution > 0.5, 1, which) 
# [1] 2 6 5 3 1 4 7 

a priori schnellen Weg, das Problem zu lösen, ist die Hungarian algorithm Verwendung in dem clue Paket implementiert:

library(clue) 
res <- solve_LSAP(original_table, maximum = TRUE) 
# Optimal assignment: 
# 1 => 2, 2 => 6, 3 => 5, 4 => 3, 5 => 1, 6 => 4, 7 => 7 
l <- as.integer(res) 
# [1] 2 6 5 3 1 4 7 

Schließlich können Sie mit recode:

vector_1 <- l[vector_1] 

Answer 2

Hier ist ein gieriger Ansatz: Die Funktion assign_group benötigt beide Vektoren, eine Clusternummer des Vektors 1, der recodiert werden soll, und einen Vektor von Clusternummern von vector_2, die verfügbar sind (d. H. Nicht anderen Clustern von vector_1 zugewiesen). Die Funktion berechnet dann, welcher Clusternummer der verfügbaren Cluster in v2avail die Clusternummer v1cl zugeordnet werden soll. Dies geschieht durch Suche nach der Gruppe mit den meisten gleichzeitigen Vorkommen.

assign_group <- function(v1, v2, v1cl, v2avail) { 
    one_comparison <- function(v2cand) sum(v1==v1cl & v2==v2cand) 
    counts <- sapply(v2avail, FUN=one_comparison) 
    return(v2avail[which.max(counts)]) 
} 

Dann können wir durch die Clusternummern von vector_1 iterieren und den „besten“ Cluster für jede Cluster-Nummer finden. Das Ergebnis recode_map ist eine Zuordnung von den Clusternummern vector_1 zu den Clusternummern vector_2.

v2avail <- unique(vector_2) 
n <- length(v2avail) 
recode_map <- rep(NA, n) 
for (i in seq(n)) { 
    best <- assign_group(vector_1, vector_2, i, v2avail) 
    recode_map[i] <- best 
    v2avail <- setdiff(v2avail, best) # don't assign the same number twice 
} 

Der umcodiert Vektor führt zu ähnlichen Ergebnissen wie in Ihrer Frage:

v1perm <- recode_map[vector_1] 
table(v1perm, vector_2) 

Dieser Ansatz geht davon aus, dass vector_1 und vector_2 sind 1:n aus Zahlen gemacht. Das Ergebnis ist im allgemeinen nicht optimal und hängt von der Reihenfolge ab, in der die Zuordnung der Gruppen erfolgt. Vielleicht wäre das Ergebnis besser, wenn zuerst die Indizes 1:n nach der Anzahl der Vorkommen in vector_1 geordnet sind und die for Schleife in dieser Reihenfolge ausgeführt wird.

Answer 3

Wenn die Anzahl der eindeutigen Werte in den beiden Vektoren nicht sehr groß ist, können wir es auf brutale Weise herausfinden, indem wir alle Permutationen der möglichen Rekodierung konstruieren, die Permutationen durchlaufen, die vector_1 rekodieren und die Überlappung berechnen mit vector_2 und das Maximum nehmen.Dies kann nicht auf verschiedene Daten skalieren entweder eingestellt, aber mit ein wenig Änderung sollte sich leicht auf zwei verschiedene Vektoren angewendet werden:

library(permute) 
n = 7     # number of unique values in vector_1 and vector_2 
recodes = rbind(1:n, allPerms(n)) # calculate all possible recodes including the identity 
which.max(apply(recodes, 1, function(p) sum((1:n)[match(vector_1, p)] == vector_2))) 
# [1] 2943    
# this line loop through possible permutations and find out the maximum overlap of the two 
# vectors after recoding, here we used `match` instead of recode because it is easier to 
# use with vectors and will generate the same results 
recodes[2943,] 
# [1] 5 1 4 6 3 2 7 

Wenden Sie diese Umkodierung auf vector_1 erzeugt:

vector_1 = (1:n)[match(vector_1, recodes[2943, ])] 
table(vector_1, vector_2) 

#   vector_2 
# vector_1 1 2 3 4 5 6 7 
#  1 2 1 0 0 0 0 0 
#  2 0 2 0 0 0 0 0 
#  3 0 0 3 1 0 0 0 
#  4 0 1 0 3 0 0 1 
#  5 0 0 0 0 2 0 0 
#  6 0 0 0 0 0 2 0 
#  7 0 0 1 0 0 1 3 

Dies ergibt gleiche Ergebnis wie OP, und sollte die Überzeugung stärken, dass die zur Verfügung gestellte Aufnahme optimiert ist.