CALCUL DÉTAILLÉ DE FACTORIEL

---

Commentaire sur cette source (3)
Ajouter un commentaire et/ou une note

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.

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

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).

Pour les "Membres Club", vous pouvez télécharger directement un fichier contenu dans le zip sans télécharger le zip en entier !

Télécharger le zip

22 mars 2008 20:47:26 :

le zip précédent comprend une erreur native venant d'Excel que j'ai modifié dans ce dernier. Mieux vaut supprimer le premier zip. merci

• CALCUL DE FACTORIEL (VITESSE)
• CALCUL ENTHALPIQUE DE L'AIR HUMIDE

• PROJECTION SOLEIL
• INTERRUPTEUR ALÉATOIRE
• PROBABILITES
• PIVOT DE GAUSS
• TOUS LES SUDOKU DU MONDE

• PROBABILITES
• JEU DE MATH - CALCUL MENTAL
• CALCUL DE MOYENNE
• BIGMATH - OPERATIONS SUR DES TRES GRANDS NOMBRES
• ROTATION 3D