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

**Hervé le vieux** · 04/11/2018, 09h37

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 VBA :

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 VBA :

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 VBA :

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 VBA :

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

**tbc92** · 04/11/2018, 15h31

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.

**Hervé le vieux** · 04/11/2018, 15h40

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.

**Hervé le vieux** · 06/11/2018, 09h49

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 VBA :

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 VBA :

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 VBA :

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

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

Algorithmes et structures de données

Discussions similaires

Partager

Partager