Problème combinatoire : 10 équipes et 15 jeux

library(lpSolve)

# parametres
n.jeux<-15
n.tours<-15
n.equipes<-10
n.paires<-n.equipes*(n.equipes-1)/2
d<-n.jeux*n.tours*n.paires

# DEFINITION ET REMPLISSAGE DES MATRICES
paire2equipe<-matrix(0,n.paires,2)
indexation<-matrix(0,d,3)

# la ligne i de paire2equipe correspond
# aux deux equipes (dans 1,n.equipes) de la paire i
cpt<-1
for (i in 1:(n.equipes-1)){
  for (j in (i+1):n.equipes){
    paire2equipe[cpt,]<-c(i,j)
    cpt<-cpt+1
  }
}

# chaque ligne de indexation correspond
# a un tour, un jeu et une paire
cpt<-1
for (i in 1:n.tours){
  for (j in 1:n.jeux){
    for (k in 1:n.paires){
      indexation[cpt,]<-c(i,j,k)
      cpt<-cpt+1
    }
  }
}

# LISTES POUR FAIRE LE LIEN AVEC LA MATRICE INDEXATION
# double liste pour faire le lien avec la matrice indexation
# la premiere liste contient un tour i
# la deuxieme liste contient, pour le tour i considere, le jeu j
# les 45 fois (n.paires) ou apparaissent le tour i et le jeu j sont dans la liste
tour.jeu.constant<-vector("list",n.tours)
for (i in 1:n.tours){
  tour.jeu.constant[[i]]<-vector("list",n.jeux)
  for (j in 1:n.jeux){
    tour.jeu.constant[[i]][[j]]<-which(indexation[,1]==i & indexation[,2]==j)
  }
}

# liste qui contient les indices de indexation correspondant au meme tour
tour.constant<-vector("list",n.tours)
for (i in 1:n.tours){
  tour.constant[[i]]<-which(indexation[,1]==i)
}

# liste qui contient les indices de indexation correspondant au meme match
paire.constante<-vector("list",n.paires)
for (i in 1:n.paires) paire.constante[[i]]<-which(indexation[,3]==i)

# liste qui contient les indices de indexation correspondant a une equipe donnee
equipe.constante<-vector("list",n.equipes)
for (i in 1:n.equipes){
  dans.paire<-which(paire2equipe[,1]==i | paire2equipe[,2]==i)
  equipe.constante[[i]]<-which(indexation[,3]%in%dans.paire)
}

# DEFINITION DES CONTRAINTES
# a chaque tour, chaque jeu est occupe au plus une fois
contrainte.un.jeu.par.tour<-matrix(0,n.tours*n.jeux,d)
for (i in 1:(n.tours*n.jeux)){
  div<-(i-1)%/%n.jeux+1
  reste<-(i-1)%%n.jeux+1
  contrainte.un.jeu.par.tour[i,tour.jeu.constant[[div]][[reste]]]<-1
}
rhs.un.jeu.par.tour<-rep(1,n.tours*n.jeux)
dir.un.jeu.par.tour<-rep("<=",n.tours*n.jeux)

# a chaque tour, 5 jeux sont occupes
contrainte.chaque.tour<-matrix(0,n.tours,d)
for (i in 1:n.tours) contrainte.chaque.tour[i,tour.constant[[i]]]<-1
rhs.chaque.tour<-rep(5,n.tours)
dir.chaque.tour<-rep("==",n.tours)

# on retrouve soit une fois, soit deux fois chaque paire
contrainte.rencontres.entre.paires<-matrix(0,2*n.paires,d)
for (i in 1:n.paires) contrainte.rencontres.entre.paires[c(i,i+n.paires),paire.constante[[i]]]<-1
rhs.rencontres.entre.paires<-c(rep(1,n.paires),rep(2,n.paires))
dir.rencontres.entre.paires<-c(rep(">=",n.paires),rep("<=",n.paires))

# chaque equipe joue exactement une fois a chaque jeu
contrainte.chaque.equipe.chaque.jeu<-matrix(0,n.equipes,d)
for (i in 1:n.equipes) contrainte.chaque.equipe.chaque.jeu[i,equipe.constante[[i]]]<-1
rhs.chaque.equipe<-rep(1,n.equipes)
dir.chaque.equipe<-rep("==",n.equipes)


# Programme LP a resoudre
# On concatene les matrices, directions et rhs de contraintes
# Ajout de la contrainte "il y a 75 rencontres en tout"
const.mat<-do.call(rbind,list(contrainte.un.jeu.par.tour,contrainte.chaque.tour,contrainte.rencontres.entre.paires,contrainte.chaque.equipe.chaque.jeu,matrix(1,1,d)))
const.dir<-c(dir.un.jeu.par.tour,dir.chaque.tour,dir.rencontres.entre.paires,dir.chaque.equipe,"==")
const.rhs<-c(rhs.un.jeu.par.tour,rhs.chaque.tour,rhs.rencontres.entre.paires,rhs.chaque.equipe,n.tours*n.equipes/2)
sol<-lp(direction="min",objective.in=rep(1,d),const.mat=const.mat,const.dir=const.dir,const.rhs=const.rhs,all.bin=TRUE)