[Débutant] Permutation d'un nombre N

Bonjour,

Voici ce qui répondra partiellement à ta demande.
Il s'agit d'un algorithme qui effectue toutes les permutations des caractères d'une chaine. Il te faudra bien entendu l'adapter à ton travail.
Par rapport à ta demande, il suffit de l'exécuter sur la chaine 234 et d'afficher les résultats précédés d'un premier chiffre (1, par ex.), le tout avec le formatage qui te plait (espace entre les chiffres, tirets, ...).
Le module a été initialement écrit en espagnol, c'est pourquoi tu trouveras des noms de variables et de procédures "en espagnol". Mais faciles à comprendre (ex. Resultados = Résultats).

Bon travail ...

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
 
    Sub Main()
 
        Dim CadenaFuente As String  ' Chaine source
 
        Console.WriteLine("***********************")
        Console.Write("Cadena ? ")   ' Chaine ?
        CadenaFuente = Console.ReadLine()
 
        Console.WriteLine("Esperamos ...")  ' Patienter 
 
        Console.WriteLine("***********************")
        ' Console.WriteLine("Estan todas las permutaciones, con duplicados si existan letras duplicadas en la cadena")
        Console.WriteLine("Voici toutes les permutations, avec doublons s'ils y a des lettres en double dans la chaine")
        Dim ListaResultados() As String = Nothing
        TodasPermutaciones(CadenaFuente, ListaResultados)   ' Resultados no ordonnar  Résultats non ordonnés
        For i As Integer = 0 To ListaResultados.Count - 1
            Console.WriteLine(ListaResultados(i))
        Next
        Console.WriteLine(ListaResultados.Count & " résultados")
 
        Console.WriteLine("Una tecla para la continuacion ...")   ' une touche pour continuer ...
        Console.ReadKey()
 
    End Sub
 
    Private Function Factorial(N As Integer) As Integer
        If N = 1 Then
            Return 1
        Else
            Return N * Factorial(N - 1)
        End If
    End Function
 
    Private Sub TodasPermutaciones(CadenaFuente As String, ByRef Resultados() As String)   ' ChaineSource, Résultats
        ' Da todas permutaciones. Existent duplicados si existen letras duplicadas en la caden fuente.
        ' Donne toutes les permutations. Des permuations existent en doubles s'il y a des caractères identiques dans la chaine source.
 
        Dim i As Integer
        Dim l As Integer
        Dim k As Integer
        Dim j As Integer
 
        Dim Posicion As Integer = 0
 
        Dim CantidadCaracters As Byte
        Dim CantidadResultados As Integer
        Dim CadenaTmp As String
        Dim ResultadosTmp() As String
 
        CantidadCaracters = CadenaFuente.Length
        If CantidadCaracters = 0 Then
            ReDim Resultados(0)
            Resultados(0) = ""
            Exit Sub
        End If
 
        CantidadResultados = Factorial(CantidadCaracters)
        ReDim Resultados(CantidadResultados - 1)
 
        If CantidadCaracters = 1 Then
            Resultados(0) = CadenaFuente
            Exit Sub
        End If
 
        For i = 0 To CantidadCaracters - 1
            CadenaTmp = String.Empty
            For j = 0 To CantidadCaracters - 1
                If j <> i Then
                    CadenaTmp = CadenaTmp & CadenaFuente.Substring(j, 1)
                End If
            Next j
 
            ReDim ResultadosTmp(CadenaTmp.Length - 1)
            If CadenaTmp.Length = 1 Then
                ResultadosTmp(0) = CadenaTmp
            Else
                TodasPermutaciones(CadenaTmp, ResultadosTmp)
            End If
 
            For k = 0 To CantidadResultados / CantidadCaracters - 1
                For l = 0 To ResultadosTmp.Count - 1
                    Resultados(l + Posicion) = CadenaFuente.Substring(i, 1) & ResultadosTmp(l)
                Next l
            Next k
 
            Posicion += CantidadResultados / CantidadCaracters
 
        Next i
 
    End Sub

Pièce jointe 599166