Sujet Précédent Sujet Suivant

Algorithme d'affectation de ressources et boucle

Baern Messages postés 5 Date d'inscription jeudi 20 décembre 2007 Statut Membre Dernière intervention 21 décembre 2007 - 20 déc. 2007 à 12:44
NHenry Messages postés 15117 Date d'inscription vendredi 14 mars 2003 Statut Modérateur Dernière intervention 10 mai 2024 - 21 déc. 2007 à 12:44
Bonjour,

Je suis étudiant et je dois réaliser un algorithme pour résoudre un problème de transport avec des contraintes d'exclusion.
Le problème se présente comme suit :

6 fournisseurs possèdent des stocks, ces fournisseurs doivent satisfaire la demande des 9 entrepôts (contraintes de stock et demande), à cause de restrictions légales, il n'est pas toujours possible de recevoir des marchandises de deux fournisseurs différents en même temps. Evidemment, l'envoi d'une unité de stock coûte, un coût qu'il me faut minimiser.

Dans le cadre du cours d'Advanced Operations Research, il me faut résoudre ce problème en utilisant une méthode de Simulated Annealing. La première chose à faire est donc de trouver une solution initiale qui satisfait à toutes les contraintes, ensuite il faudra l'améliorer en définissant un voisinage.

La première partie du problème pose problème actuellement. J'ai des tableaux de données sur une feuille excel que je récupère dans le code vba avec le code suivant:

Dim a
Dim b
Dim i
Dim j
Dim m
Dim l
Dim o
Dim p
Dim s




 





Const nbsup = 6
Const nbplant = 9
Const exclulig = 6
Const exclucol = 5
Const sep_plant1 = 4
Const sep_plant2 = 9




 



Dim numplant(nbplant) As Integer
For i = 1 To nbplant - 1
numplant(i) = Cells(1, 2 + i).Value
Next i



'Dim numplant2(nbplant) As Integer
'For j = 5 To sep_plant2
'numplant2(j) = Cells(1, 6 + j).Value
'Next j



Dim transquant(nbsup, nbplant) As Integer
For a = 1 To nbsup - 1
For b = 1 To nbplant - 1
transquant(a, b) = Cells(10 + a, 2 + b).Value
Next b
Next a



Dim vecteursup(nbsup) As Integer
For s = 1 To nbsup - 1
vecteursup(s) = Cells(10 + s, 13).Value
Next s



Dim vecteurplant(nbplant) As Integer
For j = 1 To nbplant - 1
vecteurplant(j) = Cells(10, 2 + j).Value
Next j



Dim exclu1(exclulig, exclucol) As Integer
For o = 1 To exclulig - 1
For p = o - 1 To exclucol - 1
exclu1(o, p) = Cells(20 + o, 1 + p).Value
Next p
Next o



Dim exclu2(exclulig, exclucol) As Integer
For l = 1 To exclulig - 1
For m = l - 1 To exclucol - 1
exclu2(l, m) = Cells(30 + l, 1 + m).Value
Next m
Next l



Ensuite, du fait que les entrepôts sont séparés en deux groupes, de 1 à 4 et de 5 à 9, je sépare le code en deux parties par un "if". Voici la première partie:

If (numplant(i) < 5) Then




 



    While (col_dem < 12)
    While (ligne_sup < 17)
   
   
   
    If (vecteursup(s) >= vecteurplant(j) And exclu1(o, p) <> 1 And vecteursup(s) > 0) Then



    transquant(a, b) = transquant(a, b) + vecteursup(s)
 
    vecteursup(s) = vecteursup(s) - vecteurplant(j)



    col_dem = col_dem + 1
    ligne_sup = ligne_sup + 1



    ElseIf (vecteursup(nbsup) < vecteurplant(nbplant) And exclu1(exclulig, exclucol) <> 1 And vecteursup(nbsup) > 0) Then
   
    transquant(nbsup, nbplant) = transquant(nbsup, nbplant) + vecteursup(nbsup)
    vecteursup(nbsup) = vecteursup(nbsup) - transquant(nbsup, nbplant)
   
    col_dem = col_dem + 1
    ligne_sup = ligne_sup + 1
        ElseIf ((vecteursup(nbsup) >vecteurplant(nbplant)) Or (vecteursup(nbsup) < vecteurplant(nbplant)) And exclu1(exclulig, exclucol) 1) Then
    ligne_sup = ligne_sup + 1
   
  
    End If
    Wend
    Wend


Les variables utilisées ont été définies au début du code :


Dim ligne_sup
Dim col_dem
ligne_sup = 11
col_dem = 3


La seconde partie (les entrepôts de 5 à 9) utilise le même code adapté pour utiliser exclu2 à la place de exclu1.

En faisant tourner ce code, la boucle sur les colonnes (col_dem) tourne à l'infini. Les lettres (a, b, i, ...) ne prennent que leur valeur maximale, à la place de démarrer avec la première valeur de la série, dois-je rajouter une boucle supplémentaire pour chaque lettre? Une dernière question, comment afficher, par exemple, la matrice transquant(a,b) dans la feuille excel? Rajouter .value ne semble pas fonctionner.

J'espère avoir été clair dans la description du problème, s'il vous faut la feuille excel avec les données, je vais voir comment la joindre à ce post.

Merci.

8 réponses

Réponse 1 / 8
NHenry Messages postés 15117 Date d'inscription vendredi 14 mars 2003 Statut Modérateur Dernière intervention 10 mai 2024 159
20 déc. 2007 à 13:38
Bonjour

Question : Est-ce du VB.NET, VB6 ou VBA ?

Ensuite, pourquoi avoir déclaré 9 variables pour les boucles, 2 auraient été largement suffisantes.

Donne des noms explicites à tes variables.

Pense bien à préciser le type de tes variables, évite :
Dim a
mais plutot :
Dim a as long
par exemple

pareil pour tes constantes :
const nbsup=6
devient
const nbsup as long = 6

Pour le bouclage infini, c'est, je pense, du au fait que tes 3 conditions (1 if et 2 elseif) ne sont jamais vraies ou que ton dernier elseif est vrai, mais tu ne touche pas à col_dem.

enfin une dernière remarque : à la place de While Wend utilise Do Loop, c'est plus courant à voir, et plus souple.

Balèse la personne qui a pensé au pansement à penser (ou à panser, pensée).
VB (6, .NET1&2), C++, C#.Net1
Mon site
0
Réponse 2 / 8
Baern Messages postés 5 Date d'inscription jeudi 20 décembre 2007 Statut Membre Dernière intervention 21 décembre 2007
20 déc. 2007 à 16:04
Je travaille en vba. J'ai modifié un peu le code en tenant compte de tes remarques pour les variables et les boucles, le revoici:


Sub solutioninit()


 



Dim ligne_sup As Integer
Dim col_dem As Integer



ligne_sup = 11
col_dem = 3





Dim i As Integer
Dim j As Integer



Const nbsup As Integer = 5 '-1 car matrice commence à 0
Const nbplant As Integer = 8 'idem
Const exclulig As Integer = 5 'idem
Const exclucol As Integer = 4 'idem
Const sep_plant1 As Integer = 4
Const sep_plant2 As Integer = 9




 



Dim numplant(nbplant) As Integer
For i = 0 To nbplant
numplant(i) = Cells(1, 3 + i).Value
Next i



'Dim numplant2(nbplant) As Integer
'For j = 5 To sep_plant2
'numplant2(j) = Cells(1, 6 + j).Value
'Next j



Dim transquant(nbsup, nbplant) As Integer
For i = 0 To nbsup
For j = 0 To nbplant
transquant(i, j) = Cells(11 + i, 3 + j).Value
Next j
Next i



Dim vecteursup(nbsup) As Integer
For i = 0 To nbsup
vecteursup(i) = Cells(11 + i, 13).Value
Next i



Dim vecteurplant(nbplant) As Integer
For j = 0 To nbplant
vecteurplant(j) = Cells(10, 3 + j).Value
Next j



Dim exclu1(exclulig, exclucol) As Integer
For i = 0 To exclulig
For j = 0 To exclucol
exclu1(i, j) = Cells(21 + i, 2 + j).Value
Next j
Next i



Dim exclu2(exclulig, exclucol) As Integer
For i = 0 To exclulig
For j = 0 To exclucol
exclu2(i, j) = Cells(31 + i, 2 + j).Value
Next j
Next i



Cells(1, 1).Value = vecteurplant(8)




 





If (numplant(nbplant) < 5) Then




 



Do
     
   
   
   If (vecteursup(nbsup) >= vecteurplant(nbplant) And exclu1(exclulig, exclucol) <> 1 And vecteursup(nbsup) > 0) Then



    transquant(nbsup, nbplant) = transquant(nbsup, nbplant) + vecteursup(nbsup)
    Cells(nbsup, nbplant).Value = transquant(nbsup, nbplant)
   
    vecteursup(nbsup) = vecteursup(nbspu) - vecteurplant(nbplant)
    Cells(nbsup, 13).Value = vecteursup(nbsup)
   
    col_dem = col_dem + 1
    ligne_sup = ligne_sup + 1



    ElseIf (vecteursup(nbsup) < vecteurplant(nbplant) And exclu1(exclulig, exclucol And vecteursup(nbsup) > 0) <> 1) Then
   
    transquant(nbsup, nnbplant) = transquant(nbsup, nbplant) + vecteursup(nbsup)
    Cells(nbsup, nbplant).Value = transquant(nbsup, nbplant)
   
    vecteursup(nbsup) = vecteursup(nbsup) - transquant(nbsup, nbplant)
    Cells(nbsup, 13).Value = vecteursup(nbsup)
   
    col_dem = col_dem + 1
    ligne_sup = ligne_sup + 1
        ElseIf ((vecteursup(nbsup) >vecteurplant(nbplant)) Or (vecteursup(nbsup) < vecteurplant(nbplant)) And exclu1(exclulig, exclucol) 1) Then
    ligne_sup = ligne_sup + 1
    col_dem = col_dem + 1
       
    End If



Loop Until (col_dem 11 And ligne_sup 16)
 





   
Else



Do
 
   
   
    If (vecteursup(nbsup) >= vecteurplant(nbplant) And exclu2(exclulig, exclucol) <> 1 And vecteursup(nbsup) > 0) Then



    transquant(nbsup, nbplant) = transquant(nbsup, nbplant) + vecteursup(nbsup)
    Cells(nbsup, nbplant).Value = transquant(nbsup, nbplant)
   
    vecteursup(nbsup) = vecteursup(nbsup) - vecteurplant(nbplant)
    Cells(nbsup, 13).Value = vecteursup(nbsup)
   
    col_dem = col_dem + 1
    ligne_sup = ligne_sup + 1



    ElseIf (vecteursup(nbsup) < vecteurplant(nbplant) And exclu2(exclulig, exclucol And vecteursup(nbsup) > 0) <> 1) Then
   
    transquant(nbsup, nnbplant) = transquant(nbsup, nbplant) + vecteursup(nbsup)
    Cells(nbsup, nbplant).Value = transquant(nbsup, nbplant)
   
    vecteursup(nbsup) = vecteursup(nbsup) - transquant(nbsup, nbplant)
    Cells(nbsup, 13).Value = vecteursup(nbsup)
   
    col_dem = col_dem + 1
    ligne_sup = ligne_sup + 1
        ElseIf ((vecteursup(nbsup) >vecteurplant(nbplant)) Or (vecteursup(nbsup) < vecteurplant(nbplant)) And exclu2(exclulig, exclucol) 1) Then
    ligne_sup = ligne_sup + 1
    col_dem = col_dem + 1
           
    End If



       



Loop Until (col_dem 11 And ligne_sup 16)
    
End If



End Sub



Les boucles sont toujours infinies... J'ai remarqué aussi que lorsque je lance le programme en le stoppant à If(numplant..., seulement les valeurs maximales des indices étaient utilisées.

Au cours du premier test,  je vérifie si l'entrepôt est du premier groupe ou du second, cela a comme conséquence d'envoyer à la première partie du code (le 1er do-loop) ou à la seconde, après Else.

Dans la boucle, le 1er test est pour vérifier si 1: le fournisseur a des stocks supérieurs à la demande 2: s'il n'y a pas de problème d'exclusion (en cas de plusieurs fournisseurs) et si le stock restant est supérieur à 0.

Si c'est ok, la quantité transportée doit s'afficher dans la feuille excel et le stock doit être diminué de la quantité expédiée. Passer ensuite à la ligne et colonne suivante.
Si les stocks<demande : expédier une partie du stock à l'entrepôt et réactualiser le stock restant. Passer ensuite à la ligne et colonne suivante.
Si contrainte d'exclusion rencontrée : Passer ensuite à la ligne et colonne suivante.
0
Réponse 3 / 8
NHenry Messages postés 15117 Date d'inscription vendredi 14 mars 2003 Statut Modérateur Dernière intervention 10 mai 2024 159
20 déc. 2007 à 16:26
Bonjour

Alors pourquoi avoir posté dans la catégorie VB.NET ? Erreur d'inatention sans doute.

Pour les indexs, c'est ormal, tu utilises les constantes nbsup et nbplan ...

Pour les bouclages infinis, c'est normal, si tes 3 consitions sont faussent, tu ne fais rien, même après 500 passages, elles seront toujours faussent !?

Dans les DO Loop (et contitions en général), évite les =, préfère plutot les <>, <=, >=, comme cela si tu saute une étape, tu n'aura aucun pb.

n'utilises les UNTIL que si c'est nécéssaire : Loop Until (col_dem 11 And ligne_sup 16)
devient :
Loop While col_dem <> 11 or ligne_sup <> 16

Donc là c'est facile de voir que si col_dem passe de 10 à 12, tu ne sortira jamais de ta boucle.

Balèse la personne qui a pensé au pansement à penser (ou à panser, pensée).
VB (6, .NET1&2), C++, C#.Net1
Mon site
0
Réponse 4 / 8
Baern Messages postés 5 Date d'inscription jeudi 20 décembre 2007 Statut Membre Dernière intervention 21 décembre 2007
20 déc. 2007 à 17:19
"Pour les indexs, c'est ormal, tu utilises les constantes nbsup et nbplan ..."

je mets les i et j alors? Faut-il que je rajoute quelque chose d'autre?

"Alors pourquoi avoir posté dans la catégorie VB.NET ? Erreur d'inatention sans doute."

oops désolé je pensais être dans la bonne catégorie, si un modérateur sait déplacer ce post...
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
Réponse 5 / 8
NHenry Messages postés 15117 Date d'inscription vendredi 14 mars 2003 Statut Modérateur Dernière intervention 10 mai 2024 159
21 déc. 2007 à 08:39
Bonjour

Comment veux-tu faire ton analyse :
- A chaque iteration, on passe à l'élément suivant
- Autre
?

Si c'est le premier points, tu peux utiliser 2 for imbriqués, et pour sortir un If, par exemple.

Balèse la personne qui a pensé au pansement à penser (ou à panser, pensée).
VB (6, .NET1&2), C++, C#.Net1
Mon site
0
Réponse 6 / 8
Baern Messages postés 5 Date d'inscription jeudi 20 décembre 2007 Statut Membre Dernière intervention 21 décembre 2007
21 déc. 2007 à 11:02
Salut,

Je veux faire en sorte que le programme vérifie, tout d'abord, si le premier fournisseur sait toute satisfaire la demande du premier entrepôt (ce que j'essaye de faire avec le premier test). Si c'est le cas, conserver les valeurs expédiées et restantes dans des compteurs (transquant et vecteursup) Sinon, passer à la ligne suivante pour voir si le second fournisseur sait satisfaire la demande intégrale. Si le test réussi, passer à la colonne suivante (col_dem) (elle reprend la demande du 2ème entrepôt).

Je vois bien qu'il y a un problème de logique dans ce test, ça fait bien longtemps que je n'avais plus rien programmé. ;-)
Je m'y remets aujourd'hui en revoyant les tests, en tout cas, merci pour ton aide.
0
Réponse 7 / 8
Baern Messages postés 5 Date d'inscription jeudi 20 décembre 2007 Statut Membre Dernière intervention 21 décembre 2007
21 déc. 2007 à 12:30
Ca fonctionne! J'ai retouché les tests et les boucles et le programme tourne correctement! Voici ce que j'ai désormais :

Sub solutioninit()




 



Dim ligne_sup As Integer
Dim col_dem As Integer
Dim quant_trans As Single
Dim cout As Double



ligne_sup = 11
col_dem = 3





Dim i As Integer
Dim j As Integer
Dim o As Integer
Dim p As Integer



Const nbsup As Integer = 5 '-1 car matrice commence à 0
Const nbplant As Integer = 8 'idem
Const exclulig As Integer = 5 'idem
Const exclucol As Integer = 4 'idem
Const sep_plant1 As Integer = 4
Const sep_plant2 As Integer = 9




 



Dim numplant(nbplant) As Integer
For i = 0 To nbplant
numplant(i) = Cells(1, 3 + i).Value
Next i



'Dim numplant2(nbplant) As Integer
'For j = 5 To sep_plant2
'numplant2(j) = Cells(1, 6 + j).Value
'Next j



Dim transquant(nbsup, nbplant) As Integer
For i = 0 To nbsup
For j = 0 To nbplant
transquant(i, j) = Cells(11 + i, 3 + j).Value
Next j
Next i



Dim vecteursup(nbsup) As Integer
For i = 0 To nbsup
vecteursup(i) = Cells(11 + i, 13).Value
Next i



Dim vecteurplant(nbplant) As Integer
For j = 0 To nbplant
vecteurplant(j) = Cells(10, 3 + j).Value
Next j



Dim exclu1(exclulig, exclucol) As Integer
For o = 0 To exclulig
For p = 0 To exclucol
exclu1(o, p) = Cells(21 + o, 2 + p).Value
Next p
Next o



Dim exclu2(exclulig, exclucol) As Integer
For o = 0 To exclulig
For p = 0 To exclucol
exclu2(o, p) = Cells(31 + o, 2 + p).Value
Next p
Next o



Dim transcost(nbsup, nbplant) As Integer
For i = 0 To nbsup
For j = 0 To nbplant
transcost(i, j) = Cells(3 + i, 3 + j).Value
Next j
Next i





Cells(1, 1).Value = transcost(0, 0)




 



For i = 0 To nbsup
For j = 0 To nbplant
For o = 0 To exclulig
For p = 0 To exclucol





If (numplant(i) < 5) Then





'transquant : mettre référence cellules avec les i,j et col, lignes!
Do
   
   If (vecteursup(i) >= vecteurplant(j) And exclu1(o, p) <> 1 And vecteursup(i) > 0) Then
   
   
    transquant(i, j) = transquant(i, j) + vecteurplant(j)
    Cells(11 + i, 3 + j).Value = transquant(i, j)
   
    vecteursup(i) = vecteursup(i) - vecteurplant(j)
    Cells(11 + i, 13).Value = vecteursup(i)
   
    j = j + 1
    col_dem = col_dem + 1
  
   
   
    ElseIf ((vecteursup(i) < vecteurplant(j)) Or exclu1(o, p) = 1) Then
   
Satis_dem1:
   
    ligne_sup = ligne_sup + 1
    i = i + 1
   
        If (vecteursup(i) >= vecteurplant(j)) Then
        transquant(i, j) = transquant(i, j) + vecteurplant(j)
        Cells(11 + i, 3 + j).Value = transquant(i, j)
   
        vecteursup(i) = vecteursup(i) - vecteurplant(j)
        Cells(11 + i, 13).Value = vecteursup(i)
   
        j = j + 1
        col_dem = col_dem + 1
        Else
        GoTo Satis_dem1
          
        End If
    End If
Loop While (col_dem <= 11)
 
       
 
Else
   
    Do
     
   
   
   If (vecteursup(i) >= vecteurplant(j) And exclu2(o, p) <> 1 And vecteursup(i) > 0) Then



    transquant(i, j) = transquant(i, j) + vecteurplant(j)
    Cells(11 + i, 3 + j).Value = transquant(i, j)
   
    vecteursup(i) = vecteursup(i) - vecteurplant(j)
    Cells(11 + i, 13).Value = vecteursup(i)
   
    j = j + 1
    col_dem = col_dem + 1
  
   
   
    ElseIf ((vecteursup(i) < vecteurplant(j)) Or exclu2(o, p) = 1) Then
   
Satis_dem2:
   
    ligne_sup = ligne_sup + 1
    i = i + 1
   
        If (vecteursup(i) >= vecteurplant(j)) Then
        transquant(i, j) = transquant(i, j) + vecteurplant(j)
        Cells(11 + i, 3 + j).Value = transquant(i, j)
   
        vecteursup(i) = vecteursup(i) - vecteurplant(j)
        Cells(11 + i, 13).Value = vecteursup(i)
   
        j = j + 1
        col_dem = col_dem + 1
        Else
        GoTo Satis_dem2
       
        End If
     End If
    
Loop While (col_dem <= 11)
  
   
   
   
   
End If



Next p
Next o
Next j
Next i



For i = 0 To nbsup
For j = 0 To nbplant
cout = Sum(transcost(i, j) * transquant(i, j))
Next j
Next i



Cells(17, 16).Value = cout



End Sub



Une dernière chose, comment faire pour que la ligne en rouge fonctionne? La variable cout doit faire la somme des produits des coûts unitaires et des quantités expédiées. Les deux tableaux ayant la même taille.
0
Réponse 8 / 8
NHenry Messages postés 15117 Date d'inscription vendredi 14 mars 2003 Statut Modérateur Dernière intervention 10 mai 2024 159
21 déc. 2007 à 12:44
Bonjour

For i = 0 To nbsup
For j = 0 To nbplant
cout = Sum(transcost(i, j) * transquant(i, j))
Next j
Next i

cout=0
For i = 0 To nbsup
For j = 0 To nbplant
cout = cout+ transcost(i, j) * transquant(i, j)
Next j
Next i

Si j'ai bien compri, ça doit fonctionner.

Balèse la personne qui a pensé au pansement à penser (ou à panser, pensée).
VB (6, .NET1&2), C++, C#.Net1
Mon site
0

Discussions similaires

Cherche algorithme Affectations de groupes dans des salles
Kotomine -
ismail55 -

1 réponse
Algorithme de vérification RIB (24 chiffres / maroc)
aedc -
ucfoutu -

5 réponses
recherche d'un code ou de l'algorithme
mohamedbzeouich -
Patalou -

2 réponses
conversion algorithme en code vba
tash84200 -
xalara -

3 réponses
[VBA / macro excel] remise à vide de cellules à chaque début de mois.
cs_hazzel -
ucfoutu -

18 réponses
Rejoignez-nous