dépassement de capacité avec factorielle

F

francois

Guest
Bonjour,

J'utilise des factorielles et/ou des combinaisons dans un programme Excel afin de calculer une probabilité.
Malheureusement Excel atteint vite ses limites de capacité pour un résultat poutant compris entre 0 et 1.
Comment peut-on svp contourner cette difficulté? une série?

Merci de toute aide
Francois
 

Gael

XLDnaute Barbatruc
Bonjour François,

Tous ces problèmes de combinaisons et de probabilités reposent effectivement sur des calculs de factorielles.

Une factorielle peut amener très rapidement à des chiffres astronomiques qui dépassent largement les capacités de calculs d'outils comme Excel, ce n'est donc pas la bonne méthode.

La solution est tout simplement de simplifier les opérations car lorsqu'on fait par exemple !20/15!*5! (combimaisons de 15 chiffres parmi 20), cela se résume à :

16*17*18*19*20/2*3*4*5 soit 3*16*17*19 ce qui est tout à fait dans les possibilités d'Excel.

Je t'envoie également une procédure pour générer sous Excel toutes les combinaisons ou permutations poossibles et tu peux regarder dans le salon XLD dans lequel j'ai posté pour mon 500ème un arbre binaire de probabilités avec l'exemple du loto.

'Voici une diabolique procédure pour mettre
'définitivement fin aux questions concernant les
'listes de combinaisons ou de permutations
'de R éléments choisis parmi N.
'Pour l [/b]'utiliser :
 
'1. En A1, écrire c ou p ; (Combinaison ou Permutation)
 
'2. En A2, écrire la valeur de R ;
 
'3. Sous A2, écrire la liste des N éléments ;
 
'4. Sélectionner A1 et activer la procédure.

'Exemple:
'A1 c
'A2 3
'A3 1
'A4 2
'A5 Excel
'A6 4
'A7 *
'A8 6
'
'La procédure donne alors la liste de toutes les combinaisons
'possibles de 3 éléments choisis parmi 6.


Option Explicit

Dim vAllItems As Variant
Dim Buffer() As String
Dim BufferPtr As Long
Dim Results As Worksheet

Sub ListPermutations()
 
Dim Rng As Range
 
Dim PopSize As Integer
 
Dim SetSize As Integer
 
Dim Which As String
 
Dim N As Double
 
Const BufferSize As Long = 4096

 
Set Rng = Selection.Columns(1).Cells
 
If Rng.Cells.Count = 1 Then
   
Set Rng = Range(Rng, Rng.End(xlDown))
 
End If

  PopSize = Rng.Cells.Count - 2
 
If PopSize < 2 Then GoTo DataError

&nbsp; SetSize = Rng.Cells(2).Value
&nbsp;
If SetSize > PopSize Then GoTo DataError

&nbsp; Which = UCase$(Rng.Cells(1).Value)
&nbsp;
Select Case Which
&nbsp;
Case 'C'
&nbsp; &nbsp; N = Application.WorksheetFunction.Combin(PopSize, SetSize)
&nbsp;
Case 'P'
&nbsp; &nbsp; N = Application.WorksheetFunction.Permut(PopSize, SetSize)
&nbsp;
Case Else
&nbsp; &nbsp;
GoTo DataError
&nbsp;
End Select
&nbsp;
If N > Cells.Count Then GoTo DataError

&nbsp; Application.ScreenUpdating =
False

&nbsp;
Set Results = Worksheets.Add

&nbsp; vAllItems = Rng.Offset(2, 0).Resize(PopSize).Value
&nbsp;
ReDim Buffer(1 To BufferSize) As String
&nbsp; BufferPtr = 0

&nbsp;
If Which = 'C' Then
&nbsp; &nbsp; AddCombination PopSize, SetSize
&nbsp;
Else
&nbsp; &nbsp; AddPermutation PopSize, SetSize
&nbsp;
End If
&nbsp; vAllItems = 0

&nbsp; Application.ScreenUpdating =
True
&nbsp;
Exit Sub

DataError:
&nbsp;
If N = 0 Then
&nbsp; &nbsp; Which = 'Enter your data in a vertical range of at least 4 cells. ' _
&nbsp; &nbsp; &nbsp; & String$(2, 10) _
&nbsp; &nbsp; &nbsp; & 'Top cell must contain the letter C or P, 2nd cell is the number' _
&nbsp; &nbsp; &nbsp; & 'of items in a subset, the cells below are the values from which' _
&nbsp; &nbsp; &nbsp; & 'the subset is to be chosen.'
&nbsp;
Else
&nbsp; &nbsp; Which = 'This requires ' & Format$(N, '#,##0') & _
&nbsp; &nbsp; &nbsp; ' cells, more than are available on the worksheet!'
&nbsp;
End If
&nbsp; MsgBox Which, vbOKOnly, 'DATA ERROR'
&nbsp;
Exit Sub
End Sub

Private Sub AddPermutation(Optional PopSize As Integer = 0, _
&nbsp;
Optional SetSize As Integer = 0, _
&nbsp;
Optional NextMember As Integer = 0)

&nbsp;
Static iPopSize As Integer
&nbsp;
Static iSetSize As Integer
&nbsp;
Static SetMembers() As Integer
&nbsp;
Static Used() As Integer
&nbsp;
Dim i As Integer

&nbsp;
If PopSize <> 0 Then
&nbsp; &nbsp; iPopSize = PopSize
&nbsp; &nbsp; iSetSize = SetSize
&nbsp; &nbsp;
ReDim SetMembers(1 To iSetSize) As Integer
&nbsp; &nbsp;
ReDim Used(1 To iPopSize) As Integer
&nbsp; &nbsp; NextMember = 1
&nbsp;
End If

&nbsp;
For i = 1 To iPopSize
&nbsp; &nbsp;
If Used(i) = 0 Then
&nbsp; &nbsp; &nbsp; SetMembers(NextMember) = i
&nbsp; &nbsp; &nbsp;
If NextMember <> iSetSize Then
&nbsp; &nbsp; &nbsp; &nbsp; Used(i) =
True
&nbsp; &nbsp; &nbsp; &nbsp; AddPermutation , , NextMember + 1
&nbsp; &nbsp; &nbsp; &nbsp; Used(i) =
False
&nbsp; &nbsp; &nbsp;
Else
&nbsp; &nbsp; &nbsp; &nbsp; SavePermutation SetMembers()
&nbsp; &nbsp; &nbsp;
End If
&nbsp; &nbsp;
End If
&nbsp;
Next i

&nbsp;
If NextMember = 1 Then
&nbsp; &nbsp; SavePermutation SetMembers(),
True
&nbsp; &nbsp; Erase SetMembers
&nbsp; &nbsp; Erase Used
&nbsp;
End If

End Sub&nbsp; 'AddPermutation

Private Sub AddCombination(Optional PopSize As Integer = 0, _
&nbsp;
Optional SetSize As Integer = 0, _
&nbsp;
Optional NextMember As Integer = 0, _
&nbsp;
Optional NextItem As Integer = 0)

&nbsp;
Static iPopSize As Integer
&nbsp;
Static iSetSize As Integer
&nbsp;
Static SetMembers() As Integer
&nbsp;
Dim i As Integer

&nbsp;
If PopSize <> 0 Then
&nbsp; &nbsp; iPopSize = PopSize
&nbsp; &nbsp; iSetSize = SetSize
&nbsp; &nbsp;
ReDim SetMembers(1 To iSetSize) As Integer
&nbsp; &nbsp; NextMember = 1
&nbsp; &nbsp; NextItem = 1
&nbsp;
End If

&nbsp;
For i = NextItem To iPopSize
&nbsp; &nbsp; SetMembers(NextMember) = i
&nbsp; &nbsp;
If NextMember <> iSetSize Then
&nbsp; &nbsp; &nbsp; AddCombination , , NextMember + 1, i + 1
&nbsp; &nbsp;
Else
&nbsp; &nbsp; &nbsp; SavePermutation SetMembers()
&nbsp; &nbsp;
End If
&nbsp;
Next i

&nbsp;
If NextMember = 1 Then
&nbsp; &nbsp; SavePermutation SetMembers(),
True
&nbsp; &nbsp; Erase SetMembers
&nbsp;
End If

End Sub&nbsp; 'AddCombination

Private Sub SavePermutation(ItemsChosen() As Integer, _
&nbsp;
Optional FlushBuffer As Boolean = False)

&nbsp;
Dim i As Integer, sValue As String
&nbsp;
Static RowNum As Long, ColNum As Long

&nbsp;
If RowNum = 0 Then RowNum = 1
&nbsp;
If ColNum = 0 Then ColNum = 1

&nbsp;
If FlushBuffer = True Or BufferPtr = UBound(Buffer()) Then
&nbsp; &nbsp;
If BufferPtr > 0 Then
&nbsp; &nbsp; &nbsp;
If (RowNum + BufferPtr - 1) > Rows.Count Then
&nbsp; &nbsp; &nbsp; &nbsp; RowNum = 1
&nbsp; &nbsp; &nbsp; &nbsp; ColNum = ColNum + 1
&nbsp; &nbsp; &nbsp; &nbsp;
If ColNum > 256 Then Exit Sub
&nbsp; &nbsp; &nbsp;
End If

&nbsp; &nbsp; &nbsp; Results.Cells(RowNum, ColNum).Resize(BufferPtr, 1).Value _
&nbsp; &nbsp; &nbsp; &nbsp; = Application.WorksheetFunction.Transpose(Buffer())
&nbsp; &nbsp; &nbsp; RowNum = RowNum + BufferPtr
&nbsp; &nbsp;
End If

&nbsp; &nbsp; BufferPtr = 0
&nbsp; &nbsp;
If FlushBuffer = True Then
&nbsp; &nbsp; &nbsp; Erase Buffer
&nbsp; &nbsp; &nbsp; RowNum = 0
&nbsp; &nbsp; &nbsp; ColNum = 0
&nbsp; &nbsp; &nbsp;
Exit Sub
&nbsp; &nbsp;
Else
&nbsp; &nbsp; &nbsp;
ReDim Buffer(1 To UBound(Buffer))
&nbsp; &nbsp;
End If

&nbsp;
End If

&nbsp;
'construct the next set
&nbsp;
For i = 1 To UBound(ItemsChosen)
&nbsp; &nbsp; sValue = sValue & ', ' & vAllItems(ItemsChosen(i), 1)
&nbsp;
Next i

&nbsp;
'and save it in the buffer
&nbsp; BufferPtr = BufferPtr + 1
&nbsp; Buffer(BufferPtr) = Mid$(sValue, 3)
End Sub&nbsp; 'SavePermutation


Bon courage.

@+

Gael
 

Gael

XLDnaute Barbatruc
Rebonjour,

Et bonjour Fifou, je ne t'avais pas vu.

J'ai oublié de mentionner que la procédure que je t'ai envoyée est due à Myrna Larson et disponible également sur le site Excelabo.

La fonction Combin (x,y) sur excel marche également très bien.

Et le lien pour mon 500ème:

Lien supprimé

@+

Gael
 
F

Francois

Guest
Je voulais calculer qq chose du genre C(m/2,m)/2^m pour m grand.

J'ai bidouillé le programme; je sais que de toute façon, je vais être appelé à diviser par 2^m et que je dois obtenir un résultat inférieur à 1 (proba) ; dès que ma somme est supérieure à 1, je divise par 2^1000 qui est supporté par Excel ; j'incrémente un compteur et je réajuste à la fin en divisant par la puissance de 2 adéquate.

Merci à vous
 

Statistiques des forums

Discussions
300 822
Messages
1 987 481
Membres
209 863
dernier inscrit
habibino