Simuler le lancer d'un dé pipé (non équilibré)
4/5 (4 avis)
Snippet vu 8 042 fois - Téléchargée 36 fois
Contenu du snippet
Ce code a été fait en réponse à celui de gagou9 (http://www.vbfrance.com/code.aspx?ID=28888). Il permet de simuler le lancer d'un dé pipé, qui n'est pas équilibré. Ainsi, chaque face n'a pas la même probabilité de tomber. Ce code peut servir pour des jeux (le 6 doit moins tomber que le 1 par exemple).
La fonction s'utilise de cette facon:
en paramètre on met la probabilité pour chaque face et la fonction retourne la face.
ex:
LancerLeDé(0.5, 0.20, 0.20, 0.10)
Cet exemple est la simulation d'un dé à 4 faces. La face 1 a une probabilité de 0.50 de tomber (c'est à dire une "chance" sur 2), les faces 2 et 3 ont une probabilité de 0.20 (1/5) et la face 4 une probabilité de 1/10 de tomber.
Si on simule un nombre important N de lancers les fréquences se rapprocheront de ces probabilité.
J'espère que vous aurez compris.
Bonne prog'
La fonction s'utilise de cette facon:
en paramètre on met la probabilité pour chaque face et la fonction retourne la face.
ex:
LancerLeDé(0.5, 0.20, 0.20, 0.10)
Cet exemple est la simulation d'un dé à 4 faces. La face 1 a une probabilité de 0.50 de tomber (c'est à dire une "chance" sur 2), les faces 2 et 3 ont une probabilité de 0.20 (1/5) et la face 4 une probabilité de 1/10 de tomber.
Si on simule un nombre important N de lancers les fréquences se rapprocheront de ces probabilité.
J'espère que vous aurez compris.
Bonne prog'
Source / Exemple :
Public Function LancerLeDé(ParamArray Probabilité() As Variant) As Long
Dim NbAléatoire As Currency
Dim i As Long
Dim TotalProb As Currency
'On réinitialise le générateur de nombres pseudo-aléatoires
Randomize
'On choisit un nombre au hasard entre 0 et 1
NbAléatoire = Rnd
'On vérifie que la somme de toutes les probabilités est égale à 1
For i = LBound(Probabilité) To UBound(Probabilité)
TotalProb = TotalProb + Probabilité(i)
Next i
If TotalProb <> 1 Then LancerLeDé = 0: Exit function 'Somme des probabilités différentes de 1. Impossible==> erreur
TotalProb = 0
For i = LBound(Probabilité) To UBound(Probabilité)
TotalProb = TotalProb + Probabilité(i)
If NbAléatoire <= TotalProb Then
'On a trouvé le numéro=> on retourne le numéro de la face
'Cette face doit être différente de 0 (erreur) donc on rajoute 1
LancerLeDé = i + 1
Exit Function
End If
Next i
End Function
A voir également
- Lancer le dé
- Dé non pipés - Meilleures réponses
- Comment simuler une pipe - Meilleures réponses
- Lancer un script python automatiquement ✓ - Forum - Python
- Lancer script php automatiquement - Forum - PHP
- Lancer script python via bouton html - Forum - Python
- C# lancer un programme externe - Forum - C# / .NET
- Lancer un processus à partir d'une page asp avec les droits admins sans toucher à la configuration d - Conseils pratiques - ASP / ASP.NET
14 mai 2008 à 13:26
je suis nouveau sur le forum.
je viens de trouver votre fonction et je la trouve intérssante.
mais je voudrais savoir si il est possible de l'adapter en macro afin de lancer le dé par un simple bouton, et que le résultat s'affiche sur le cellule active.
merci d'avance pour les réponse que vous pourriez m'apporter.
31 janv. 2005 à 18:12
Allez a+
27 janv. 2005 à 18:11
27 janv. 2005 à 09:41
D'accord, mais après ? Il faudrait quitter la fonction ou assimilé...
Voilà... Sinon j'ai pas grand chose à dire :)
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.