Znaleźć najlepsze pasujące pary punktów z 2 wektorów

Question

Mam 2 listy z X, Y współrzędne punktów. Lista 1 zawiera więcej punktów niż lista 2.

Zadaniem jest znalezienie par punktów w taki sposób, aby zminimalizować ogólną odległość euklidesową.

Mam działający kod, ale nie wiem, czy to jest najlepszy sposób i chciałbym uzyskać podpowiedź, co mogę poprawić dla wyniku (lepszy algorytm do znalezienia minimum) lub szybkość, ponieważ lista jest około 2000 elementów każdy.

Runda w wektorach próbkowania jest zaimplementowana, aby uzyskać także punkty o tych samych odległościach. W funkcji "rdist" wszystkie odległości są generowane w "odległościach". Niż minimum w macierzy służy do połączenia 2 punktów ("dist_min"). Wszystkie odległości od tych 2 punktów zostaną teraz zastąpione przez NA i pętla będzie kontynuowana przez przeszukanie następnego minimum, aż wszystkie punkty listy 2 będą miały punkt z listy 1. Na końcu dodałem wykres do wizualizacji.

require(fields) 

set.seed(1) 
x1y1.data <- matrix(round(runif(200*2),2), ncol = 2) # generate 1st set of points 
x2y2.data <- matrix(round(runif(100*2),2), ncol = 2) # generate 2nd set of points 

distances <- rdist(x1y1.data, x2y2.data) 
dist_min <- matrix(data=NA,nrow=ncol(distances),ncol=7) # prepare resulting vector with 7 columns 

for(i in 1:ncol(distances)) 
{ 
    inds <- which(distances == min(distances,na.rm = TRUE), arr.ind=TRUE) 

    dist_min[i,1] <- inds[1,1]    # row of point(use 1st element of inds if points have same distance) 
    dist_min[i,2] <- inds[1,2]    # column of point (use 1st element of inds if points have same distance) 
    dist_min[i,3] <- distances[inds[1,1],inds[1,2]] # distance of point 
    dist_min[i,4] <- x1y1.data[inds[1,1],1]  # X1 ccordinate of 1st point 
    dist_min[i,5] <- x1y1.data[inds[1,1],2]  # Y1 coordinate of 1st point 
    dist_min[i,6] <- x2y2.data[inds[1,2],1]  # X2 coordinate of 2nd point 
    dist_min[i,7] <- x2y2.data[inds[1,2],2]  # Y2 coordinate of 2nd point 

    distances[inds[1,1],] <- NA # remove row (fill with NA), where minimum was found 
    distances[,inds[1,2]] <- NA # remove column (fill with NA), where minimum was found 
} 

# plot 1st set of points 
# print mean distance as measure for optimization 
plot(x1y1.data,col="blue",main="mean of min_distances",sub=mean(dist_min[,3],na.rm=TRUE))  
points(x2y2.data,col="red")       # plot 2nd set of points 
segments(dist_min[,4],dist_min[,5],dist_min[,6],dist_min[,7]) # connect pairwise according found minimal distance 

Answer 1

Jest to podstawowy problem w optymalizacji kombinatorycznej zwanej assignment problem. Jednym ze sposobów rozwiązania problemu przydziału jest Hungarian algorithm który jest realizowany w trop pakietu R:

require(clue) 
sol <- solve_LSAP(t(distances)) 

Możemy sprawdzić, czy wyprzedza naiwne rozwiązanie:

mean(dist_min[,3]) 
# [1] 0.05696033 
mean(sqrt(
    (x2y2.data[,1] - x1y1.data[sol, 1])^2 + 
    (x2y2.data[,2] - x1y1.data[sol, 2])^2)) 
#[1] 0.05194625 

I możemy skonstruować podobną działkę do tego w swoim pytaniu:

plot(x1y1.data,col="blue")  
points(x2y2.data,col="red") 
segments(x2y2.data[,1], x2y2.data[,2], x1y1.data[sol, 1], x1y1.data[sol, 2])