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
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
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
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
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
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
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
leIf 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
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
"for" principal (je le fait pour 1 seul niveau (cela m'a permis de
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 :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
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
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
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
"for" principal (je le fait pour 1 seul niveau (cela m'a permis de
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 :
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
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
leIf 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
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
"for" principal (je le fait pour 1 seul niveau (cela m'a permis de
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 :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
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 :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
leIf 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
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
"for" principal (je le fait pour 1 seul niveau (cela m'a permis de
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 :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
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 :
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
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
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
"for" principal (je le fait pour 1 seul niveau (cela m'a permis de
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 :
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
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 :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
leIf 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
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
"for" principal (je le fait pour 1 seul niveau (cela m'a permis de
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 :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