VBA Nombres premiers

Hello,

Je dois trouver un algorithme VBA qui me permettrait de trouver au moins trois nombres parfaits.

Je bloque totalement à ceci.

Sauriez vous comment le trouver?

PS Un nombre parfait est égal à la somme de ses diviseurs, 1 y compris. Ex : 6=1+2+3.

bonjour,

as-tu déjà une idée de l'algorithme ?

BonsoirJazmincita, H2so4,

as-tu déjà une idée de l'algorithme ?

@H2so4. Cela va te rappeler quelques souvenirs...

Voir ici > Défi de la rentrée

En effet une des particularités des nombres parfaits est qu'il nécessite qu'un des diviseurs soit un nombre premier (impair de surcroît) de Mersenne.

Et surtout que ce nombre premier est un valeur unique dans les diviseurs. Puisque les autres valeurs (colonne 2) sont toutes paires et calculables par 2 puissance rang.

Ci-dessous le tableau réalisé.

En première colonne le rang. En 2ième colonne la formule 2^(ligne()-1). En 3ième colonne la formule (2^ligne()-1).

Le résultat de la multiplication donne le nombre parfait (il se termine soit par 6 ou 8)

Exemple: pour le rang 3 on a donc 2^(3-1) x (2^3-1). Soit 2 puissance 2 = 4 que l'on multiplie par 2 puissance 3 = 8 moins 1 = 7. Donc 4 x 7 = 28

En notes certaines particularités:

Le dernier diviseur étant égale à la moitié du nombre parfait.

Le rang ou l'on peut trouver un nombre parfait est toujours un nombre premier (2,3,5,7,13,17 etc...)

Tous les chiffres ou nombres (hors chiffre 1 et le nombre de Mersenne) étant tous des valeurs paires.

Le nombre de Mersenne étant placé dans l'ordre des diviseurs sur le rang+1 (voir valeur rouge en 5ième colonne). Les valeurs le suivant sont toujours un

multiple de ce nombre de Mersenne.

On peut aussi noter l'équidistance en incluant le nombre parfait (paire de valeurs) donnant le nombre parfait -> 1 x 28, 2 x 14, 4 x 7 pour le rang 3

Il y a ici 17 rangs ou l'on trouve les 6 premiers nombres parfaits.

Dernière précision: les 2 suivants sont de très grands nombres. Il n'existe que 8 nombres parfaits inférieurs à mille trillions (10^21).

Pour vous éviter un long calcul. Voici le 7ème 137 438 691 328 et le 8ième 2 305 843 008 139 952 128.

Envie d'un petit défi ?

@Xcellus,

En voyant les diviseurs des nombres parfaits que j'ai trouvés, j'ai en effet remarqué la présence de ces puissances de 2 et d'une (puissance de 2)-1, mais je n'avais pas fait lien avec les nombres de Mersenne. Ton affirmation est-elle une conjecture ou bien cela a-t-il été démontré ?

En tout cas, merci de cette piqûre de rappel pour ce joli défi que tu nous avais mis.

Bonsoir Jazmincita, H2so4,

Ton affirmation est-elle une conjecture ou bien cela a-t-il été démontré

Ce n'est pas une conjecture, depuis Euler (1707-1783) qui a démontré que ces nombres parfaits était paires.

Or jusqu'à 2021 on n'en décompte que 51 (un petit jaune). Tellement ils sont rares. Encore plus rares que les nombres premiers.

Et comme ils dépendent en plus de ces nombres premiers (par type Mersenne)

Il faut des milliers d'ordinateurs travaillant sur des parties de la recherche pour trouver des nombres premiers gigantesques.

Et parmi ceux là, peut être un Parfait.

Voici par VBA (du moins jusqu'au 17 ième rang) parce qu'ensuite il faut plus passer par le Cray 2000 de Météo France.

Sub NParfait()
For Rg = 2 To 17 'Boucle de Rang (du 2ième jusqu'au 17ième rang)
Mers = (2 ^ Rg) - 1 'Nbre de Mersenne (2ième multiplicateur)
Prem = 2 ^ Rg / 2 'Premier multiplicateur ou bien (Mers + 1) / 2
Cible = Prem * Mers 'Nombre à parfaire
NbDiv = Rg * 2 - 1 'Nombre de diviseurs
'La factorisation du nbre Mersenne doit rendre un nbre 1ier unique égale à Mersenne sinon faux
If Premier(Mers) = 0 Then 'Test Rang sur chiffre ou nbre impair (vu qu'un nbre premier est impair excepté 2)
SomOne = 0: SomTwo = 0: E = -1
For D = 1 To NbDiv 'Boucle sur le nbre de diviseurs
'Premier groupe de valeurs < à Mersenne
If SomOne < Mers Then SomOne = SomOne + 2 ^ (D - 1) Else _
E = E + 1: SomTwo = SomTwo + Mers * 2 ^ E 'Deuxième groupe de valeurs = ou > à Mersenne
If SomOne + SomTwo = Cible Then MsgBox "Nombre Parfait =" & Cible 'Egalité Sommation et Cible
Next D
End If
Next Rg
End Sub

Et en complément une Fonction Premier qui l'accompagne. Afin de zapper certains rangs et notamment le rang 11 qui malgré qu'il soit un nombre premier.

Le nombre de Mersenne (2047) ne l'est pas car il a deux facteurs: 23 x 89

Function Premier(T As Long)
F = 0    'Flag
'Chercher un diviseur plus petit ou
'égal à la racine carré du nombre testé
For V = 2 To Sqr(T)
'Si on trouve au moins un premier diviseur
'le Flag est inversé puis sortie de boucle
If T Mod V = 0 Then F = 1: Exit For
Next
Premier = F
End Function

En tout cas, merci de cette piqûre de rappel pour ce joli défi que tu nous avais mis.

Et tu y avais participé grandement et avec brio.