Function Np(ByVal A As Double, Optional ByVal Opt As Variant = "?") 'Si Opt="?" : Renvoi VRAI ou FAUX selon que le nombre est premier ou pas 'Si Opt="pn" : renvoi la valeur du Nième nb premier 'Si Opt="pi" : renvoi le nombre de nombre premier inférieurs ou égal à A : pi(x) 'Si Opt="fact" : renvoi la décomposition en facteurs premiers 'Traitement du type Opt = LCase(CStr(Opt)) If Opt = "?" Then Np = CBool(False) If Opt = "np" Or Opt = "pi" Then Np = CDbl(Np) If Opt = "fact" Then Np = CStr(Np) 'Traitement A en entier positif A = Abs(Int(A)) 'Définitions des variables optimisés par le type de déclaration (Long ou Double) Dim B As Double, nb() As Byte Dim liste As Long, Saut As Long, t As Long, A1 As Long, A2 As Long If A > 2147483647 Then 'valeur limite du type long liste = CDbl(liste): Saut = CDbl(Saut): t = CDbl(t): A1 = CDbl(A1): A2 = CDbl(A2) End If 'Traitement option Select Case Opt Case "?" 'VRAI ou FAUX ? 'Reponse Select Case A Case Is <= 1 Np = False Case Else Np = (NbDiv(A) = 1) End Select Case "pi" 'Fonction pi(x) 'Cas particuliers If A < 2 Then Np = 0: Exit Function If A = 2 Then Np = 1: Exit Function 'Valeurs des bornes A1 = Int((A ^ 0.5 - 3) / 2) A2 = Int((A - 3) / 2) 'Cherche nb premier GoSub Eratosthene 'Compte le nb de nb premiers For t = 0 To A2 If nb(t) = 0 Then B = B + 1 End If Next t Np = B + 1 Case "pn" 'Valeur du Nième nombre premier If A = 1 Then Np = 2: Exit Function 'Borne supérieure de recherche : formule empirique testée jusqu'à A=2 millions 'Le mini est atteint pour A=26218 Dim bs As Double bs = A * (Log(A) + Log(Log(A))) + 232 - A / 1.05 'Valeurs des bornes A1 = Int((bs ^ 0.5 - 3) / 2) A2 = Int((bs - 3) / 2) 'Cherche nb premier GoSub Eratosthene 'Compte B = 1 For t = 0 To A2 If nb(t) = 0 Then B = B + 1 If B = A Then Np = 2 * t + 3: Exit Function End If Next t Np = B Case "fact" 'Décomposition en facteurs premiers If A = 0 Then Np = "0": Exit Function Dim memnb As Double 'Boucle de recherche Do B = NbDiv(A) If B = 1 Then Exit Do t = 0 Do memnb = B: A = A / B: t = t + 1: B = NbDiv(A) Loop While B = memnb t = IIf(memnb = A, t + 1, t) Np = Np & Trim(Str(memnb)) & IIf(t > 1, "^" & Trim(t), "") & "*" Loop Until B = 1 If A <> memnb Then Np = Np & Trim(Str(A)) 'rajoute la dernière valeur Else Np = Left(Np, Len(Np) - 1) 'enlève la dernière étoile End If End Select Exit Function Eratosthene: 'Tableau de nb ReDim nb(A2) 'Crible : Génère la liste des nombres premiers impair For liste = 0 To A1 If nb(liste) = 0 Then Saut = 2 * liste + 3 For t = (Saut ^ 2 - 3) / 2 To A2 Step Saut nb(t) = 1 Next t End If Next liste Return End Function