R: LPsolve (lineare Programmierung) mit "fehlenden Werten"

Question

Ich versuche, LP in R (LPsolve) auszuführen, aber wo eine meiner Kombinationen nie passieren sollte. Wenn ich zum Beispiel versuche, Männer und Frauen (nicht Menschen :-)) zu paaren, um einen Funktionswert zu maximieren (Matrix, die unten "Rang" genannt wird). Einer der Männchen ist jedoch ein Vollbruder zu einem der Weibchen, also möchte ich nicht, dass diese Paarung überhaupt jemals stattfindet (sagen Sie Männchen 1 & Weibchen 1 in der Matrix unten). Ich möchte, dass alle Weibchen gepaart sind (d. H. Eine Einschränkung) und ich möchte, dass alle Männchen 2 und nur 2 Paarungen haben (eine weitere Einschränkung). Ich habe versucht, die [1,1] Paarung wirklich negativ zu machen, und das kann helfen, aber ich möchte, dass es narrensicher ist. Ich habe versucht, NA, NULL usw. aber nicht in Anspruch zu nehmen. Vielen Dank im Voraus

rank <- matrix (0,3, 6) # matrix of males (rows) x females (columns) with the value to maximize for each combination 

for (i in 1:3) { 
for (j in 1:6) 
    { 
    rank[i,j] <-i*j 
    } 
} 


m <- NROW(rank) #number of males 
f <- NCOL(rank) # number of females 

row.signs <- c(rep("=", m)) 
row.rhs <- c(rep(2,m)) 
col.signs <- rep ("=", f) 
col.rhs <- c(rep(1,f)) 

lp.transport (rank, "max", row.signs, row.rhs, col.signs, col.rhs)$solution 

Answer 1

Ich glaube nicht, dass Sie Constraint definieren können die Standardtransportproblem Formulierung mit ... Ich schlage vor, Sie das Transportproblem mit der Hand zu definieren und dann Ausschlüsse Einschränkung hinzufügen:

library(lpSolve) 
m <- 3 # n of males 
f <- 6 # n of females 
# rank matrix 
rank <- matrix(1:(m*f),nrow=m) 
# sibling exclusions (where the matrix is 1, we don't allow mating for that combination) 
# here we block male 1 with female 1 
exclusions <- matrix(0,nrow=m,ncol=f) 
exclusions[1,1] <- 1 
# transportation problem definition 
obj <- as.numeric(rank) 
nMalePerFemaleRhs <- rep(1,f) 
nMalePerFemaleSign <- rep("=",f) 
nMalePerFemaleConstr <- matrix(0,nrow=f,ncol=m*f) 
for(i in 1:f){ 
    nMalePerFemaleConstr[i,(i-1)*m+(1:m)] <- 1 
} 
nFemalePerMaleRhs <- rep(2,m) 
nFemalePerMaleSign <- rep("=",m) 
nFemalePerMaleConstr <- matrix(0,nrow=m,ncol=m*f) 
for(i in 1:m){ 
    nFemalePerMaleConstr[i,seq(from=i,length.out=f,by=m)] <- 1 
} 
# sibling exclusions constraint 
siblingConstr <- t(as.numeric(exclusions)) 
siblingRhs <- 0 
siblingSign <- '=' 

res <- lp(direction='max', 
      objective.in=obj, 
      const.mat = rbind(nMalePerFemaleConstr,nFemalePerMaleConstr,siblingConstr), 
      const.dir = c(nMalePerFemaleSign,nFemalePerMaleSign,siblingSign), 
      const.rhs = c(nMalePerFemaleRhs,nFemalePerMaleRhs,siblingRhs), 
      all.int = TRUE 
     ) 
solutionMx <- matrix(res$solution,nrow=m) 

Ergebnis:

> solutionMx 
    [,1] [,2] [,3] [,4] [,5] [,6] 
[1,] 0 0 0 0 1 1 
[2,] 0 0 1 1 0 0 
[3,] 1 1 0 0 0 0