У вас есть набор из N = 400 объектов, каждый из которых имеет свои собственные координаты, скажем, в 19-мерном пространстве.
Вы вычисляете (евклидову) матрицу расстояний (все попарные расстояния).
Теперь вы хотите выбрать n = 50 объектов, чтобы сумма всех парных расстояний между выбранными объектами была максимальной.
Я придумал способ решить эту проблему с помощью линейного программирования (код ниже, для меньшего примера), но он кажется мне неэффективным, потому что я использую N * (N-1) / 2 двоичных переменных, соответствующих всем не избыточные элементы матрицы расстояний, а затем множество ограничений для обеспечения самосогласованности вектора решения.
Я подозреваю, что должен быть более простой подход, где используются только N переменных, но я не могу сразу думать об одной.
В этом посте кратко упоминается некоторый алгоритм Брон-Кербоша, который, очевидно, рассматривает часть суммы расстояний.
Но в этом примере сумма расстояний является конкретным числом, поэтому я не вижу прямого применения к моему делу.
Я кратко рассмотрел квадратичное программирование, но опять-таки не смог увидеть непосредственную параллель с моим случаем, хотя матрица 'b% *% bT', где b - вектор двоичного решения (столбца), теоретически мог использоваться для умножения матрицы расстояний и т. д .; но я действительно не знаком с этой техникой.
Может ли кто-нибудь посоветовать (/ указать мне на другие посты объяснения), если и как можно решить эту проблему путем линейного программирования с использованием только N двоичных переменных?
Или дать какой-нибудь другой совет о том, как решить проблему более эффективно?
Спасибо!
PS: вот код, который я упоминал выше.
require(Matrix)
#distmat defined manually for this example as a sparseMatrix
distmat <- sparseMatrix(i=c(rep(1,4),rep(2,3),rep(3,2),rep(4,1)),j=c(2:5,3:5,4:5,5:5),x=c(0.3,0.2,0.9,0.5,0.1,0.8,0.75,0.6,0.6,0.15))
N = 5
n = 3
distmat_summary <- summary(distmat)
distmat_summary["ID"] <- 1:NROW(distmat_summary)
i.mat <- xtabs(~i+ID,distmat_summary,sparse=T)
j.mat <- xtabs(~j+ID,distmat_summary,sparse=T)
ij.mat <- rbind(i.mat,"5"=rep(0,10))+rbind("1"=rep(0,10),j.mat)
ij.mat.rowSums <- rowSums(ij.mat)
ij.diag.mat <- .sparseDiagonal(n=length(ij.mat.rowSums),-ij.mat.rowSums)
colnames(ij.diag.mat) <- dimnames(ij.mat)[[1]]
mat <- rbind(cbind(ij.mat,ij.diag.mat),cbind(ij.mat,ij.diag.mat),c(rep(0,NCOL(ij.mat)),rep(1,NROW(ij.mat)) ))
dir <- c(rep("<=",NROW(ij.mat)),rep(">=",NROW(ij.mat)),"==")
rhs <- c(rep(0,NROW(ij.mat)),1-unname(ij.mat.rowSums),n)
obj <- xtabs(x~ID,distmat_summary)
obj <- c(obj,setNames(rep(0, NROW(ij.mat)), dimnames(ij.mat)[[1]]))
if (length(find.package(package="Rsymphony",quiet=TRUE))==0) install.packages("Rsymphony")
require(Rsymphony)
LP.sol <- Rsymphony_solve_LP(obj,mat,dir,rhs,types="B",max=TRUE)
items.sol <- (names(obj)[(1+NCOL(ij.mat)):(NCOL(ij.mat)+NROW(ij.mat))])[as.logical(LP.sol$solution[(1+NCOL(ij.mat)):(NCOL(ij.mat)+NROW(ij.mat))])]
items.sol
ID.sol <- names(obj)[1:NCOL(ij.mat)][as.logical(LP.sol$solution[1:NCOL(ij.mat)])]
as.data.frame(distmat_summary[distmat_summary$ID %in% ID.sol,])