Simuler le lancer d'un dé pipé (non équilibré)
Soyez le premier à donner votre avis sur cette source.
Snippet vu 7 440 fois - Téléchargée 35 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
- Dé pipé
- Dé truqué - Meilleures réponses
- Dé pipés - Meilleures réponses
- Pipe c++ - Guide
- Pipe unix - Forum - C
- Visual Basic / VB.NET : Utiliser des pipes (tubes de communications) entre des applications vb - Cod - Guide
- Visual Basic / VB.NET : Capture du texte d'un programme dos par un pipe ... - CodeS SourceS - Guide
- C / C++ / C++.NET : Initiation aux tubes unix (pipe()) - CodeS SourceS - Guide
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.
Allez a+
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.