XL 2019 Distribution de valeurs équitables

[Schaeffer40]

Bonjour à tous,
Je viens chercher votre aide pour concevoir une fiche excel particulière,

Dans un jeu nous sommes 2 joueurs et essayons de partager équitablement des objets de puissances différentes (indivisibles) pour être tous deux de puissances équivalentes.
J'ai essayé Kutools et le solveur pour l'instant sans succès car j'ai des variables à prendre en compte :

- Nous sommes 2 joueurs
- Nous pouvons porter au maximum 7 objets
- Nous avons une 30ène d'objets de puissances allant de 250 à 5, une grande diversité donc difficile à équilibrer
- On essaye d'obtenir le maximum de puissance pour les 2 joueurs au plus équitable

Avez-vous des idées ?
Merci d'avance !!

 

[sylvanu]

Bonjour Schaeffer, et bienvenu sur XLD,
vous n'auriez pas un petit fichier test ?
Ce serait plus simple, et l'éventuelle solution serait directement applicable à votre projet.
Question : Peux t-on utiliser le VBA ?

 

[Schaeffer40]

Salut Sylvanu ! Merci de ta réponse,
Voici mon fichier, il n'y a aucune formule intéressante encore, mais la liste des objets y es.
Bien sûr, pas de soucis avec le VBA, je devrais pouvoir le modifier si besoin.

 

[sylvanu]

Re,
Un essai en PJ en distribuant une carte alternativement à chaque joueur puis en commutant carte par carte pour converger vers une différence nulle.

 

[Schaeffer40]

Pardonne mon retard j'ai besoin de m'absenter du PC régulièrement.

Beau travail merci Sylvanu, on y es presque je vois ce que tu dis, il reste la problèmatique du nombre maximum d'objets à porter en même temps, ton code fonctionne pour utiliser toute la liste, il n'est possible de porter jusqu'à 7 objets, éventuellement cette variable pourrais changer, il faudra que je la rende modifiable...

Je cherchais avec Kutool avec la fonction composer un numéro, permettant de sélectionner un nombre d'éléments, mais cet outil est tellement long pour ne rien donner, aurais-tu une équivalence sur ton code VBA ?

 

[sylvanu]

Je ne connais Kutool que de nom, donc c'est un point sur lequel je ne peux pas vous être d'un grand secours.
Pour le premier point, ça m'avais échappé, et ça complique sérieusement le problème. A voir.

 

[Schaeffer40]

Pas de soucis, je connais pas Kutool plus que ça j'ai seulement essayé l'option vue sur un tuto.
Oui je me doutais aussi que ça serai difficile, avoir plusieurs variables permettrais d'affiner une égalité pour les deux joueurs en portant 7 objets ou moins..

En attendant super boulot pour ton code, je peux toujours retirer les 14+ de la liste de Feuil1.
Si jamais vous avez du nouveau sur ma problématique n'hésitez pas, j'aimerai beaucoup trouver un moyen d'incorporer cette limite d'objet par rapport au "stock" possible

 

[sylvanu]

Il y a la solution de "bourrin". Voir PJ.
On laisse l'aléatoire faire, et le résultat semble assez probant.
On met en K2 le nombre de cartes par joueur, et en K3 le temps de calcul max désiré.

 

[Schaeffer40]

Effectivement l'égalité est à peu près respecté par l'aléatoire, merci.
Faut voir pour réussir à combiner les deux methodes, ou bien imposer les 10 premiers objets pour la distribution afin d'obtenir le maximum de puissance pour les deux joueurs

 

[sylvanu]

Re, bonsoir dysorthographie,

bien imposer les 10 premiers objets pour la distribution afin d'obtenir le maximum de puissance

A un moment le nombre de contraintes deviendra trop grand pour être soluble.

 

[dysorthographie]

Re bonjour,
j'ais supprimer mon poste erreur de fichier

salut sylvanu

 

[sylvanu]

Re tout le monde,
@dysorthographie, je me suis permis.
Comme la macro de dysorthographie est très rapide, alors on peut boucler un certain nombre de fois et ne retenir que la configuration qui se rapproche le plus du max. Juste en rajoutant une petite couche d'itérations.
Avec 100 itérations on arrive de l'ordre de 80% du max, ce qui n'est pas si mal.
@Schaeffer, C'est encore une piste. Avec tous ces outils vous devriez converger.

 

[dysorthographie]

on peut favoriser les Pet power (B) max en ajoutant ue primo filtre!

'on ajoute une valeur Min pour filtrer sur ORDER pour favoriser les {Pet power (B)} les plus élevé!
Min = 4
For I = 1 To 7
Obj.Filter = "Order<=" & Min
Obj.Move Int(Obj.RecordCount * Rnd)

DoEvents
Min = Min + 5
Next

End Sub 
Sub Donne()
Dim H  As Integer, Min As Integer
Dim Obj As Object: Set Obj = CreateObject("ADODB.Recordset")
Obj.Fields.Append "Order", adInteger, 4
Obj.Fields.Append "Name", adChar, 50
Obj.Fields.Append "Power", adDouble, 18.4
Obj.Open
Dim Joueur As Object:  Set Joueur = CreateObject("ADODB.Recordset")
Joueur.Fields.Append "Order", adInteger, 4
Joueur.Fields.Append "Name", adChar, 50
Joueur.Fields.Append "Power", adDouble, 18.4
Joueur.Fields.Append "Joueur", adInteger, 4
Joueur.Open
With Sheets("Feuil1").Range("A2").CurrentRegion
    For I = 2 To .Rows.Count
        If Trim("" & .Cells(I, "B")) <> "" Then
        Obj.AddNew
            Obj("Order") = .Cells(I, "A")
            Obj("Name") = .Cells(I, "B")
            Debug.Print Format(.Cells(I, "C"), "#0.000")
          
            Obj("Power") = .Cells(I, "C")
            Obj.Update
        End If
    Next
    End With
Debug.Print Obj.RecordCount
Obj.MoveFirst
Randomize (Split(Format(Timer, "0.000"), ",")(1))
'on ajoute une valeur Min pour filtrer sur ORDER 9a favorise les Pet power (B) les plus elevé!
Min = 4
For I = 1 To 7
Obj.Filter = "Order<=" & Min
    Obj.Move Int(Obj.RecordCount * Rnd)
    Joueur.AddNew
    Joueur("Order") = Obj("Order")
    Joueur("Name") = Obj("Name")
    Joueur("Power") = Obj("Power")
    Joueur("Order") = Obj("Order")
    Joueur("Joueur") = "1"
    Joueur.Update
    P = Split(Obj("Power"), ",")(0)
     H = 4.12201154163232E-02 * Obj("Power")
            If H < 1 Then H = 1
    Obj.Delete
    Obj.Update
    Obj.Filter = "Power>=" & (P - H) & " AND Power<=" & (P + H)
    While Obj.EOF
        Obj.Filter = "Power>=" & (P - H) & " AND Power<=" & (P + H)
        H = H + 1
    Wend
    
 Obj.MoveFirst
 Obj.Move Int(Obj.RecordCount * Rnd)
    Joueur.AddNew
    Joueur("Order") = Obj("Order")
    Joueur("Name") = Obj("Name")
    Joueur("Power") = Obj("Power")
    Joueur("Order") = Obj("Order")
    Joueur("Joueur") = 2
    Joueur.Update
    Obj.Delete
    Obj.Update
    Obj.Filter = ""
    Obj.MoveFirst
    Joueur.MoveFirst
    DoEvents
    Min = Min + 5
Next
Joueur.Sort = "Order"
With Sheets("Analyse")
    .Range("A2").CopyFromRecordset Joueur
    .Range(.Range("D2"), .Cells(.Rows.Count, "D").End(xlUp)).NumberFormat = """JOUEUR"" 0"
End With

End Sub

 

[eriiic]

Bonjour à tous,

une question me taraude...
Qu'est-ce qui prime le plus ?
L'égalité parfaite ou plus de puissance ?
On peut imaginer que l'égalité parfaite soit 1000/1000 mais qu'il y ait une autre solution 1500/1503.
L'écart maxi souhaité est vraiment le plus proche de 0 ?
eric

 

[Schaeffer40]

Rebonsoir à tous,
Je pensais exactement à la même chose Sylvanu sur un nombre d'itération sauf que je ne sais pas m'y prendre, en tout cas c'est une solution sûrement proche du but !

Dysorthographie travail incroyable, pour le coup on conserve une excellente équité en cherchant le meilleur résultat, j'ai implémenté ton tronçon de code pour conserver une valeur Min, cependant je ne dois pas bien m'y prendre, je pensais qu'en ramenant la valeur Min à 12 et plus ça permettrant d'avoir un optimum plus élevé mais ce n'est pas le cas, on est sur la bonne voie.

Salut Eriic, je dirai que la puissance prime le plus comparé à une égalité parfaite, un résultat avoisinant les 85-90% avec par exemple 850/858 me conviendrais très bien.

Au plaisir, merci à tous de vous pencher sur mon problème, la solution se rapproche