Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

  1. #1
    Membre à l'essai
    Homme Profil pro
    Support technico réglementaire
    Inscrit en
    juin 2013
    Messages
    12
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Nord (Nord Pas de Calais)

    Informations professionnelles :
    Activité : Support technico réglementaire
    Secteur : Industrie

    Informations forums :
    Inscription : juin 2013
    Messages : 12
    Points : 24
    Points
    24

    Par défaut Décomposition d'un nombre en facteurs premiers par roue de factorisation

    Bonjour à tous

    Quelqu'un peut-il m'apporter de l'aide à propos d'une incompréhension de ma part qui m'empêche littéralement de dormir ?

    Je travaille avec Access 2016 (VBA 7.1).

    Toutes les sources de langue française et anglaise que j'ai consultées à propos des roues de factorisation, en commençant par Wikipédia, indiquent que, pour factoriser un nombre, on peut omettre des diviseurs les nombres qui ne sont pas situés sur les rayons de la roue.
    Ces rayons sont déterminés par les nombres premiers qui figurent sur le "premier tour de roue", à partir du nombre premier qui suit le dernier de la base.
    Toutes donnent l'exemple de la base {1, 2, 3} dont la primorielle est 6 :

    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

    et indiquent qu'il est inutile de tester les diviseurs des colonnes autres que 1 et 6. Dont acte !
    Certaines vont même jusqu'à la base {1, 2, 3, 5} dont la primorielle est 30, et la plupart indiquent que, jusqu'à un certain point, il est possible d'accélérer la décomposition en augmentant la base {1, 2, 3, 5, 7}, {1, 2, 3, 5, 7, 11}...
    Par curiosité j'ai donc écrit une fonction de décomposition à "base variable" pour chronométrer les différences.

    Grande a été ma surprise de constater qu'au delà de la base {1, 2, 3, 5}, la factorisation peut échouer !

    Par exemple, avec une base {2, 3, 5, 7} -primorielle = 210-, les nombres premiers du 1er tour sont :
    2, 3, 5, 7, 11, 13, 17, 19, 23, 29, 31, 37, 41, 43, 47, 53, 59, 61, 67, 71, 73, 79, 83, 89, 97, 101, 103, 107, 109, 113, 127, 131, 137, 139, 149, 151, 157, 163, 167, 173, 179, 181, 191, 193, 197, 199
    '
    Cela signifie que les nombres du rayon situés sous 121 (11 × 11) doivent être omis des diviseurs, et pourtant la plupart d'entre eux sont premiers :
    * 121 + 1 * 210 = 331 PREMIER
    * 121 + 2 * 210 = 541 PREMIER
    * 121 + 3 * 210 = 751 PREMIER ...

    Idem pour le rayon sous le nombre 143 (11 × 13) :
    * 143 + 1 * 210 = 353 PREMIER
    * 143 + 2 * 210 = 563 PREMIER
    * 143 + 3 * 210 = 773 PREMIER ...

    Avec cette base le nombre 116 843 N'EST DONC PAS DÉCOMPOSÉ alors qu'il est égal au produit de nombres premiers 331 * 353

    Quelqu'un peut-il m'indiquer à quel moment je me fourvoie (de manière simple, parce qu'à 71 ans les neurones ne sont plus ce qu'ils étaient ) ?

    Ci-dessous, la routine de factorisation et celle qui détermine les éléments de la roue ; la fonction "NombresPremiersEratosthène" retourne la liste des nombres premiers.
    C'est celle publiée sur ce site le 16 décembre 2016 par Pijaku à qui je fait part de mon admiration pour le travail comparatif réalisé !
    https://www.developpez.net/forums/d1...bres-premiers/.

    Voici en outre, à toutes fins utiles, quelques unes des sources que j'ai consultées :

    https://en.wikipedia.org/wiki/Wheel_factorization
    https://primes.utm.edu/glossary/page...lFactorization
    https://planetmath.org/wheelfactorization
    https://numericalrecipes.wordpress.c...factorization/
    https://programmingpraxis.com/2009/0...factorization/

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    'Structure décrivant une roue de factorisation (cf. fonction "FacteursPremiersParRoue")
    'Les tableaux .Base, .PremTour1 et .Incréments SONT INDEXÉS A UN !
    Private Type RoueFactorisation
        Base()       As Long     'Liste des nombres premiers de la base
        PremExtra    As Long     'Nombre premier qui suit le dernier de la base
        ValPrim      As Currency 'Valeur de la primorielle de la base
        PremTour1()  As Long     'Nombres premiers dans le 1er "tour de roue"
        Incréments() As Byte     'Liste des incréments entre secteurs "utiles" de la roue
    End Type 'RoueFactorisation
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    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
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    134
    135
    136
    137
    138
    139
    140
    141
    142
    143
    144
    145
    146
    147
    148
    149
    150
    151
    152
    153
    154
    155
    156
    157
    158
    159
    160
    161
    162
    163
    164
    165
    166
    167
    168
    '=======================================================================================
    Public Function FacteursPremiersParRoue(ByVal Nombre As Long, _
                                             ByRef Facteurs() As Long, _
                                    Optional ByVal DernBase As Integer = 11) As Long
    
    'CRÉATION :         27 octobre 2018 - Hervé Mary d'après un article Wikipédia publié sur
    '                   https://en.wikipedia.org/wiki/Wheel_factorization
    'MODIFICATIONS :
    'DESCRIPTION :
    ' Cette fonction décompose, par la méthode de la roue de factorisation, un nombre entier
    'en ses facteurs premiers.
    'Elle retourne la liste de facteurs et le nombre de facteurs trouvés.
    '
    '   Note : Si le nombre est négatif, elle ajoute un facteur -1 et décompose la valeur
    '          absolue du nombre ; exemple : -35 -> -1, 5, 7
    '
    'INFORMATIONS REÇUES :
    '   Nombre   : Nombre à décomposer
    '   Facteurs : référence à un tableau INDEXÉ A 1, que la fonction redimensionne ? la
    '              valeur convenable et dans laquelle elle retourne chaque facteur premier
    '              Exemple pour 72 = 2 × 2 × 2 × 3 × 3 :
    '              Facteurs(1) = 2, Facteurs(2) = 2, Facteurs(3) = 2
    '              Facteurs(4) = 3, Facteurs(5) = 3
    '   DernBase : Dernier nombre premier de la base utilisée pour construire la roue.
    '              Si l'argument est omis, la fonction utilise la base {2, 3, 5, 7, 11}
    '
    '              Si le nombre n'est pas un nombre premier, la fonction crée la base pour
    '              le nombre premier immédiatement inférieur ; par exemple si DernBase = 12,
    '              la fonction crée la base pour 11 : {2, 3, 5, 7, 11}.
    '
    '              Augmenter ce nombre réduit la durée d'exécution au prix d'une consomma-
    '              tion mémoire plus importante ; au delà de 11, le gain de temps d'exécu-
    '              tion est annihilé, voire accru, par da durée de construction de la roue.
    '              Par exemple pour décomposer MaxLongInteger (2 147 483 647) qui est un
    '              nombre premier :
    '                 Base  5 : 0.063 s (10 appels)
    '                 Base  7 : 0.025 s (10 appels)
    '                 Base 11 : 0.023 s (10 appels)
    '                 Base 13 : 0.063 s (10 appels)
    '
    'CONDITIONS ET EXCEPTIONS :
    ' * 1 n'est PAS un nombre premier ; il est nommé "produit vide"
    '
    ' * Le plus grand diviseur premier d'un nombre est inférieur à la racine carrée du nombre
    '   mais il est plus rapide de multiplier le diviseur par lui-même pour le comparer au
    '   nombre plutôt que de calculer la racine carrée du nombre pour la comparer au diviseur
    '
    ' * La fonction utilise la méthode de la "roue de factorisation" :
    '   Partant d'une courte liste de nombres premiers (la base), on génère une liste (la
    '   roue) des entiers qui sont copremiers avec tous les nombres de la base.
    '   Pour trouver le plus petit diviseur du nombre à factoriser, on le divise successi-
    '   vement par les nombres premiers de la base, puis par ceux de la roue.
    '
    '   Avec une base constituée des nombres premiers 2 et 3, dont le produit est 6, chaque
    '   "tour de roue" comporte 6 secteurs :
    '
    '   .-----------------------------------.
    '   |  1  |  2  |  3  |  4  |  5  |  6  | 1er "tour de roue" -> essai de 2, 3, 5
    '   '-----------------------------------'
    '            v     v     v           v
    '   .-----+-----+-----+-----+-----+-----.
    '   |  7  |  8  |  9  |  10 |  11 |  12 | 2ème "tour de roue" -> essai de  7 et 11
    '   |  13 |  14 |  15 |  16 |  17 |  18 | 3ème "tour de roue" -> essai de 13 et 17
    '   |  19 |  20 |  21 |  22 |  23 |  24 | 4ème "tour de roue" -> essai de 19 et 23
    '   |  25 |  26 |  27 |  28 |  29 |  30 | 5ème "tour de roue" -> essai de 25 et 29
    '   |     |     |     |     |     |     |
    '  >==>^<========= 4 =========>^<== 2 ==>
    '
    '   On constate que les rayons notés "v" NE PEUVENT PAS CONTENIR DE NOMBRES COPREMIERS,
    '   avec les nombres de la base et qu'il est donc inutile d'essayer les diviseurs qu'il
    '   contiennent ;  dans le cas illustré ils sont, soit pairs, soit multiples des nombres
    '   du premier "tour de roue".
    '
    '   Note : Cela ne signifie pas que les autres secteurs ne contiennent que des nombres
    '          premiers ; certains peuvent ne pas l'être comme, par exemple, 25 dans la
    '          colonne 1 du tableau ci-dessus.
    '
    '   A partir de 5 (nombre premier qui suit le dernier nombre de la base), pour passer
    '   d'un secteur "utile" au suivant, on ajoute donc alternativement 2, puis 4 au divi-
    '   seur courant pour obtenir le diviseur  suivant :
    '   5 + 2 = 7 puis  7 + 4 = 11 puis 11 + 2 = 13 puis 13 + 4 = 17 puis 17 + 2 = 19 puis
    '   19 + 4 =23 ...
    '
    '   On ne réalise donc plus que 2 divisions par "tour de roue" au lieu des 6 qu'il
    '   aurait fallu réaliser avec l'essai systématique de tous les nombres entiers, soit
    '   2/6 = 33% (gain de 67%).
    '
    '   Avec une base constituée des nombres premiers {2, 3, 5}, dont la primorielle est 30,
    '   chaque "tour de roue" comporte 30 secteurs avec une liste d'incréments égale ?
    '   4, 2, 4, 2, 4, 6, 2, 6 ; on ne réalise donc plus que 8 divisions au lieu de 30,
    '   soit 8/30 = 27% (gain de 73%)
    '   Avec une base {2, 3, 5, 7} dont la primorielle est 210, on ne réalise plus que 48
    '   divisions sur 210, soit 48/210 = 23% (gain 77%)
    '   Avec une base {2, 3, 5, 7, 11} dont la primorielle est 2310, on ne r?alise plus que
    '   331 division sur 2310, soit 331/2310 = 14,3% (gain 85.7%)
    '
    '   Note : la fonction "ElémentsRoue" crée, pour une base donnée, la liste des incré-
    '          ments qui permettent de passer d'un secteur "utile" au suivant.
    '
    '---------------------------------------------------------------------------------------
    
    Dim Diviseur   As Currency 'Le carré du diviseur peut dépasser la taille d'un "Long"
    Dim Index      As Long
    Dim NbFacteurs As Long
    Dim Roue       As RoueFactorisation
    
        'Vider le tableau des facteurs
        Erase Facteurs: NbFacteurs = 0
    
        If Nombre = 0 Then Exit Function 'Cas trivial : on retourne 0
    
        'Si le nombre est négatif...
        If Nombre < 0 Then
            '...utiliser -1 comme premier facteur
            NbFacteurs = NbFacteurs + 1
            ReDim Facteurs(1 To 1)
            Facteurs(1) = -1
            '...et changer son signe
            Nombre = Abs(Nombre)
        End If 'Nombre < 0
    
        If Nombre = 1 Then Exit Function 'Cas trivial : UN N'EST PAS un nombre premier
        
        'Construire la roue de factorisation pour la base indiqué
        Call ElémentsRoue(DernBase, Roue)
    
        With Roue
            'Essayer tous les nombres premiers de la base
            For Index = 1 To UBound(.Base)
                Diviseur = .Base(Index)
                Do While Nombre Mod Diviseur = 0
                    NbFacteurs = NbFacteurs + 1
                    ReDim Preserve Facteurs(1 To NbFacteurs)
                    Facteurs(NbFacteurs) = Diviseur
                    Nombre = Nombre / Diviseur
                Loop 'While Nombre Mod Diviseur = 0
            Next Index
            
            'Initialiser le premier diviseur
            Diviseur = .PremExtra
            Index = 1
    
            'Inutile de poursuivre au delà de la racine carrée du nombre
            Do While Diviseur * Diviseur <= Nombre
                If Nombre Mod Diviseur = 0 Then
                    NbFacteurs = NbFacteurs + 1
                    ReDim Preserve Facteurs(1 To NbFacteurs)
                    Facteurs(NbFacteurs) = Diviseur
                    Nombre = Nombre / Diviseur
                Else
                    Diviseur = Diviseur + .Incréments(Index)
                    If Index < UBound(.Incréments) Then Index = Index + 1 Else Index = 1
                End If
            Loop 'While Diviseur * Diviseur <= Nombre
    
        End With 'Roue
    
        'S'il reste un nombre différent de 1, c'est forcément un facteur premier
        '(c'est peut-être le nombre lui-même)
        If Nombre > 1 Then
            NbFacteurs = NbFacteurs + 1
            ReDim Preserve Facteurs(1 To NbFacteurs)
            Facteurs(NbFacteurs) = Nombre
        End If 'Nombre > 1
    
        'Retourner le nombre de facteurs premiers trouvés
        FacteursPremiersParRoue = NbFacteurs
    End Function 'FacteursPremiersParRoue
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    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
    '=======================================================================================
    Private Sub ElémentsRoue(ByVal DernBase As Integer, _
                             ByRef RoueFact As RoueFactorisation)
    
    'CRÉATION :         26 octobre 2018 - Hervé Mary
    'MODIFICATIONS :
    'DESCRIPTION :
    '   Cette fonction détermine les éléments pour construire une roue de factorisation.
    '
    'INFORMATIONS REÇUES :
    '   DernBase : denier nombre premier de la base à utiliser pour la roue
    '   RoueFact : Référence à une variable dans laquelle la fonction renvoi les éléments
    '              de la roue
    '
    'CONDITIONS ET EXCEPTIONS :
    ' Les incréments entre les secteurs "utiles" (les rayons) d'une roue de factorisation
    ' sont égaux aux différences entre les nombres premiers consécutifs de la roue, calcu-
    ' lées à partir du nombre premier qui suit le dernier de la base.
    ' Par exemple, pour la base {2, 3, 5}, dont la primorielle est 30, les nombres premiers
    ' du premier "tour de roue" sont 1, 3, 5, 7, 11, 13, 17, 19, 23, 29, 31, 37 et les
    ' incréments sont calculés de la manière suivante :
    '
    '               11-7 13-11 17-13 19-17 23-19 29-23 31-29 37-31
    '                 =    =     =     =     =     =     =     =
    '   Incréments = [4,   2,    4,    2,    4,    6,    2,    6]
    '
    '   Note : les nombres premiers, hormis 2, étant tous impairs, les incréments sont
    '          obligatoirement des nombres pairs (impair + pair -> impair)
    '
    ' L'avant dernier incrément est celui qui permet de passer du dernier nombre premier du
    ' premier tour de la roue au premier nombre du tour suivant ; le dernier incrément est
    ' celui qui permet de passer du premier nombre du 2?me tour au premier nombre premier de
    ' ce 2ème tour (égal à la différence entre 1 et le nombre premier qui suit le dernier de
    ' la base) :
    '
    ' .------------------------------------------------------------------------.
    ' |  1  |  2  |  3 |  4 |  5 |  6 |  7 |  8 |  9 | 10 | 11 | ... | 29 | 30 | 1er tour
    '                                    <===1er incrément==><==...     |
    '     .==================avant dernier incrément===================='
    '     |
    ' |  31 |  32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | ... | 59 | 60 | 2?me tour
    '     <======dernier incrément======>
    '
    '---------------------------------------------------------------------------------------
    
    Dim Index  As Integer
    Dim NbIncr As Integer
    
        With RoueFact
            'Retrouver la valeur et les éléments de la primorielle utilisée pour
            'construire la roue
            .Base = Primorielle(DernBase, .ValPrim)
    
            'Retrouver tous les nombres premiers du premier tour de roue
            .PremTour1 = NombresPremiersEratosthène(.ValPrim)
    
            'Trouver le nombre premier qui suit le dernier de la base
            For Index = 1 To UBound(.PremTour1)
                If .PremTour1(Index) > DernBase Then Exit For
            Next Index
            .PremExtra = .PremTour1(Index)
        
            'Prédimensionner la liste d'incréments...
            ReDim .Incréments(1 To UBound(.PremTour1))
            '...et construire la liste
            NbIncr = 0
            For Index = Index To UBound(.PremTour1) - 1
                NbIncr = NbIncr + 1
                .Incréments(NbIncr) = .PremTour1(Index + 1) - .PremTour1(Index)
            Next Index
            '...avant dernier incrément
            NbIncr = NbIncr + 1
            .Incréments(NbIncr) = .ValPrim + 1 - .PremTour1(UBound(.PremTour1))
            '...et dernier incrément
            NbIncr = NbIncr + 1
            .Incréments(NbIncr) = .PremExtra - 1
            'Redimensionner la liste à la taille convenable
            ReDim Preserve .Incréments(1 To NbIncr)
        End With 'RoueFact
    
    End Sub 'ElémentsRoue
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    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
    '=======================================================================================
    Private Function Primorielle(ByVal NombrePremier As Long, _
                        Optional ByRef Valeur As Currency) As Long()
    
    'CRÉATION :         25 octobre 2018 - Hervé Mary
    'MODIFICATIONS :
    'DESCRIPTION :
    '   Cette fonction retourne la listes des nombres premiers qui constituent la primorielle
    'pour le nombre premier qui lui est fourni.
    'Elle en retourne aussi la valeur
    '
    'INFORMATIONS REÇUES :
    '   NombrePremier : Nombre premier dont il faut retourner la primorielle
    '                   Si le nombre n'est pas un nombre premier, la fonction crée la primo-
    '                   rielle pour le nombre premier immédiatement inférieur ; par exemple
    '                   si NombrePremier = 12, la fonction crée la primorielle P(11)
    '   Valeur        : Référence à une variable dans laquelle la fonction retourne la valeur
    '                   de la primorielle.
    '                   La fonction affecte systématiquement la valeur de la primorielle à
    '                   l'argument, mais cette affectation est sans conséquence si l'argument
    '                   est omis
    '
    'CONDITIONS ET EXCEPTIONS :
    ' https://fr.wikipedia.org/wiki/Primorielle
    '
    ' On appelle "primorielle" (= factorielle de nombres premiers), notée n# ou P(n), le
    ' produit de tous les nombres premiers inférieurs ou égaux à n.
    ' Par exemple : P(3) = 2 × 3 = 6,  P(5) = 2 × 3 × 5 = 30, P(7) = 2 × 3 × 5 × 7 = 210
    '---------------------------------------------------------------------------------------
    '
    
    Dim Index As Long
    Dim Liste() As Long
    
        'Retrouver la liste de tous les nombres premiers inférieurs ou égaux au nombre indiqué
        Liste = NombresPremiersEratosthène(NombrePremier)
        'Retourner la liste des membres...
        Primorielle = Liste
        '...et sa valeur
        Valeur = 1
        For Index = 1 To UBound(Liste)
            Valeur = Valeur * Liste(Index)
        Next Index
        
    End Function 'Primorielle

  2. #2
    Rédacteur/Modérateur

    Homme Profil pro
    Ingénieur qualité méthodes
    Inscrit en
    décembre 2013
    Messages
    2 109
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations professionnelles :
    Activité : Ingénieur qualité méthodes
    Secteur : Conseil

    Informations forums :
    Inscription : décembre 2013
    Messages : 2 109
    Points : 4 411
    Points
    4 411

    Par défaut

    Sur cette roue issue de Wikipédia : https://en.wikipedia.org/wiki/Wheel_...ion-n%3D30.svg, on a 30 rayons, , base 2x3x5, on voit que les cases coloriées en jaune dans le 1er cercle sont uniquement les multiples de 2 3 ou 5, pas tous les nombres premiers. Et c'est uniquement ceux là qui sont propagés sur les rayons, en ajoutant 30 à chaque fois.
    N'oubliez pas le bouton Résolu si vous avez obtenu une réponse à votre question.

  3. #3
    Membre à l'essai
    Homme Profil pro
    Support technico réglementaire
    Inscrit en
    juin 2013
    Messages
    12
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Nord (Nord Pas de Calais)

    Informations professionnelles :
    Activité : Support technico réglementaire
    Secteur : Industrie

    Informations forums :
    Inscription : juin 2013
    Messages : 12
    Points : 24
    Points
    24

    Par défaut

    Merci !

    J'ai entretemps identifié ma lamentable bévue !

    Il suffit de ne pas confondre "nombres premiers", comme je l'ai fait, avec "nombres COPREMIERS avec ceux de la base" (c'est ce que je disais : à 71 ans les neurones font de la colle ) !

    En tout cas chapeau pour la promptitude et encore merci.

  4. #4
    Membre à l'essai
    Homme Profil pro
    Support technico réglementaire
    Inscrit en
    juin 2013
    Messages
    12
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Nord (Nord Pas de Calais)

    Informations professionnelles :
    Activité : Support technico réglementaire
    Secteur : Industrie

    Informations forums :
    Inscription : juin 2013
    Messages : 12
    Points : 24
    Points
    24

    Par défaut

    Pour que cette discussion ait, comme les conte de fées, une fin heureuse, voici la routine corrigée et celle qui calcule le PGCD.
    Encore merci.

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    'Structure décrivant une roue de factorisation (cf. fonction "FacteursPremiersParRoue")
    'Les tableaux .Base, .PremTour1 et .Incréments SONT INDEX?S A UN !
    Private Type RoueFactorisation
        Base()       As Long     'Liste des nombres premiers de la base
        PremExtra    As Long     'Nombre premier qui suit le dernier de la base
        ValPrim      As Currency 'Valeur de la primorielle de la base
        Incréments() As Byte     'Liste des incréments entre secteurs "utiles" de la roue
    End Type 'RoueFactorisation

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    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
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    134
    135
    136
    137
    138
    139
    140
    141
    142
    143
    144
    145
    146
    147
    148
    149
    150
    151
    152
    153
    154
    155
    156
    157
    158
    159
    160
    161
    162
    '=======================================================================================
    Private Sub ElémentsRoue(ByVal DernBase As Integer, _
                             ByRef RoueFact As RoueFactorisation)
    
    'CR?ATION :         05 novembre 2018 - Hervé Mary
    'MODIFICATIONS :
    'DESCRIPTION :
    '   Cette fonction détermine les éléments pour construire une roue de factorisation.
    '
    'INFORMATIONS REÇUES :
    '   DernBase : denier nombre premier de la base ? utiliser pour la roue
    '   RoueFact : Référence à une variable dans laquelle la fonction renvoi les éléments
    '              de la roue
    '
    'CONDITIONS ET EXCEPTIONS :
    ' Les incréments entre les secteurs "utiles" (les rayons) d'une roue de factorisation
    ' sont égaux aux différences entre les nombres COPREMIERS consécutifs de la roue, calcu-
    ' lées ? partir du nombre premier qui suit le dernier de la base.
    ' Par exemple pour la base {2, 3, 5}, dont la primorielle est 30, les nombres COPREMIERS
    ' du premier "tour de roue" sont 1, 3, 5, 7, 11, 13, 17, 19, 23, 29, 31, 37 et les
    ' incréments sont calculés de la manière suivante :
    '
    '               11-7 13-11 17-13 19-17 23-19 29-23 31-29 37-31
    '                 =    =     =     =     =     =     =     =
    '   Incréments = [4,   2,    4,    2,    4,    6,    2,    6]
    '
    '   Notes : * Un nombre COpremier avec les nombres de la base n'est pas obligatoirement
    '             un nombre premier ; par exemple, pour la base {2, 3, 5, 7} dont la primo-
    '             rielle est 210, les nombres 121 et 143 sont copremiers avec 2, 3, 5 et 7
    '             (ils ne sont divisibles par aucun de ces nombres), sans pour autant être
    '             premiers (ils sont respectivement décomposables en 11 x 11 et 11 x 13)
    '
    '           * Hormis 2, tous les nombres premiers sont impairs ; en outre, comme 2 fait
    '             partie de toutes les bases, aucun nombre COPREMIER ? ceux de la base ne
    '             peut être un nombre pair.
    '             Les incréments sont donc  obligatoirement des nombres pairs
    '             (impair + pair -> impair)
    '
    ' L'avant dernier incrément est celui qui permet de passer du dernier nombre premier du
    ' premier tour de la roue au premier nombre du tour suivant ; le dernier incrément est
    ' celui qui permet de passer du premier nombre du 2?me tour au premier nombre premier de
    ' ce 2?me tour (?gal ? la différence entre 1 et le nombre premier qui suit le dernier de
    ' la base) :
    '
    ' .------------------------------------------------------------------------.
    ' |  1  |  2  |  3 |  4 |  5 |  6 |  7 |  8 |  9 | 10 | 11 | ... | 29 | 30 | 1er tour
    '                                    <===1er incrément==><==...     |
    '     .==================avant dernier incrément===================='
    '     |
    ' |  31 |  32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | ... | 59 | 60 | 2?me tour
    '     <======dernier incrément======>
    '
    ' PERFORMANCES :
    '  Même avec un crible d'élimination des multiples des nombre de la base, la durée de
    '  construction d'une roue de base {2, 3, 5, 7, 11} devient significative ; elle devient
    '  prohibitive pour une roue de base {2, 3, 5, 7, 11, 13} et carrément extravagante
    '  pour une roue de base {2, 3, 5, 7, 11, 13, 17}
    '                Sans crible Avec crible                Gain sans/avec crible
    '    Base =  3 :   0.027 s     0.023 s (1?000 appels)   15 %
    '    Base =  5 :   0.031 s     0.027 s (1?000 appels)   13 %
    '    Base =  7 :   0.238 s     0.164 s (1?000 appels)   31 %
    '    Base = 11 :   3.023 s     1.961 s (1?000 appels)   35 %
    '    Base = 13 :  43.789 s    27.992 s (1?000 appels)   36 %
    '    Base = 17 : 802.789 s   524.234 s (1?000 appels)   34 %
    '
    '  En tout état de cause, la procédure limite la base ? 17
    '
    '---------------------------------------------------------------------------------------
    
    Const BaseMax = 17
    Const Omettre = True    'Après dimensionnement du crible, toutes ses cellules sont False
                            'on met à TRUE les cellules correspondant aux nombres à OMETTRE
                            'du test de coprimalité
    
    Dim Coprem    As Boolean
    Dim IdxBase   As Long
    Dim Index     As Long
    Dim NbIncr    As Long
    Dim Précédent As Long
    Dim Crible()  As Boolean
    
        With RoueFact
            'Retrouver la valeur et les éléments de la primorielle utilisée pour
            'construire la roue
            If DernBase > BaseMax Then DernBase = BaseMax
            .Base = Primorielle(DernBase, .ValPrim)
            
            'Déterminer le premier nombre premier qui suit le dernier de la base
            If DernBase = 3 Then
                .PremExtra = 5
            ElseIf DernBase = 5 Then
                .PremExtra = 7
            ElseIf DernBase = 7 Then
                .PremExtra = 11
            ElseIf DernBase = 11 Then
                .PremExtra = 13
            ElseIf DernBase = 13 Then
                .PremExtra = 17
            Else
                .PremExtra = 19
            End If 'DernBase = ...
            
            'Pour ne pas tester la coprimalité de tous les nombres impairs avec ceux de la
            'base, on crée un crible dont on élimine les multiples des nombre de la base
            '(qui ne peuvent évidemment pas être copremiers à ces derniers)
            ReDim Crible(1 To .ValPrim)
            'Après dimensionnement du tableau, toutes ses cellules sont à False
            'On met à TRUE les cellules correspondant aux nombres à OMETTRE du
            'test de coprimalité
            For IdxBase = 2 To UBound(.Base) 'On omet les multiples de 2
                For Index = .Base(IdxBase) * .Base(IdxBase) To .ValPrim Step .Base(IdxBase)
                    Crible(Index) = Omettre
                Next Index
            Next IdxBase
    
            'Prédimensionner la liste d'incréments (sans nombres pairs !)...
            ReDim .Incréments(1 To .ValPrim / 2)
            '...et construire la liste
            NbIncr = 0: Précédent = 0
            'Chercher les nombres qui sont copremiers avec ceux de la base
            For Index = .PremExtra To .ValPrim Step 2 'Inutile de tester les nombres pairs
                If Crible(Index) = Not Omettre Then
                    GoSub CoPremiersBase
                    If Coprem Then
                        If Précédent > 0 Then
                            'Incrémenter le nombre d'incréments...
                            NbIncr = NbIncr + 1
                            '...et ajouter l'incrément à la liste
                            .Incréments(NbIncr) = Index - Précédent
                        End If 'Précédent > 0
                        Précédent = Index
                    End If 'Coprem
                End If 'Crible(Index) = Not Omettre
            Next Index
            '...avant dernier incrément
            NbIncr = NbIncr + 1
            .Incréments(NbIncr) = .ValPrim + 1 - Précédent
            '...et dernier incrément
            NbIncr = NbIncr + 1
            .Incréments(NbIncr) = .PremExtra - 1
            'Redimensionner la liste ? la taille convenable
            ReDim Preserve .Incréments(1 To NbIncr)
        End With 'RoueFact
        Exit Sub
    
    '-------------------------------------------------
    CoPremiersBase:
        'Détermine si le nombre contenu dans la variable "Index" est ou non copremier avec
        'TOUS le nombres de la base de la roue
        'Comme on ne travaille que sur des "Long", pour réduire la durée d'exécution,
        'le sous-programme appelle directement "PGCDPrivate"
    
        Coprem = False
        With RoueFact
            For IdxBase = 1 To UBound(.Base)
                If PGCDPrivate(Index, .Base(IdxBase)) <> 1 Then Return
            Next IdxBase
        End With 'RoueFact
        Coprem = True
        Return
    
    End Sub 'ElémentsRoue
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    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
    '=======================================================================================
    Private Function PGCDPrivate(ByVal A As Long, _
                                 ByVal B As Long) As Long
    
    'CR?ATION :         29 octobre 2018 - Hervé Mary
    'MODIFICATIONS :
    'DESCRIPTION :
    '   Cette fonction calcule le PGCD (Plus Grand Commun Diviseur) positif de 2 nombres par
    'l'algorithme d'Euclide (division euclidienne).
    'Elle retourne 0 si les deux nombres sont nuls.
    '
    'INFORMATIONS REÇUES :
    '   A, B : nombres dont il faut calculer le PGCD
    '
    'CONDITIONS ET EXCEPTIONS :
    ' * Bien qu'un PGCD puisse être négatif (par exemple -3 et +3 sont tous deux les PGCD de
    '   6 et 9), usuellement, pour des nombres entiers, on considère uniquement des PGCD
    '   positifs
    '
    ' * La division euclidienne ou division entière est une opération qui, à deux entiers
    '   naturels appelés dividende et diviseur, associe deux autres entiers appelés quotient
    '   et reste.
    '         Avant VBA7 : Quotient = Int(A / B) et Rest = A - Quotient * B
    '   À partir de VBA7 : Quotient = A \ B      et Reste = A Mod B
    '
    ' * Principe de l'algorithme d'Euclide : PGCD(A, 0) = a et PGCD(A, B) = PGCD(B, A mod B).
    '
    ' * Le traitement par boucles est très légèrement plus rapide que l'appel récursif décrit
    '   sur le site Wikipédia : https://fr.wikipedia.org/wiki/Algorithme_d%27Euclide :
    '
    '       If B = 0 Then
    '           PGCD = A
    '       Else
    '           PGCD = PGCD(B, A Mod B)
    '       End If 'B = 0
    '
    '    Récursion : 0.625 s  A = 2?147?483?647, B = 18 PGCD -> 1 (1?000?000 appels)
    '      Boucles : 0.602 s  A = 2?147?483?647, B = 18 PGCD -> 1 (1?000?000 appels)
    '
    ' * Le remplacement du calcul du modulo par la fonction 'Mod' de VBA7 (lorsque c'est
    '   possible) réduit la durée d'exécution :
    '
    '      Calcul : 0.602 s  A = 2 147 483 647, B = 18 PGCD -> 1 (1 000 000 appels)
    '         Mod : 0.484 s  A = 2 147 483 647, B = 18 PGCD -> 1 (1 000 000 appels)
    '---------------------------------------------------------------------------------------
    
    Dim R As Long
    
        PGCDPrivate = 0 'Présumer l'absence de PGCD (les 2 nombre sont égaux à 0
                          'ou l'un des nombres n'est pas un entier)
    
        'Abandonner si les 2 nombres sont nuls
        If A = 0 And B = 0 Then Exit Function
        
        'Ne considérer que les PGCD positifs
        If A < 0 Then A = Abs(A): If B < 0 Then B = Abs(B)
    
        If A < B Then R = B: B = A: A = R 'permuter les valeurs
        
        Do While Abs(B) >= 1
    #If VBA7 Then '(Office 2010 ou ultérieur, 15-Jul-2010)
            'La fonction Mod n'existe pas avant VBA7
            R = A Mod B
    #Else '(Office 2007 ou antérieur)
            R = A - Int(A / B) * B
    #End If 'VBA7
            A = B
            B = R
        Loop 'While Abs(B) >= 1
    
        'Retourner le PGCD
        PGCDPrivate = Abs(A)
    
    End Function 'PGCDPrivate

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. [Python 3.X] Programmation décomposition en produits de facteurs premiers d'un seul nombre
    Par Intrepid13 dans le forum Général Python
    Réponses: 16
    Dernier message: 22/09/2015, 19h47
  2. nasm division d'un nombre en facteur de nombre premier
    Par Stanouf dans le forum x86 32-bits / 64-bits
    Réponses: 2
    Dernier message: 10/01/2012, 18h54
  3. Réponses: 1
    Dernier message: 08/04/2009, 13h17
  4. Décomposition en facteurs premiers
    Par Girl24 dans le forum Fortran
    Réponses: 6
    Dernier message: 18/11/2008, 14h08
  5. Décomposition en facteurs premiers
    Par méphistopheles dans le forum Algorithmes et structures de données
    Réponses: 7
    Dernier message: 07/11/2005, 21h56

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo