Pour trouver tous les nombres premiers, nous allons utiliser la méthode du crible d'Eratosthène. Cela consiste à boucler sur tous les nombres de 2 à n, de vérifier si le nombre "en cours" est un multiple. S'il ne l'est pas, il s'agit d'un nombre premier.
Un nombre premier est un entier naturel qui admet exactement deux diviseurs distincts entiers et positifs (qui sont alors 1 et lui-même).
Fonction
Code appelant
Sub Appel()
Debug.Print EstPremier(31)
Debug.Print EstPremier(42)
Debug.Print EstPremier(Cells(2, 3))
End Sub
Code de la fonction
Function EstPremier(Nb As Integer) As Boolean
Dim i As Long
If Nb = 1 Or Nb = 0 Then Exit Function
For i = 2 To Sqr(Nb)
If Nb Mod i = 0 Then Exit Function
Next i
EstPremier = True
End Function
Nota : Cette fonction personnalisée peut être utilisée comme formule de feuille de calcul. Pour cela, saisir dans la feuille, par exemple :
=EstPremier(A1)
Tous les nombres premiers : algorithme
Pour réaliser ceci, on écrit la liste de tous les nombres jusqu'à NbreMax.
On élimine 1.
On souligne 2 et on élimine tous les multiples de 2.
Puis on fait de même avec 3.
On choisit alors le plus petit nombre non souligné et non éliminé ici 5,
On élimine tous ses multiples.
On réitère le procédé jusqu'à la partie entière de la racine de n.
Les nombres non éliminés sont les nombres premiers jusqu'à n.
Code de la fonction
Le choix du type de cette fonction est due au fait que je souhaitais voir les erreurs apparaitre comme message à l'utilisateur. Nous pourrions facilement la "bricoler" pour que cette fonction nous renvoie un nombre de type Integer ou Long...
Pour des raisons de lenteur de ce code, nous allons également nous limiter aux 1500 premiers nombres premiers...
Function NbPremiers_Eratosthène(Rang As Long) As Variant
'Détermination du nième nombre premier méthode du crible d'Eratosthène
Dim i As Long, j As Long, k As Long, NbreMax As Long, est_premier(), Flag As Boolean
If Rang >= 1 And Rang <= 1500 Then
ReDim Preserve est_premier(Rang)
k = 0
NbreMax = 20 * Rang 'suffit pour un rang < 1500
Flag = True
For i = 2 To NbreMax
For j = 2 To i
If j = i Then Exit For
If i Mod j = 0 Then Flag = False: Exit For
Next
If Flag = True Then
If i = 2 Then
est_premier(k) = 1
k = k + 1
Else
est_premier(k) = i
k = k + 1
End If
Else
Flag = True
End If
If k = Rang Then Exit For
Next i
NbPremiers_Eratosthène = est_premier(Rang - 1)
Else
NbPremiers_Eratosthène = "Rang trop grand ou trop petit (compris entre 1 et 1500 inclus)."
End If
End Function
Code d'appel
Nous avons ici deux possibilités :
Nième nombre premier
Sub Test()
'Pour obtenir le 499ième Nombre premier :
MsgBox NbPremiers_Eratosthène(499)
End Sub
Liste des 99 premiers nombres premiers
Sub ListeNbPrems()
'Pour obtenir la liste des 99 1ers nombres premiers :
Dim i As Long, Msg As String, Tb(98)
For i = 1 To 99
Tb(i - 1) = NbPremiers_Eratosthène(i)
Next i
MsgBox Tb(0) & " " & Tb(1) & " " & Tb(2) & " ... " & Tb(UBound(Tb))
End Sub
Amélioration, optimisation d'un algorithme/code
Il est bien entendu que nous ne nous contenterons pas de trouver les 99 premiers nombres premiers.
L'optimisation n'aurait, dans ce cas, pas lieu d'être.
Le but est de trouver les nombres premiers avec une borne supérieure N très grande, dans un minimum de temps, et une parfaite "stabilité", tout en sachant que :
ce sujet n'a d'autre intérêt que celui d'exercice,
Visual Basic ne battra jamais de records, ni ne trouvera le premier nombre premier inconnu à ce jour,
il ne s'agit pas ici d'une course contre le temps, les résultats donnés le sont uniquement à titre de comparaison.
Note : Pour l'ensemble des codes de la 1ère partie, nous utiliserons la procédure d'appel suivante :
Sub test_Crible()
Dim Tb() As Long, N As Long, T As Single
T = Timer
N = 10000
Tb = Liste_Premiers(N)
Debug.Print "Pour N = " & N & ", durée : " & Timer - T & " seconde, " & _
UBound(Tb) + 1 & " nombres premiers, de " & _
Tb(LBound(Tb)) & " à " & _
Tb(UBound(Tb))
End Sub
I- Avec variables tableau
Première implémentation : l'algorithme naïf
Algo :
Un tableau dimensionné à N dont tous les éléments sont mis à false
On part du chiffre 2 et on met à True tous ses multiples, jusqu'à N (ses multiples correspondront très exactement à leur index dans le tableau)
On passe au suivant et refait la même chose avec ses multiples
Comment cela peut donc bien se traduire en code VBA...
L'algorithme suivant est dit "naïf" car non-optimisé.
Function Liste_Premiers(Max As Long) As Long()
Dim Temp() As Boolean, Liste() As Long, cpt As Long
Dim i As Long, j As Long
ReDim Temp(Max) 'Ici, tous les items de Temp sont False
'double boucle
For i = 2 To Max
For j = i * i To Max Step i
'ici j est le multiple d'un nombre qui lui est inférieur
'==> j n'est donc pas premier
Temp(j) = True
Next
Next i
'restitution
For i = 2 To Max
If Temp(i) = False Then
ReDim Preserve Liste(cpt)
Liste(cpt) = i
cpt = cpt + 1
End If
Next i
Liste_Premiers = Liste
End Function
Résultat pour N = 10 000 : durée : 0 seconde, 1229 nombres premiers, de 2 à 9973
Mais...
Ce code ne peut pas fonctionner sur des N trops grands.
j = i * i entrainant un dépassement de capacité.
Optimisons...
Seconde implémentation : Ainsi naquit Erathostène
Pour ces deux raisons :
accélérer le code,
augmenter la taille de N
il faut :
uniquement tester les impairs premiers déjà trouvés en tant que diviseurs
en se limitant à la racine carrée de n
Cela va nous donner :
1 boucle sur les pairs (pour les éliminer),
1 double boucle réduite (de 1 à MAX, on passe à : de 1 à Sqr(MAX))
1 boucle de restitution
Le code devient donc :
Function Liste_Premiers(Max As Long) As Long()
Dim Temp() As Boolean, Liste() As Long, cpt As Long, racine As Long
Dim i As Long, j As Long
ReDim Temp(Max) 'Ici, tous les items de Temp sont False
'pairs éliminés (hormis 2) :
For i = 4 To Max Step 2
Temp(i) = True
Next
'double boucle sur impairs ET jusqu'à racine carrée de MAX
racine = Sqr(Max)
For i = 3 To racine Step 2
For j = i * i To Max Step i
'ici j est le multiple d'un nombre qui lui est inférieur
'==> j n'est donc pas premier
Temp(j) = True
Next
Next i
'restitution
For i = 2 To Max
If Temp(i) = False Then
ReDim Preserve Liste(cpt)
Liste(cpt) = i
cpt = cpt + 1
End If
Next i
Liste_Premiers = Liste
End Function
A partir de maintenant, nous allons pouvoir tester sur de plus grands nombres. Arbitrairement, choisissons 8 000 000.
Dans la Sub initiale test, remplaçons donc N = 10000 par N = 8000000
Résultat :
durée : 1,832031 seconde, 539777 nombres premiers, de 2 à 7999993
Troisième implémentation : Inutile de repasser 3 fois tes caleçons!
La réflexion suivante va être d'éliminer encore certaines valeurs.
Dans la double boucle, For i = 3 To racine Step 2, on se rends compte, à l'analyse, que l'on passe et repasse sur des nombres déjà traités.
Il n'est pas nécessaire, à titre d'exemple, de traiter les multiples de 9 dans la boucle For j, sachant qu'ils ont déjà été traités dans la boucle For j = 3 * 3 To...
Éliminons les.
Comment?
Juste ajouter un test If Temp(i) = False Then, comme ceci :
Function Liste_Premiers(Max As Long) As Long()
Dim Temp() As Boolean, Liste() As Long, cpt As Long, racine As Long
Dim i As Long, j As Long
'liste des nombres de 1 à Max + attribution du False
ReDim Temp(2 To Max)
'boucle nombres pairs > 2
For i = 4 To Max Step 2
Temp(i) = True
Next
'double boucle
racine = Sqr(Max)
For i = 3 To racine Step 2
If Temp(i) = False Then 'si i n'est pas le multiple d'un nombre inférieur
For j = i * i To Max Step i
'ici j est le multiple d'un nombre inférieur à j
'==> j n'est donc pas premier
Temp(j) = True
Next
End If
Next i
'restitution
For i = 2 To Max
If Temp(i) = False Then
ReDim Preserve Liste(cpt)
Liste(cpt) = i
cpt = cpt + 1
End If
Next i
Liste_Premiers = Liste
End Function
Les résultats :
Pour N = 8000000, avec Crible Tableau, durée : 1,216797 seconde, 539777 nombres premiers trouvés.
Quatrième implémentation : Ce n'est pas la peine de ReDim un max
Nous avons trois boucles :
Elimination des pairs
double boucle optimisée précédemment
une boucle de restitution.
Comment réduire le temps d'exécution.
Ici, il faut faire appel à l'optimisation d'un code VBA pur et simple.
Dans la boucle de restitution, on ReDim un tableau à de nombreuses reprises (plus de 500000 fois).
Nous allons donc le dimensionner avant pour le redimensionner après son alimentation.
Le code devient donc :
Function Liste_Premiers(MAX As Long) As Long()
Dim Temp() As Boolean, Liste() As Long, cpt As Long, racine As Long
Dim i As Long, j As Long
ReDim Temp(2 To MAX)
'Dimensionnement du tableau des résultats
ReDim Liste(MAX / 2)
'boucle des pairs
For i = 4 To MAX Step 2
Temp(i) = True
Next
'double boucle
racine = Sqr(MAX)
For i = 3 To racine Step 2
If Temp(i) = False Then
For j = i * i To MAX Step i
Temp(j) = True
Next
End If
Next i
'restitution
For i = 2 To MAX
If Temp(i) = False Then
Liste(cpt) = i
cpt = cpt + 1
End If
Next i
'redimensionnement final
ReDim Preserve Liste(cpt - 1)
Liste_Premiers = Liste
End Function
Résultats pour N = 8 000 000 :
durée : 0,7578125 seconde, 539777 nombres premiers, de 2 à 7999993
Cinquième implémentation : Le fermier dans son pré
Pouvons nous encore gagner en temps d'exécution?
Nous avons toujours 3 boucles. N'y a t'il pas moyen de s'en passer?
Analogie :
Le fermier voisin possède un champs de 3 hectares remplit de choux rouges et blancs.
Lorsqu'il est amené à compter ses choux rouges, je ne le vois pas arracher ses choux blancs pour après refaire le même parcours en comptant ses choux rouges!
Revenons en à nos nombres pairs.
Nous avons compris qu'il fallait les éviter pour ne pas avoir à "passer" la double boucle sur tous les nombres.
Plutôt que de les éviter, supprimons les de l'équation. Ignorons les dans la boucle de restitution!
Grâce à cela, nous évitons une boucle (la première) et réduisons la dernière boucle dite de restitution!
Le code :
Function Liste_Premiers(Max As Long) As Long()
Dim Temp() As Boolean, Liste() As Long, cpt As Long, racine As Long
Dim i As Long, j As Long
ReDim Temp(2 To Max)
ReDim Liste(Max \ 2)
'double boucle
racine = Sqr(Max)
For i = 3 To racine Step 2
If Temp(i) = False Then
For j = i * i To Max Step i
Temp(j) = True
Next
End If
Next i
'restitution
Liste(0) = 2
For i = 3 To Max Step 2
If Temp(i) = False Then
cpt = cpt + 1
Liste(cpt) = i
End If
Next i
ReDim Preserve Liste(cpt)
Liste_Premiers = Liste
End Function
Résultats pour N = 8 000 000 :
durée : 0,5 seconde, 539777 nombres premiers, de 2 à 7999993
Autre modèle : avec Mod, Modulo
L'utilisation de Mod sera forcément plus lente.
Qu'à cela ne tienne, testons !
Nous utiliserons 1 000 000 pour tester.
Voici le code optimisé par Marc-L (développez.com) :
Sub DemoMod1NombresPremiers()
Dim T!, d&, NP&(), N&, R#, c&, L&
T! = Timer
d& = 1000000
ReDim NP(d \ 2, 0): NP(0, 0) = 2
For N = 3 To d Step 2
R# = Sqr(N)
For c& = 0 To L&
If N Mod NP(c, 0) Then
If NP(c, 0) > R Then L = L + 1: NP(L, 0) = N: Exit For
Else
Exit For
End If
Next
Next
Debug.Print "Modulo1 : "; Format(Timer - T, "0.000s"), L + 1
End Sub
Le résultat :
Modulo1 pour : 1 000 000 trouve 78 497 solutions en : 1,422s
Le modulo est donc à la traîne par rapport au crible.
II- Avec Collection
En poussant les tests, on se rends compte que le dernier code de crible nous permet de traiter les nombres premiers jusqu'à de grands nombres (pour Excel bien sur !).
Par exemple, nous obtenons un résultat pour N = 100 000 000, et cela, en un temps "relativement acceptable" :
Pour N = 100 000 000, avec Crible Tableau, durée : 6,81 seconde, 5 761 455 nombres premiers trouvés.
En poussant plus loin, néanmoins, on se heurte à deux problèmes :
la stabilité : lors de l'exécution du code, il arrive que VBA ne réponde plus,
la capacité mémoire de l'ordinateur.
Sur le mien, en tentant N = 150 000 000, le code bloque sur la ligne ReDim Liste(MAX / 2) pour une erreur d'exécution 7. Mémoire insuffisante.
Il en va de même pour notre tableau de Boolean Temp() qui lui bloque un peu plus tard...
Comment pallier cela, quitte à perdre de la rapidité?
La Collection est la solution.
Pour aller plus haut ! :
On reprend donc le dernier code de crible en remplaçant la variable tableau Liste par une collection : NBP.
Nous perdrons en rapidité, mais gagnerons en amplitude.
Remarque : Sub et non plus Function.
Sub NBP_Collection_1()
Dim Temp() As Boolean, NBP As New Collection
Dim racine As Long, Max As Long, i As Long, j As Long
Dim T As Single
Max = 25000000
T = Timer
ReDim Temp(2 To Max)
NBP.Add 2
'double boucle
racine = Sqr(Max)
For i = 3 To racine Step 2
If Temp(i) = False Then
For j = i * i To Max Step i
Temp(j) = True
Next
End If
Next i
'restitution
For i = 3 To Max Step 2
If Temp(i) = False Then NBP.Add i
Next i
T = Timer - T
Debug.Print "Pour N = " & Format(Max, "#,##0") & ", avec Crible Collection, durée : " & Format(T, "0.000s") & " seconde, " & _
Format(NBP.Count, "#,##0") & " nombres premiers trouvés."
End Sub
Résultats :
Pour N = 150 000 000, avec Crible Collection, durée : 15,213s seconde, 8 445 858 nombres premiers trouvés.
Pour N = 200 000 000, avec Crible Collection, durée : 20,426s seconde, 11 080 599 nombres premiers trouvés.
Pour N = 250 000 000, avec Crible Collection, durée : 30,656s seconde, 14 860 683 nombres premiers trouvés.
Au delà, le problème de mémoire insuffisante se pose toujours pour le dimensionnement de la variable Temp() As Boolean.
Collection 2ème essai : Naïveté quand tu nous tiens...
Si, au lieu d'éliminer les "non premiers", on se contentait de garder les "premiers".
L'avantage de la collection ici réside dans l'utilisation de sa clé.
Si une même clé est utilisée deux fois, cela génère une erreur.
En annulant le gestionnaire d'erreur, on fait en sorte que cette seconde "entrée" ne soit pas enregistrée.
Ainsi :
On Error Resume Next
maColl.Add 3, "cle"
maColl.Add 9, "cle"
aura pour effet de ne stocker que 3 dans la collection.
Il nous faut donc imposer la même clé pour tous les multiples de 3, une autre clé pour tous les multiples de 5, une autre clé pour tous les multiples de 7, etc...
Pour cela, il nous faut une double boucle de création de clé et utiliser Mod (que l'on sait lent).
Sub Avec_Collection()
Dim NbPrems As New Collection
Dim i&, T!, S&, N&
N = 1000000
S = Sqr(N)
T = Timer
NbPrems.Add 2, "2"
For i = 3 To N Step 2
On Error Resume Next
NbPrems.Add i, Cle(i, S)
Next
T = Timer - T
Debug.Print "Pour N = " & Format(N, "#,##0") & ", avec Crible Collection, durée : " & Format(T, "0.000s") & " seconde, " & _
Format(NbPrems.Count, "#,##0") & " nombres premiers trouvés."
End Sub
Sub Avec_Dico()
Dim d As Object
Dim i&, T!, S&, N&, c$
Set d = CreateObject("Scripting.Dictionary")
N = 1000000
S = Sqr(N)
T = Timer
d.Add "2", 2
For i = 3 To N Step 2
c = Cle(i, S)
If Not d.Exists(c) Then d.Add c, i
Next
Debug.Print "dico " & Timer - T & " " & d.Count
End Sub
Function Cle(Nb As Long, Tot As Long) As String
Dim i&, T!
For i = 3 To Tot Step 2
'abandonné car plus lent que Mod :
'If Nb / i = Nb \ i Then Cle = i: Exit Function
If Nb Mod i = 0 Then
Cle = i
Exit Function
End If
Next
Cle = Nb
End Function
Les résultats :
Pour N = 1 000 000, avec Collection, durée : 4,041s seconde, 78 498 nombres premiers trouvés.
Pour N = 1 000 000, avec dictionary, durée : 3,775s seconde, 78 498 nombres premiers trouvés.
Ici l'utilisation de Mod et d'une clé String ralentissent énormément le code.
Collection 3ème essai : de pire en pire !
Pour se passer de Mod, il va nous falloir penser différemment.
Ne plus comparer systématiquement tous les multiples, mais les supprimer.
Pour les supprimer, il faut que la liste soit préalablement établie.
Ici, nous allons donc :
établir la collection des nombres impairs,
réaliser une double boucle de suppression des multiples
Sub NBP_Collection_Remove()
Dim NBP As New Collection
Dim racine As Long, Max As Long, i As Long, j As Long
Dim T As Single
Max = 1000000
T = Timer
NBP.Add 2, "2"
'boucle initiale
For i = 3 To Max Step 2
NBP.Add i, CStr(i)
Next
'double boucle
racine = Sqr(Max)
For i = 3 To racine Step 2
For j = i * 2 To Max Step i
On Error Resume Next
NBP.Remove CStr(j)
Next
Next i
T = Timer - T
Debug.Print "Pour N = " & Format(Max, "#,##0") & ", avec Collection.Remove, durée : " & Format(T, "0.000s") & " seconde, " & _
Format(NBP.Count, "#,##0") & " nombres premiers trouvés."
End Sub
Les résultats :
Pour N = 10 000, avec Collection.Remove, durée : 0,141s seconde, 1 229 nombres premiers trouvés.
Pour N = 100 000, avec Collection.Remove, durée : 1,875s seconde, 9 592 nombres premiers trouvés.
Pour N = 1 000 000, avec Collection.Remove, durée : 27,008s seconde, 78 498 nombres premiers trouvés.
Nous avons toujours ce souci des String (dans la clé) qui ralentissent le code.
Cet article est régulièrement mis à jour par des experts sous la direction de Jean-François Pillou, fondateur de CommentCaMarche et directeur délégué au développement numérique du groupe Figaro.
