Microsoft 365 Problème de distribution et de permutations.

Gégé-45550

XLDnaute Accro
Bonjour amis Excel'lents !
Tout est dans le titre et le fichier ci-joint.
Merci d'avance de vos brillants éclairages (je sais, cette phrase ouvre la porte à toutes les blagues du genre "illuminations à l'approche de Noël", "on n'est pas des illuminés", "je n'ai pas la lumière à tous les étages" ... ne vous privez surtout pas !)
Amicalement,
 

Pièces jointes

  • Test.xlsx
    13 KB · Affichages: 10

Gégé-45550

XLDnaute Accro
Bonsoir Gégé-45550,

A priori il s'agit des arrangements des 12 lettres A à L pris 3 par 3.

Il y en a 12 x 11 x 10 = 1320, il est facile de les lister.

A+
Bonsoir job75,
Merci pour cette réponse rapide (peut-être un peu trop) car je ne pense pas qu'après avoir listé tous les arrangements de 3 lettres parmi 12 (ça je sais faire mais je ne vois pas à quoi ça peut me servir), je serai plus avancé pour savoir comment arranger ma liste de 143 éléments de telle manière que la condition "pas plus de 14 lettres identiques à chacune des trois places" soit respectée. De plus, l'algorithme "idéal" doit pouvoir fonctionner quelle que soit cette liste, à condition bien entendu qu'aucune lettre ne soit présente au total plus de 42 fois (3*14).
Cordialement,
 

TooFatBoy

XLDnaute Barbatruc
Bonjour,

Est-ce qu'on est sûr que ça se calcule ?
On doit pouvoir calculer le nombre de solutions possibles, mais est-il possible d'en sortir au moins une ?

Je vois comment calculer le nombre minimum et maximum théorique d'apparitions possibles aux différents emplacements, pour chacune des 12 lettres, mais à part ça... Je ne vois rien de chez Rien !

 
Dernière édition:

Gégé-45550

XLDnaute Accro
Bonjour,

Est-ce qu'on est sûr que ça se calcule ?
On doit pouvoir calculer le nombre de solutions possibles, mais est-il possible d'en sortir au moins une ?

Je vois comment calculer le nombre minimum et maximum théorique d'apparitions possibles aux différents emplacements, pour chacune des 12 lettres, mais à part ça... Je ne vois rien de chez Rien !

Bienvenue au club !!!
Mais on y arrive "à la main", ça doit donc pouvoir se calculer (peut-être par itérations ?).
Ah, au fait, il y a au moins une personne qui croit qu'une règle de 111 se vérifie avec une preuve par 1001 ;)🤣
Bien amicalement
 

job75

XLDnaute Barbatruc
Bonjour Gégé-45550, TooFatBot, le forum,

Regardez attentivement le fichier joint et cette macro :
VB:
Sub Tirages()
Dim t, ntirages&, i, j, k, n&, a(1 To 3)
t = Timer
ntirages = 100000 'nombre maximum de tirages, à adapter
Application.ScreenUpdating = False
'---liste des arrangements---
For i = 65 To 76
    For j = 65 To 76
        If j <> i Then
            For k = 65 To 76
                If k <> i And k <> j Then
                    n = n + 1
                    a(1) = Chr(i)
                    a(2) = Chr(j)
                    a(3) = Chr(k)
                    Cells(n + 1, 2).Resize(, 3) = a
                End If
            Next k
        End If
Next j, i
'---tris aléatoires---
[K2:M144].ClearContents 'RAZ
With [A1].CurrentRegion.Resize(, 4)
    For n = 1 To ntirages
        If n Mod 100 = 0 Then Application.StatusBar = Format(n, "#,##0") & " tirages" 'pour faire patienter...
        .Sort .Columns(1), Header:=xlYes
        If Application.Max(Range("G2:I13")) <= 14 Then
            [K2:M144] = [B2:D144].Value
            Application.ScreenUpdating = True
            MsgBox Format(n, "#,##0") & " tirages réalisés en " & Format(Timer - t, "0.0") & " secondes", , "143 arrangements trouvés"
            Exit Sub
        End If
    Next n
End With
MsgBox "Aucun résultat en " & Format(ntirages, "#,##0") & " tirages..."
End Sub
100 000 tirages prennent du temps, pourtant ce n'est qu'à la 2ème tentative que j'ai obtenu un résultat.

Avec 67 000 tirages en 291 secondes.

A+
 

Pièces jointes

  • Arrangements(1).xlsm
    51.9 KB · Affichages: 2

Gégé-45550

XLDnaute Accro
Bonjour Gégé-45550, TooFatBot, le forum,

Regardez attentivement le fichier joint et cette macro :
VB:
Sub Tirages()
Dim t, ntirages&, i, j, k, n&, a(1 To 3)
t = Timer
ntirages = 100000 'nombre maximum de tirages, à adapter
Application.ScreenUpdating = False
'---liste des arrangements---
For i = 65 To 76
    For j = 65 To 76
        If j <> i Then
            For k = 65 To 76
                If k <> i And k <> j Then
                    n = n + 1
                    a(1) = Chr(i)
                    a(2) = Chr(j)
                    a(3) = Chr(k)
                    Cells(n + 1, 2).Resize(, 3) = a
                End If
            Next k
        End If
Next j, i
'---tris aléatoires---
[K2:M144].ClearContents 'RAZ
With [A1].CurrentRegion.Resize(, 4)
    For n = 1 To ntirages
        If n Mod 100 = 0 Then Application.StatusBar = Format(n, "#,##0") & " tirages" 'pour faire patienter...
        .Sort .Columns(1), Header:=xlYes
        If Application.Max(Range("G2:I13")) <= 14 Then
            [K2:M144] = [B2:D144].Value
            Application.ScreenUpdating = True
            MsgBox Format(n, "#,##0") & " tirages réalisés en " & Format(Timer - t, "0.0") & " secondes", , "143 arrangements trouvés"
            Exit Sub
        End If
    Next n
End With
MsgBox "Aucun résultat en " & Format(ntirages, "#,##0") & " tirages..."
End Sub
100 000 tirages prennent du temps, pourtant ce n'est qu'à la 2ème tentative que j'ai obtenu un résultat.

Avec 67 000 tirages en 291 secondes.

A+
 

Gégé-45550

XLDnaute Accro
Bonjour job75
Merci pour cette réponse. chez moi, j'obtiens
Capture.png

Malheureusement, le problème est plus complexe qu'il n'y paraît.
En effet, il ne s'agit pas de trouver seulement 143 arrangements répondant aux critères, mais bien d'arranger les 143 triplets pour qu'ils répondent aux critères.
Or si je prends le premier triplet de la liste imposée (AEJ), déjà il ne figure pas dans la liste des résultats obtenus.
C'est un vrai casse-tête sur lequel je bute depuis 2 semaines.
Merci de votre intérêt.
Cordialement
 

job75

XLDnaute Barbatruc
Dans ce fichier (2) je pars de la liste imposée pour construire la liste des arrangements :
VB:
Sub Tirages()
Dim t, ntirages&, d As Object, tablo, i&, x$, y$, z$, n&
t = Timer
ntirages = 100000 'nombre maximum de tirages, à adapter
Application.ScreenUpdating = False
'---liste des arrangements---
Range("C2:F" & Rows.Count).ClearContents 'RAZ
Set d = CreateObject("Scripting.Dictionary")
tablo = [A2:A144]
For i = 1 To 143
    x = Left(tablo(i, 1), 1)
    y = Mid(tablo(i, 1), 2, 1)
    z = Right(tablo(i, 1), 1)
    d(x & " " & y & " " & z) = ""
    d(x & " " & z & " " & y) = ""
    d(y & " " & x & " " & z) = ""
    d(y & " " & z & " " & x) = ""
    d(z & " " & x & " " & y) = ""
    d(z & " " & y & " " & x) = ""
Next
[D2].Resize(d.Count) = Application.Transpose(d.Keys)
[D2].Resize(d.Count).TextToColumns [D2], xlDelimited, Space:=True 'commande Convertir
[C2].Resize(d.Count) = "=RAND()"
'---tris aléatoires---
[M2:O144].ClearContents 'RAZ
With [C1].CurrentRegion.Resize(, 4)
    For n = 1 To ntirages
        If n Mod 100 = 0 Then Application.StatusBar = Format(n, "#,##0") & " tirages" 'pour faire patienter...
        .Sort .Columns(1), Header:=xlYes
        If Application.Max(Range("I2:K13")) <= 14 Then
            [M2:O144] = [D2:F144].Value
            Application.ScreenUpdating = True
            MsgBox Format(n, "#,##0") & " tirages réalisés en " & Format(Timer - t, "0.0") & " secondes", , "143 arrangements trouvés"
            Exit Sub
        End If
    Next n
End With
MsgBox "Aucun résultat en " & Format(ntirages, "#,##0") & " tirages..."
End Sub
On obtient 498 arrangements mais pas de solutions.

Si l'on passe la limite à 15 au lieu de 14 on obtient très vite une solution.
 

Pièces jointes

  • Arrangements(2).xlsm
    23.9 KB · Affichages: 3

job75

XLDnaute Barbatruc
J'ai mis dans le fichier (2) comme liste imposée en A2:A144 la liste des triplets obtenue avec le fichier (1).

Eh bien avec 3 essais de 100 000 tirages chacun je n'ai pas trouvé de solution.

L'algorithme utilisé n'est donc pas performant.
 

Discussions similaires

Statistiques des forums

Discussions
314 450
Messages
2 109 721
Membres
110 551
dernier inscrit
Khyolyanna