TROUVEZ LA LISTE DES NOMBRES PREMIERS TRES RAPIDEMENT !
cs_Sophus
Messages postés
37
Date d'inscription
mercredi 20 novembre 2002
Statut
Membre
Dernière intervention
27 juillet 2007
-
24 nov. 2002 à 16:28
cs_astra Messages postés 21 Date d'inscription samedi 21 décembre 2002 Statut Membre Dernière intervention 19 mars 2004 - 9 mai 2003 à 20:11
cs_astra Messages postés 21 Date d'inscription samedi 21 décembre 2002 Statut Membre Dernière intervention 19 mars 2004 - 9 mai 2003 à 20:11
Cette discussion concerne un article du site. Pour la consulter dans son contexte d'origine, cliquez sur le lien ci-dessous.
https://codes-sources.commentcamarche.net/source/5168-trouvez-la-liste-des-nombres-premiers-tres-rapidement
https://codes-sources.commentcamarche.net/source/5168-trouvez-la-liste-des-nombres-premiers-tres-rapidement
9 mai 2003 à 20:11
je fe po de la pub pour le mien mais celui ci est TRES LENT :)
27 nov. 2002 à 16:30
> http://www.vbfrance.com/article.aspx?Val=6508
(ben j'ai bien le droit de faire un peu de pub now !!! :p :) )
27 nov. 2002 à 13:24
Dim div, nbr, nbrdiv As Long
Dim Lst() As Long
Private Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii < 48 And KeyAscii <> 8 Or KeyAscii > 57 Then KeyAscii = 0
End Sub
Private Sub Command1_Click()
'Initialisation : on rappelle que 1 n'est pas consideré comme un nombre premier
ReDim Lst(0)
nbr = Val(Text1.Text)
div = 2
nbrdiv = 0
Text2.Text = ""
If nbr < 2 Then MsgBox "Quel utilité de calculer ? "
Text1.Locked = True
Command1.Enabled = False
'Le Caption du label3 sera toujours égale a "En Travail :"
'Un autre label ( le 4) indiquera à droite du label3 le nombre
'Ca évitera au pc d'avoir a rajouter a chaque fois "En travail :"
Label3.Caption = "En travail : Test du diviseur :"
While div <= Sqr(nbr) 'Rajouter Int() ralenti t'il le test ? Mais sans Int() le test s'effectue sur des nombre de type single... ce qui ralenti ) A voir ...
Label4.Caption = div & " sur " & Int(Sqr(nbr))
'Plusieurs possiblités :
' --> If nbr/div =int(nbr/div) Then
' --> If nbr mod div Then
' --> If nbr-(nbrdiv)*div Then
If nbr / div = Int(nbr / div) Then
Lst(nbrdiv) = div
nbrdiv = nbrdiv + 1
ReDim Preserve Lst(nbrdiv)
nbr = nbr / div
div = div - 1 ' si nbr multiple de 4 ? il faut retester "2"
End If ' On enleve donc 1 ...
div = div + 1 ' pour le rajouter la . resultat : aucun ( ou alors incremente )
DoEvents
Wend
If nbr Then
For div = 0 To nbrdiv - 1
Text2 = Text2 & Lst(div) & " * "
Next div
Text2 = Text2 & nbr
Else
MsgBox " Votre nombre est premier !"
End If
Text1.Locked = False
Command1.Enabled = True
Label3.Caption = "Factorisation terminée."
End Sub
Je l'ai testé, il marche assez rapidement.
Sinon pour ce qui est de la liste des nombre premier, l'algo de Proger est pas mal, mais sa boucle for ralentie encore le temps de calcul. Pk essayer de diviser par 8 si on sait que le nombre a tester n'ets pas divisible par 2 ?
Donc le mieux c'est carrement de tester els nombre premier inferieur a la racine carre du nombre :
Remplace :
For i = 3 To Int(Sqr(j)) + 1 Step 2
If j Mod i = 0 Then
Exit For
End If
Next i
If j Mod i <> 0 Then
Par :
i=0
Do
i=i+1
Until NPTable(i) > Int(Sqr(j)) Or not( j mod NPtable(i) )
If NPtable(i)>Int(Sqr(j)) Then
Et la suite...
J'en profite pour rapeler a Proger que 1 n'ets pas un nombre premeir. C'ets l'unité.
Voila, je pense que ca t'aidera ...
-={[ZeroCool]}=-
P.S. je vais mettre une source sur les nombres parfaits paires.
26 nov. 2002 à 11:42
car si c'est 30s pour arriver a 220217, c'est grave!
Il me faut 1,3 secondes avec un athlon 700Mo (slota) avec l'algo ci-dessous (5 sec avec l'affichage) :
Function FastNbPrems(MaxiVal As Long) As Long
'calcul tout les nombres premiers jusqu'a une valeur approchant de maxival
'intialisation
Dim NPtable() As Long, NPavance As Long
Dim i As Long, j As Long
ReDim NPtable(0 To 1) As Long
NPtable(0) = 1
NPtable(1) = 3
NPavance = 1
j = 3
'calcul
Do
j = j + 2
For i = 3 To Int(Sqr(j)) + 1 Step 2
If j Mod i = 0 Then
Exit For
End If
Next i
If j Mod i <> 0 Then
NPavance = NPavance + 1
ReDim Preserve NPtable(0 To NPavance)
NPtable(NPavance) = j
'Label1.Caption = j: DoEvents 'ralenti le calcul!
End If
Loop Until j >= MaxiVal
FastNbPrems = NPtable(NPavance)
End Function
(code home-made)
bon en fait le problème du code a Sophus est d'utiliser le disque dur plutôt que la ram pour sauvegarder les valeurs, sinon la théorie est bonne...
Il devrai sauvegarder la liste uniquement à la suspention/reprise du calcul.
25 nov. 2002 à 17:46
24 nov. 2002 à 18:21
lol
24 nov. 2002 à 17:04
Voilà
24 nov. 2002 à 16:53
24 nov. 2002 à 16:49
24 nov. 2002 à 16:44
24 nov. 2002 à 16:28