1. Ce site utilise des "témoins de connexion" (cookies) conformes aux textes de l'Union Européenne. Continuer à naviguer sur nos pages vaut acceptation de notre règlement en la matière. En savoir plus.

XL 2016 Rotation

Discussion dans 'Forum Excel' démarrée par NOUVEL, 8 Novembre 2017.

  1. Modeste geedee

    Modeste geedee XLDnaute Barbatruc

    Inscrit depuis le :
    8 Mars 2012
    Messages :
    5894
    "J'aime" reçus :
    705
    Sexe :
    Masculin
    Habite à:
    50.3257, 3.2486
    Utilise:
    Excel 2007 (PC)
    Bonsour®
    le fait que la macro liste tout les arrangements possibles sans doublons pour une personne rencontrant chaque autre personne une et une seule fois est par construction exhaustive ( i.e. il n'y en a pas d'autres, tout autre arrangement produira un doublon)
    il suffit alors d'affecter aléatoirement les noms à chaque numéro :rolleyes:
    piece jointe sur la base de la macro de Kendev
     

    Pièces jointes:

  2. job75

    job75 XLDnaute Barbatruc

    Inscrit depuis le :
    15 Mai 2008
    Messages :
    23263
    "J'aime" reçus :
    1735
    Sexe :
    Masculin
    Habite à:
    Paris
    Utilise:
    Excel 2013 (PC)
    Bonsoir tout le monde,

    Ce qu'il faut bien comprendre c'est que le 1er tour sert à ranger les 49 joueurs dans l'ordre, donc forcément sans doublon de paires.

    Ensuite les 7 tours suivants déplacent les joueurs de manière astucieuse pour éviter les doublons de paires et donc aboutir à la solution unique.

    Moi ce que j'aimerais savoir c'est si KenDev a (re)trouvé cette solution PAR LUI-MÊME, sinon qu'il nous dise il l'a trouvée.

    Je ne serais pas étonné qu'un génie comme Blaise Pascal (1623-1662) qui s'intéressait aux joueurs et aux jeux de hasard ait trouvé cette manière de faire.

    A+
     
  3. Magic_Doctor

    Magic_Doctor XLDnaute Accro

    Inscrit depuis le :
    2 Juin 2005
    Messages :
    1910
    "J'aime" reçus :
    17
    Habite à:
    Montevideo
    Utilise:
    Excel 2007 (PC)
    Et... "Dans le doute, mieux vaut croire" [Raymond Poulidor]
     
  4. job75

    job75 XLDnaute Barbatruc

    Inscrit depuis le :
    15 Mai 2008
    Messages :
    23263
    "J'aime" reçus :
    1735
    Sexe :
    Masculin
    Habite à:
    Paris
    Utilise:
    Excel 2013 (PC)
    Rebonsoir Magic_Doctor,

    Ben là tu pollues non ?
     
  5. KenDev

    KenDev XLDnaute Impliqué

    Inscrit depuis le :
    22 Janvier 2011
    Messages :
    638
    "J'aime" reçus :
    28
    Utilise:
    Excel 2007 (PC)
    Bonsoir à tous,

    @job75,

    J'ai trouvé cette méthode FAUSSE par moi même oui, n'est pas Blaise Pascal qui veut... La méthode ne fonctionne en effet que dans les cas ou le nombre de tables est un nombre premier ce qui est le cas du 7 demandé, et par un hasard(?) amusant, également le cas des quelques nombres que j'ai utilisé pour vérifier cette macro...

    Le post précédent s'en trouve modifié.

    Cordialement
    KD
     
  6. job75

    job75 XLDnaute Barbatruc

    Inscrit depuis le :
    15 Mai 2008
    Messages :
    23263
    "J'aime" reçus :
    1735
    Sexe :
    Masculin
    Habite à:
    Paris
    Utilise:
    Excel 2013 (PC)
    Bonjour le forum,

    Eh bien un grand bravo KenDev, j'ai ajouté la vérification des paires uniques créées :
    Code (Text):
    Sub aaa()
      Call bbb(7)
    End Sub

    Sub bbb(ByVal n&)
      Dim a%(), i%, j%, k%, b%, t, d As Object
      If n < 2 Then Exit Sub
      ReDim a(1 To n + 1, 1 To n, 1 To n)
      For i = 1 To n: For j = 1 To n: a(1, i, j) = n * (i - 1) + j: a(2, i, j) = n * (j - 1) + i: Next j, i
      For k = 3 To n + 1: For i = 1 To n: For j = 1 To n: b = i + (j - 1): b = b + n * (b > n): a(k, i, j) = a(k - 1, b, j): Next j, i, k
      Sheets.Add
      For k = 1 To n + 1: Cells((k - 1) * n + 1, 1) = "Tour " & k: For i = 1 To n: For j = 1 To n: Cells((k - 1) * n + i, j + 1) = a(k, i, j): Next j, i, k
      Cells.EntireColumn.AutoFit
      '---vérification---
      t = Cells(1, 2).Resize(n * (n + 1), n)
      Set d = CreateObject("Scripting.Dictionary")
      For i = 1 To UBound(t): For j = 1 To n - 1: For k = j + 1 To n: d(t(i, j) & " " & t(i, k)) = "": Next k, j, i
      MsgBox "Nombre de paires uniques créées : " & d.Count & " sur " & n * n * (n * n - 1) / 2
    End Sub
    Bonne journée.
     
  7. job75

    job75 XLDnaute Barbatruc

    Inscrit depuis le :
    15 Mai 2008
    Messages :
    23263
    "J'aime" reçus :
    1735
    Sexe :
    Masculin
    Habite à:
    Paris
    Utilise:
    Excel 2013 (PC)
    Re,

    On peut analyser les doublons :
    Code (Text):
    Sub aaa()
      Call bbb(15)
    End Sub

    Sub bbb(ByVal n&)
      Dim a%(), i%, j%, k%, b%, t, d As Object, x$, t1
      If n < 2 Then Exit Sub
      ReDim a(1 To n + 1, 1 To n, 1 To n)
      For i = 1 To n: For j = 1 To n: a(1, i, j) = n * (i - 1) + j: a(2, i, j) = n * (j - 1) + i: Next j, i
      For k = 3 To n + 1: For i = 1 To n: For j = 1 To n: b = i + (j - 1): b = b + n * (b > n): a(k, i, j) = a(k - 1, b, j): Next j, i, k
      Sheets.Add
      For k = 1 To n + 1: Cells((k - 1) * n + 1, 1) = "Tour " & k: For i = 1 To n: For j = 1 To n: Cells((k - 1) * n + i, j + 1) = a(k, i, j): Next j, i, k
      Cells.EntireColumn.AutoFit
      '---vérification---
      t = Cells(1, 2).Resize(n * (n + 1), n)
      Set d = CreateObject("Scripting.Dictionary")
      For i = 1 To UBound(t): For j = 1 To n - 1: For k = j + 1 To n: x = t(i, j) & " " & t(i, k): d(x) = d(x) + 1: Next k, j, i
      MsgBox "Nombre de paires uniques créées : " & d.Count & " sur " & n * n * (n * n - 1) / 2 & " "
      If d.Count = n * n * (n * n - 1) / 2 Then Exit Sub
      '---analyse des doublons---
      t = d.items: d.RemoveAll
      For n = 0 To UBound(t): d(t(n)) = d(t(n)) + 1: Next
      t = d.keys: t1 = d.items: x = ""
      For n = 0 To UBound(t): x = x & vbLf & t1(n) & " paires sont créées " & t(n) & " fois": Next
      MsgBox Mid(x, 2), , "Analyse"
    End Sub
    A+
     
  8. job75

    job75 XLDnaute Barbatruc

    Inscrit depuis le :
    15 Mai 2008
    Messages :
    23263
    "J'aime" reçus :
    1735
    Sexe :
    Masculin
    Habite à:
    Paris
    Utilise:
    Excel 2013 (PC)
    Re,

    Quand le nombre de tables n'est pas premier je pense que la méthode de KenDev minimise le nombre de doublons, mais il faudrait arriver à le démontrer.

    On remarque que le nombre de fois où une paire est créée est toujours un diviseur du nombre de tables.

    A+
     
  9. Magic_Doctor

    Magic_Doctor XLDnaute Accro

    Inscrit depuis le :
    2 Juin 2005
    Messages :
    1910
    "J'aime" reçus :
    17
    Habite à:
    Montevideo
    Utilise:
    Excel 2007 (PC)
    Que je sache, un forum est destiné avant tout pour le "fun", et aucun commentaire pollue, à moins qu'il ne soit ordurier...
    Comme tout le monde l'aura compris, cette citation n'est pas du célèbre cycliste-toujours-perdant, mais du célèbre janséniste dont on nous aura vacciné pour le Bac français avec ses fameuses "Pensées"...
    Que KenDev ait trouvé par lui-même la solution, là n'est pas le problème. Ce qui importe, c'est la soution !

    Une bonne réflexion, celle de José Gervasio Artigas (el prócer del Uruguay). Peut-être la plus belle définition de la liberté que j'aie jamais lue : " Con libertad no ofendo ni temo "
    À cogiter !
     
  10. job75

    job75 XLDnaute Barbatruc

    Inscrit depuis le :
    15 Mai 2008
    Messages :
    23263
    "J'aime" reçus :
    1735
    Sexe :
    Masculin
    Habite à:
    Paris
    Utilise:
    Excel 2013 (PC)
    Bonjour Magic_Doctor,

    Je me posais juste la question et tu as très bien répondu.

    En fin de journée je suis un peu en panne d'humour.

    A
     

Partager cette page