Calcul détaillé de factoriel

Soyez le premier à donner votre avis sur cette source.

Vue 12 515 fois - Téléchargée 368 fois

Description

le code VBA d'excel permet de donner chiffre à chiffre le résultat du calcul de factoriel d'un nombre. L'objectif était par la création de cette très longue chaine de chiffres, de pouvoir l'utiliser pour la randomisation et ne jamais obtenir les même valeurs, mais aussi pour comparer les vitesses de calculs de machines.
En modifiant les dimensions du tableau tablo(), on peut calculer de grands factoriels. Au-delà du côté apparamment futile, les calculs peuvent aussi permettre de vérifier les écarts entre 2 machines (générations d'erreurs).
par ailleurs, et je le mets dans le code, VBA contient un bogue que j'ai noté Bogue de VBA, au milieu du code et que j'ai du traiter.
Cet exercice, j'en avais besoin il y a plus longtemps que ne l'indique la date de ce projet, pour traiter de l'analyse combinatoire.

Source / Exemple :


Private Sub CommandButton1_Click()
'---------------------------------- Daniel Baudry -------------------
'    koomky@free.fr
'
'                          1 février 2008 - 52200 Langres
'
'--------------------------------------------------------------------
'Objet:
' ce code permet de calculer le factoriel de n'importe quel nombre
' pourvu que le dimensionnement du tableau appelé 'tablo()' soit fait
' en cohérence avec la dimension du résultat, en donnant tous les chiffres
'les uns derriere les autres, du résultat du factoriel
'
' Pour ce faire, si vous voyez que le résultat n'apparait pas ou que le
' code s'arrête, redimensionner tablo(), ainsi que xtablo et ytablo qui
' vont avec un peu plus loin en dessous.
'--------------------------------------------------------------------
'Principe:
' quand on multiplie un nombre par un autre (qu'il ait n chifrres ou 1 seul)
' on stocke chaque résultat dans un tableau, une ligne de tablo() récupérant
' les opérations d'un opérande.
' on stocke toutes les lignes des opérations, chacune d'elles relevant d'un
' opérande. exemple dans 18 x 17, une ligne de tablo stocke 1x7 et 8x7
' une autre ligne stocke 1x1 et 8x1.
' on fait la somme des lignes qu'on stocke dans une autre ligne de tablo(),
' puis on extrait les unités dans chaque cellule de tablo() et les dizaines
' sont additionnées à la cellule voisine de gauche.
' De proche en proche, la ligne de tablo() ne contient plus que des valeurs à
' 1 chiffre.
' par itérations successives, on remultiplie le résultat par la valeur suivante
' n-1, jusqu'à ce que n=1.
' on affiche ensuite le résultat final en entier et par tranches de 100 caractères
'allant de 0 à 9.
'
'--------------------------------------------------------------------------------
'mise en page
'--------------------------------------------------------------------------------
'nettoyage colonne C et plage calculs
ActiveSheet.Range("C2:c500").Select
Selection.ClearContents
ActiveSheet.Range("d2:d500").Select
Selection.ClearContents
ActiveSheet.Range("a1").Select
ActiveSheet.Range("d1") = "          450! donne exactement 1001 chiffres - Interrompre en cours de calcul avec CTRL +  Pause"
'-----------------------------------------------
'demande du nombre à factorialiser
v1 = InputBox("Entrer la valeur n! à factorialiser ... ", "Calcul de Factoriel n", 10)
'-------------- controle des caractères et signes
If Val(v1) = 0 Then v1 = "1": GoTo cestun:
If Val(v1) = 1 Then GoTo cestun:

If Val(v1) < 0 Then
    m = MsgBox("Pas de valeurs négatives SVP ! recommencez")
    Exit Sub
End If
If Abs(Int(Val(v1)) - Val(v1)) > 0 Then
    m = MsgBox("Que des nombres entiers SVP ! recommencez")
    Exit Sub
End If
lv1 = Len(v1)
For u = 1 To lv1
    If Asc(Right(Left(v1, u), 1)) < 48 Or Asc(Right(Left(v1, u), 1)) > 57 Then
        m = MsgBox("Que des valeurs faites de chiffres allant de 0 à 9 SVP ! recommencez")
    End If
Next
'-----------------------------------------------------------------------------------------------
On Error Resume Next
If v1 = "" Then Exit Sub 'si on annule l'inputBox
ActiveSheet.Range("c2") = v1
ActiveSheet.Range("d2") = "Nombre à factorialiser"
ActiveSheet.Range("d3") = " ...Opérande en cours de calcul"
'-----------------------------------------------
vp = v1 'à conserver
'-----------------------------------------------------------------------------
'              ATTENTION AU DIMENSIONNEMENT DU TABLEAU tablo()
'                    pour les grands factoriels >100
'-----------------------------------------------------------------------------
'si le resultat et impossible avec de grand nombre, allonger les dimensions du
'tableau tablo(), en y et x
'--------------------------------------------------------------------------------
'Dim tablo(50, 5000) 'tablo(ytablo,xtablo) c'est la MATRICE
xtablo = 10000
ytablo = 20
Dim tablo(10, 10000) As Integer
'ReDim tablo(ytablo, xtablo)
'ATTENTION, la première ligne de tablo() à l'indice 0, on s'en servira
'xtablo et ytablo définissent les dim du tableau, on ne peut les mettre dans tablo()
'comme ceci tablo(xtablo,ytablo), excel 2003 ne l'accepte pas
v2 = v1 - 1
'-------------------------------------------------------------------------------
zz = "|": zzz = ""
If Val(vp) > 200 Then
    po = Int(Val(vp) / 200) + 1
    For y = 1 To 200: zzz = zzz & zz: Next y: zzz = zzz & " - 100%"
Else
    po = 1
    For y = 1 To ActiveSheet.Range("c2"): zzz = zzz & zz: Next y: zzz = zzz & " - 100%"
End If
ActiveSheet.Range("d12") = zzz
nb = 0
dep = Now '$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
'on décompose v1 et v2 en chiffres pour réaliser le calcul
'--------------------------------------------------------------------------------
'd'abord, mise à zéro de la matrice tablo()
'--------------------------------------------------------------------------------
'décomposition de v1 en ses chiffres ----v1
For i = 1 To Len(Str(v1))
    'on stocke les chiffres 1 par 1
    tablo(2, i) = Left(Right(Str(v1), i), 1)
Next i
'la ligne 1 de tablo() contient les chiffres de v1
'---------------------- zone de bouclage de l'itération
bouclerfactoriel: 'ce repère est utilisé à partir de la 2 eme itération
nb = nb + 1
If nb = po Then
    ActiveSheet.Range("d11") = ActiveSheet.Range("d11") & "|"
    nb = 0
End If
'----------------------v2
For i = 1 To Len(Str(v2))
    tablo(1, i) = Left(Right(Str(v2), i), 1)
Next i
'la ligne 2 de tablo() contient les chiffres de v2
' ce qui donnerait dans tablo()
'colonnes                3        2       1
'                     -----------------------
'                                  1      2                 pour v2  ligne 2 de tablo()
'                                  1      3                 pour v1  ligne 1 de tablo()
'-----------------------------------------------------------------------------------------------
'on multiplie tour à tour les chiffres de v2 avec tous ceux de v1, comme on le ferait
'manuellement dans une mutiplication de nombres
If (v2 = vp - 1) Then
    m1 = Len(Str(v1))  'cas premiere boucle
Else
    For e = xtablo To 1 Step -1
        If (tablo(2, e) > 0 And xtablo - e = 1) Then Stop:
        If tablo(2, e) > 0 Then m1 = e: Exit For 'boucles suivantes
        'donne le nombre de chiffres à traiter
    Next e
End If
m1 = m1 + 5
'on introduit dans tablo() le résultat de la multiplication.
'le (i-1) tient compte du décalage vers la gauche des dizaines
For i = 1 To Len(Str(v2)) 'ex 12
    For j = 1 To m1 '         ex 2, car longueur v1 = 2 (2 chiffres)
        tablo(2 + i, j + (i - 1)) = tablo(1, i) * tablo(2, j)
    Next j
    'For ii = j + 1 To xtablo: tablo(2 + i, ii) = 0: Next ii '-------$$$$$$$$$$$$$
Next i
'ce qui donne ceci dans tablo()
'colonnes          3        2       1
'                     -----------------------------
'                           1      2                        ligne 4 de tablo() (1x2 et 1x1)
'                                  3      6                 ligne 3 de tablo() (3x2 et 3x1)
'                                  1      2                 pour v2  ligne 2 de tablo()
'                                  1      3                 pour v1  ligne 1 de tablo()
'-----------------------------------------------------------------------------------------------
'------------ on somme les lignes de tablo()
For z = 1 To xtablo + 2
    For y = 3 To ytablo '3 car c'est à partir de cette ligne que sont stockés les résultats
        tablo(0, z) = tablo(0, z) + tablo(y, z)
    Next y
Next z
'ce qui donne ceci dans tablo()
'colonnes                3        2       1
'                     -----------------------------
'                           1      2                        ligne 4 de tablo() (1x2 et 1x1)
'                                  3      6                 ligne 3 de tablo() (3x2 et 3x1)
'                                  1      2                 pour v2  ligne 2 de tablo()
'                                  1      3                 pour v1  ligne 1 de tablo()
'                           1      5      6                 ligne 0 de tablo(), somme des lignes 3 et 4
'-----------------------------------------------------------------------------------------------
'ici on ne laisse que des unités dans les cases de tablo() à sa ligne 0
'les dizianes sont reportées et ajoutées à la case juste à gauche
For z = 1 To xtablo + 1 'on scrute toute la ligne 0 de tablo()
    w = tablo(0, z)
    If w > 9 Then 'si la valeur dépase 9
       d = Val(Left(Str(w), Len(Str(w) - 1))) 'd=dizaine
       '--------------------- Bogue de VBA
        u = Val(Right(Str(w), 1)) 'u=unité, la méthode (A-int(A/10))*10 pour récupérer
        '                                    l'unité ne fonctionne pas correctement avec Excel
        If (d * 10 + u) <> w Then d = Int(w / 10)
        tablo(0, z) = u
        tablo(0, z + 1) = tablo(0, z + 1) + d
    Else
        tablo(0, z) = w
    End If
Next z
'For ii = z + 1 To xtablo: tablo(0, ii) = 0: Next ii '-------$$$$$$$$$$$$$
'--------------effacer partie de tablo()--------------------------
'on réitinialise tablo() à 0 sauf la ligne 0
For y = 1 To ytablo: For x = 0 To xtablo: tablo(y, x) = 0: Next x: Next y
'-------------- décrément de v2 pour boucler
v2 = v2 - 1
mot = "" 'mot servira à concaténer les valeurs trouvées lors du calcul
'on déplace la ligne 0 en ligne 1 et on vide cette ligne 0
For u = 1 To xtablo
    tablo(2, u) = tablo(0, u) 'devient v1
    '
    If tablo(0, u) = 0 Then t = "0" Else t = Str(tablo(0, u))
    mot = t & mot
    tablo(0, u) = 0
Next u
'For ii = u + 1 To xtablo: tablo(2, ii) = 0: Next ii '-------$$$$$$$$$$$$$
'on controle la taille du tableau tablo() ------------------------------------
GoTo ggoottoo:
For ta = xtablo To 1 Step -1
    If tablo(2, ta) > 0 Then
        xtablo = xtablo + 10
        ytablo = ytablo + 10
       ' ReDim Preserve tablo(xtablo, ytablo)
    End If
Next ta
ggoottoo:
'-----------------------------------------------------------------------------------
'ActiveSheet.Range("c" & 10) = mot
If v2 = 0 Then GoTo findecalcul:
    ActiveSheet.Range("c3") = v2 + 1
'-------------------------------------------------------------------------------
    GoTo bouclerfactoriel: 'on boucle jusqu'à ce que v2 =0
'----------------------------------------------------------------------------------
'                                            BOUCLAGE
'----------------------------------------------------------------------------------
findecalcul:
cestun:
If Val(v1) = 1 Then mot2 = "1": GoTo cestlafin:

fin = Now '$$$$$$$$$$$$$$$
ActiveSheet.Range("d11") = ActiveSheet.Range("d11") & "| - 100%" 'image de barre de progression (facultatif) = 100%
'
For y = 1 To Len(mot)
    If (Left(mot, 1)) = "0" Then mot = Right(mot, Len(mot) - 1) Else Exit For
Next y
'
mot2 = ""
For y = 1 To Len(mot)
    If Mid(mot, y, 1) = " " Then GoTo encore:
        mot2 = mot2 & Mid(mot, y, 1)
encore:
Next y
'----------------------------------------------------------------------------------------------------
cestlafin: '***
'----------------------------------------------------------------------------------------------------
ActiveSheet.Range("c" & 10) = "_" & mot2
ActiveSheet.Range("d3") = "Nombre de caractères du résultat hors tirait bas"
ActiveSheet.Range("d12") = "Par tranches de 100 chiffres, du haut (les + grandes) vers le bas (les unités)"
'ActiveSheet.Range("c13") = "Tranche la plus à droite (unités)"
k = "Factoriel " & v1 & " = " & v1 & "! = "
k = k & v1 & " x " & v1 - 1 & " x " & v1 - 2 & " x " & v1 - 3 & "( ... x 3 x 2 x 1) ="
ActiveSheet.Range("c9") = k
ActiveSheet.Range("D5") = "Pour de petits factoriels (<200) réduire la dimension de tablo()"
ActiveSheet.Range("D6") = "au début du code. Le gain de temps sera amplifié."
lonmot = Len(mot2) - 1
'----------------mise en forme par tranches
ActiveSheet.Range("c3") = lonmot
'nombre de tranches de 100 caractères
mot3 = mot2
delai = fin - dep 'format
delai = Format(delai, "##,##0.0000000000")
delai = delai * 24 * 3600
delai = Int(delai * 1000) / 1000
ActiveSheet.Range("d12") = ActiveSheet.Range("d12") & " - Total chiffres = " & Len(mot3) & " - délai = " & delai & " sec."
nt = lonmot / 100
nte = Int(nt)
For i = 1 To nte
    ActiveSheet.Range("D" & 12 + i) = "_" & Left(mot3, 100)
    mot3 = Right(mot3, Len(mot3) - 100)
Next i
ActiveSheet.Range("D" & 12 + i) = "_" & mot3
End Sub

Private Sub CommandButton2_Click()
Sheets("Conseil").Select
End Sub

Conclusion :


Le code fonctionne bien, munissez-vous de patience si vous optez pour des factoriels au-delà de 1000.
Il faut 21 minutes pour 3200!. Mon processeur est à 3 GHz
L'approche devrait aussi servir à produire des calculs précis sans notation ingénieur, dans d'autres cas de figures (astronomie, microspie, etc).

Codes Sources

A voir également

Ajouter un commentaire Commentaires
Messages postés
22
Date d'inscription
mardi 4 décembre 2007
Statut
Membre
Dernière intervention
3 décembre 2009

merci US_30,

j'ai lu les autres applis sur les factoriels, avec les remarques concernant la vitesse.
Je travaille sur un algorithme, mais dans le cas présent, je voulais répondre à un objectif, comme la justesse du résultat.

Patrice 99, j'ai tenu compte de ta remarque, ma réponse est la même que celle faite à US_30.

Je réfléchis à un traitement matriciel, et à la non prise en compte des 0 qui s'alignent par centaines et font perdre du temps.
Mais ce sera peut etre autre chose.

Bien à vous.
Messages postés
2065
Date d'inscription
lundi 11 avril 2005
Statut
Membre
Dernière intervention
14 mars 2016
8
Bonjour,

Le résultat du calcul est juste, c'est un bon point. Mais... lorsqu'on fait un calcul avec les grands nombres, on cherche surtout un algorithme rapide... et c'est pas le cas ici. Sache qu'on peut arriver en une seule seconde au calcul de la factorielle 5000. Mais rien ne dit que se record ne pas être battu... Un 10/10 d'encouragement.

Amicalement,
Us.
Messages postés
1221
Date d'inscription
jeudi 23 août 2001
Statut
Membre
Dernière intervention
9 septembre 2018

Tu as pensé à désactiver les événements et le rafraichissement pendant le calcul ? Cela permet d'aller 100 x + vite.

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.