Excel - Accélérer et/ou simplifier une macro

Bonjour,

Content de savoir que le MPFE est toujours vivant
et que ça collabore encore.
Depuis que j'ai attrapé la fièvre Facebook, j'ai délaissé
Excel mais là j'aurais une tite question pour vous.
Je suis à la recherche des nombres narcissiques !
Un nombre narcissique contenant n chiffres est un nombre
égal à la somme de chacun de ses chiffres à la n ième puissance.
Exemples :
153 = 1^3 +5^3 + 3^3
1634 = 1^4 + 6^4 + 3^4 + 4^4
548 834 = 5^6 + 4^6 + 8^6 + 8^6 + 3^6 + 4^6
Il en existe seulement 88.
Voici une macro me permettant de trouver des nombres
narcissiques contenant 8 chiffres. Elle m'a permis d'en trouver trois
mais je me demande si je pourrais l'accélérer (19 minutes) ou la simplifier.
La voici et je vous remercie à l'avance :

Sub Nombres_Narcissiques()
Dim T As Double
T = Timer
Dim x(1 To 8) As Long
For i = 10000000 To 99999999
For j = 1 To 8
x(j) = Mid(i, j, 1)
Next j
If x(1) ^ 8 + x(2) ^ 8 + x(3) ^ 8 + x(4) ^ 8 + x(5) ^ 8 + x(6) ^ 8 + x(7) ^ 8 + x(8) ^ 8 = i Then
k = k + 1
Cells(k, 1) = i
End If
Next i
Range("B1") = Application.Round((Timer - T), 1) & " Sec"
End Sub

Serge

Avec la d?finition que tu donnes, j'ai l'impression que
si 153 est un nombre narcissique alors
135, 531, 513, 351 et 315 le sont aussi, non ?

Si c'est le cas, je ne vois pas d'ou sort le 88, puisque rien qu'avec
les permutations de 548834 on doit d?passer ce nombre.

si les permutations ne sont pas autoris?es, quelle est la r?gle pour
d?finir quelle est la bonne ? (cela peut ?tre important pour tes
optimisations).

Le 25/04/2012 17:35, Tatanka a ?crit :

Salut "bcar",

153 est narcissique car 153 = 1^3 + 5^3 + 3^3
mais 135, 531, 513, 315 et 351 ne le sont pas car
si tu fais la somme des cubes de chacun de leurs chiffres,
tu obtiendras toujours 153.

Serge

Bonjour,

Hum, 153 = 1^3 + 5^3 + 3^3

Donc 135, 531, 513, 351 et 315 ?tant diff?rent de 153 ils ne peuvent pas ?tre narcissiques (si j'ai bien compris).

bcar a ?crit :

Salut Michel,

153 = 1^3 + 5^3 + 3^3, donc narcissique. Mais
135 n'est pas égal à 1^3 + 3^3 + 5^3 (153)
531 n'est pas égal à 5^3 + 3^3 + 1^3 (153)
135 n'est pas égal à 1^3 + 3^3 + 5^3 (153)
...

Serge

Et voici la liste des 88 nombres narcissiques :

http://mathworld.wolfram.com/NarcissisticNumber.html

A+
Serge

Bonsoir,

J'ai trouvé plus simple comme macro mais elle est
encore plus lente que la première !

Sub Nombres_Narcissiques2()
Dim s As Long
For i = 10000000 To 99999999
For j = 1 To 8
s = s + Mid(i, j, 1) ^ 8
Next j
If s = i Then
k = k + 1
Cells(k, 1) = i
End If
s = 0
Next i
End Sub

Serge

Bonjour Serge
une p'tit question
à quoi sert un nombre narcissique?

jn9kao$i8g$1@speranza.aioe.org...

Salut Fredo,

Pour le moment, à ce que je sache, à rien :-)
Beaucoup de mathématiciens ne pensent qu'à s'amuser !
Les spécialistes de la théorie des nombres du début du 20e siècle
juraient que ça ne servirait jamais à rien de tripoter les nombres
premiers mais aujourd'hui, c'est un des outils indispensables pour
la sécurité informatique...

Serge

D?sol?, la fatigue...

Le 25/04/2012 18:46, Tatanka a ?crit :

Merci pour l'info
Ma bécane, avec la première routine exposée m'est 596 sec pour sortir
24678050
24678051
88593477


Mémoire DDR3 PC3-10666 2 Go 1333 Mhz
Carte mère MSI GF615M P33 - Socket AM3 pour processeur AMD  Sempron AM3

jn9pe6$hj$1@speranza.aioe.org...

Bonsour?

J'ai trouv? plus simple comme macro mais elle est
encore plus lente que la premi?re !
*************************************
peut-etre en n'explorant que les nombres multiples de N
(pas test?)
*************************************
Sub Nombres_Narcissiques2()
Dim s As Long
For i = 10^N To 10^(N+2) step N
For j = 1 To N
s = s + Mid(i, j, 1) ^ n
Next j
If s = i Then
k = k + 1
Cells(k, 1) = i
End If
s = 0
Next i
End Sub
****************************

Apr?s ma question (d?bile) d'hier soir, voila les principes qui te
permettront de faire tourner ton algo en quelques secondes

je te conseille de suivre les ?tapes et de constater (ou non) les
am?liorations progressivement

- utilise "option explicit" (cela t'obligera ? d?clarer tes variables)
- type tes variables
- tu peux utiliser Application.ScreenUpdating = False (anecdotique ici)
- tu peux utiliser Application.Calculation = xlCalculationManual
(anecdotique ici)

Evitons les calculs inutiles
d?j? on remarque que 9^8 * 3 = 129 140 163 (9 chiffres)
donc tout nombre sup?rieur ? 99900000 ne conviendra pas
donc on fait For i = 10000000 To 99900000
'au lieu de For i = 10000000 To 99999999

Le but du jeu va ?tre de ne pas refaire 100 fois les m?me calculs
on va donc construire un tableau des puissances

Dim precalc(0 To 9) As Long
For i = 0 To 9
precalc(i) = i ^ 8
Next i

Ainsi les calculs de puissance ne seront plus ? refaire, il suffira
d?acc?der au tableau

le

se transforme donc en

If precalc(x(1)) + precalc(x(2))
+ precalc(x(3)) + precalc(x(4))
+ precalc(x(5)) + precalc(x(6))
+ precalc(x(7)) + precalc(x(8)) = i Then

ou encore mieux puisque on peut consid?rer que le
'For j = 1 To 8
'  x(j) = Mid(i, j, 1)
'Next j
n'est pas n?cessaire

If precalc(CLng(Mid(i, 1, 1))) + precalc(CLng(Mid(i, 2, 1)))
+ precalc(CLng(Mid(i, 3, 1))) + precalc(CLng(Mid(i, 4, 1)))
+ precalc(CLng(Mid(i, 5, 1))) + precalc(CLng(Mid(i, 6, 1)))
+ precalc(CLng(Mid(i, 7, 1))) + precalc(CLng(Mid(i, 8, 1))) = i Then

l? d?j? on devrait avoir gagn? un petit peu de temsp
mais pas encore assez pour en gagner encore plus on va d?boucler le
descendre ? 30 secondes) mais tu peux gagner encore plus en d?bouclant
plusieurs niveaux

tu constate donc que
quand tu passe de xxx xxx x{0-8} ? xxx xxx x{0-8} + 1
il n'y a qu'un chiffre qui change
Pourquoi alors refaire tout le calcul

on declare plus haut un
dim partialSum as long

et on fait

For i = 10000000 To 99900000 Step 10
partialSum = precalc(CLng(Mid(i, 1, 1))) + precalc(CLng(Mid(i, 2, 1)))
+ precalc(CLng(Mid(i, 3, 1))) + precalc(CLng(Mid(i, 4, 1)))
+ precalc(CLng(Mid(i, 5, 1))) + precalc(CLng(Mid(i, 6, 1)))
+ precalc(CLng(Mid(i, 7, 1)))

If partialSum = i Then
k = k + 1
Cells(k, 1) = i
End If
If partialSum + precalc(1) = i + 1 Then
k = k + 1
Cells(k, 1) = i + 1
End If
If partialSum + precalc(2) = i + 2 Then
k = k + 1
Cells(k, 1) = i + 2
End If
...
...
...
If partialSum + precalc(9) = i + 9 Then
k = k + 1
Cells(k, 1) = i + 9
End If

next i

pour tester 10 nombres, au lieu de faire
10*7 = 70 additions (? la louche)
on ne va en faire que 6 + 9 (+9 (pour les i + x)) = 24 !!!

Bon il y a toujours une grosse perte de temps (pas v?rifier mais presque
sur) sur la partie long=>string=>long, il y a moyen de faire mieux...

Pour pousser presque encore plus on peut envisager
(je ne met pas d'indentation volontairement)
...
Dim sumPartial As Long
Dim number As Long
number = 0
sumPartial = 0
For i8 = 1 To 9
number = number + i8 * 10000000
sumPartial = sumPartial + precalc(i8)
For i7 = 0 To 9
number = number + i7 * 1000000
sumPartial = sumPartial + precalc(i7)
For i6 = 0 To 9
number = number + i6 * 100000
sumPartial = sumPartial + precalc(i6)
For i5 = 0 To 9
number = number + i5 * 10000
sumPartial = sumPartial + precalc(i5)
For i4 = 0 To 9
number = number + i4 * 1000
sumPartial = sumPartial + precalc(i4)
For i3 = 0 To 9
number = number + i3 * 100
sumPartial = sumPartial + precalc(i3)
For i2 = 0 To 9
number = number + i2 * 10
sumPartial = sumPartial + precalc(i2)
For i1 = 0 To 9
number = number + i1
sumPartial = sumPartial + precalc(i1)
If sumPartial = number Then
k = k + 1
Cells(k, 1) = number
End If
number = number - i1
sumPartial = sumPartial - precalc(i1)
Next i1
number = number - i2 * 10
sumPartial = sumPartial - precalc(i2)
Next i2
number = number - i3 * 100
sumPartial = sumPartial - precalc(i3)
Next i3
number = number - i4 * 1000
sumPartial = sumPartial - precalc(i4)
Next i4
number = number - i5 * 10000
sumPartial = sumPartial - precalc(i5)
Next i5
number = number - i6 * 100000
sumPartial = sumPartial - precalc(i6)
Next i6
number = number - i7 * 1000000
sumPartial = sumPartial - precalc(i7)
Next i7
number = number - i8 * 10000000
sumPartial = sumPartial - precalc(i8)
Next i8
...

la ca commence vraiment ? poutrer,
en exercice, je te laisse le soin de d?boucler le for repr?sentant les
unit?s (ce n'est pas excessif et on doit encore bien gagner)

En conclusion, pour aller plus vite il te faudra d'une part identifier
et ?viter les calcules inutiles et identifier et supprimer les calculs
redondants. Il y a surement mati?re ? encore pas mal d'optimisation dans
tout ce qui a ?t? expos? ici.

bcar


Le 25/04/2012 17:35, Tatanka a ?crit :

Bon jour, Beethoven ....

Jacquouille

jnb0gi$lo7$1@speranza.aioe.org...

Bonsour?

J'ai trouv? plus simple comme macro mais elle est
encore plus lente que la premi?re !
*************************************
peut-etre en n'explorant que les nombres multiples de N
(pas test?)
*************************************
Sub Nombres_Narcissiques2()
Dim s As Long
For i = 10^N To 10^(N+2) step N
For j = 1 To N
s = s + Mid(i, j, 1) ^ n
Next j
If s = i Then
k = k + 1
Cells(k, 1) = i
End If
s = 0
Next i
End Sub
****************************

Juste encore une petite pr?cision par rapport au typage des variable et
aux cast implicites ou explicites non maitris?s :

sur mon PC pour la premi?re solution propos?e (un seul For (don pas la
plus rapide))

si on fait :

...
For i = 10000000 To 99800000 Step 10
partialSum = precalc(CLng(Mid(i, 1, 1)))
+ precalc(CLng(Mid(i, 2, 1)))
+ precalc(CLng(Mid(i, 3, 1)))
+ precalc(CLng(Mid(i, 4, 1)))
+ precalc(CLng(Mid(i, 5, 1)))
+ precalc(CLng(Mid(i, 6, 1)))
+ precalc(CLng(Mid(i, 7, 1)))
...

=> 36 secondes

mais on fait :

...
dim nb as string
For i = 10000000 To 99800000 Step 10
nb = Cstr(i) ' -- On cast une seule fois au lieu de 7 !
partialSum = precalc(CLng(Mid(nb, 1, 1)))
+ precalc(CLng(Mid(nb, 2, 1)))
+ precalc(CLng(Mid(nb, 3, 1)))
+ precalc(CLng(Mid(nb, 4, 1)))
+ precalc(CLng(Mid(nb, 5, 1)))
+ precalc(CLng(Mid(nb, 6, 1)))
+ precalc(CLng(Mid(nb, 7, 1)))
...

=> 24 secondes (33% de temps de gagn? !)

apr?s on peut se dire que ce qui nous fait perdre du temps c'est le Clng
alors on peut feinter un peu en modifiant notre tableau pr?calcul?
on saite que
asc("0") = 48
asc("9") = 57

on Fait donc :

...
Dim precalc(48 To 57) As Long
For i = 48 To 57
precalc(i) = (i - 48) ^ 8
Next i
dim nb as string
For i = 10000000 To 99800000 Step 10
nb = Cstr(i) ' -- On cast une seule fois au lieu de 7 !
partialSum = precalc(asc(Mid(nb, 1, 1)))
+ precalc(asc(Mid(nb, 2, 1)))
+ precalc(asc(Mid(nb, 3, 1)))
+ precalc(asc(Mid(nb, 4, 1)))
+ precalc(asc(Mid(nb, 5, 1)))
+ precalc(asc(Mid(nb, 6, 1)))
+ precalc(asc(Mid(nb, 7, 1)))
...

=> 16 secondes encore (33% de gagn? ou 50% depuis le d?but !)

Alors ok on est toujours loin des environ 2 secondes (si tu as fait le
d?bouclage des unit?) de la seconde m?thode propos?e
(sans cast puisqu'on ne travaille qu'avec des symboles num?riques).

Mais cela illustre bien le "danger" des conversions implicites ou non

bcar


Le 26/04/2012 10:55, bcar a ?crit :

Encore quelques pistes pour passer sous la seconde peut ?tre :

pour am?liorer la lisibilit? on consid?rera la proc?dure suivante :

' --Incr?mente le num?ro de la ligne et affiche le r?sultat
Private Sub pInc(ByRef k As Integer, ByVal number As Long)
k = k + 1
Feuil1.Cells(k, 1) = number
End Sub

On va utiliser un deuxi?me tableau pr?calcul? pour le d?bouclage des
unit? (cela peut quand m?me faire gagner 90 000 000  d'additions :

puisqu'on fait
sumPartial + precalc(1) = number + 1
sumPartial + precalc(2) = number + 2
...
sumPartial + precalc(n) = number + n
autant int?grer le plus n dans le precalc

donc on va avoir :

' -- Utilis? pour incr?menter sumPartial avec les 7 premiers chiffres
Dim precalc(0 To 9) As Long
For i = 0 To 9
precalc(i) = i ^ 8
Next i

' -- Utilis? pour incr?menter sumPartial avec les unit?s
Dim precalcFinal(0 To 9) As Long
For i = 0 To 9
precalcFinal(i) = i ^ 8 - i
Next i

on fait les 7 For pour les 7 premiers chiffres puis :

If sumPartial = number Then Call printAndInc(k, number)
If sumPartial + precalcFinal(1) = number Then Call pInc(k, number + 1)
If sumPartial + precalcFinal(2) = number Then Call pInc(k, number + 2)
...
If sumPartial + precalcFinal(9) = number Then Call pInc(k, number + 9)

On gagne ainsi environ 10%

pour gagner encore un peu, on peu se dire que les tests des 9 unit?s ne
sont pas utiles, on rajoute un petit test :
If sumPartial + precalcFinal(5) < number Then

de mani?re ? diviser en 2 notre "groupe d'unit?s" et on obtient

If sumPartial + precalcFinal(5) < number Then
If sumPartial = number Then Call printAndInc(k, number)
If sumPartial + precalcFinal(1) = number Then Call pInc(k, number + 1)
If sumPartial + precalcFinal(2) = number Then Call pInc(k, number + 2)
If sumPartial + precalcFinal(3) = number Then Call pInc(k, number + 3)
If sumPartial + precalcFinal(4) = number Then Call pInc(k, number + 4)
Else
If sumPartial + precalcFinal(5) = number Then Call pInc(k, number + 5)
If sumPartial + precalcFinal(6) = number Then Call pInc(k, number + 6)
If sumPartial + precalcFinal(7) = number Then Call pInc(k, number + 7)
If sumPartial + precalcFinal(8) = number Then Call pInc(k, number + 8)
If sumPartial + precalcFinal(9) = number Then Call pInc(k, number + 9)
End If

pour gratter encore un peu, on peut, dans chacune des branche du if
initial, r?p?ter l'op?ration avec :
If sumPartial + precalcFinal(3) < number Then
et
If sumPartial + precalcFinal(8) < number Then

bcar

Le 27/04/2012 09:58, bcar a ?crit :

Bonjour,

En maths, on conna=EEt deux fa=E7ons de d=E9finir un ensemble :
- par compr=E9hension
- par extension

La premi=E8re consiste =E0 donner une d=E9finition, comme tu l'as fait.
La deuxi=E8me consiste =E0 donner la liste compl=E8te des =E9l=E9ments.

Puisque tous les nombres concern=E9s sont connus, probablement on aurait =

un moyen plus rapide de les afficher en les mettant dans une table, ou=20
une liste.