Simuler le lancer d'un dé pipé (non équilibré)

Soyez le premier à donner votre avis sur cette source.

Snippet vu 7 018 fois - Téléchargée 35 fois

Commenter

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'

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

Ajouter un commentaire

Commentaires

Signaler
alexduf25
Messages postés
1
Date d'inscription
mercredi 14 mai 2008
Statut
Membre
Dernière intervention
14 mai 2008
bonjour

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.
Signaler
cs_gagou9
Messages postés
126
Date d'inscription
vendredi 19 septembre 2003
Statut
Membre
Dernière intervention
20 novembre 2007
Merci c'est génial, j'aouterai ta fonction dans mon prog !!
Allez a+
Signaler
BozzoDodo
Messages postés
185
Date d'inscription
vendredi 20 décembre 2002
Statut
Membre
Dernière intervention
10 janvier 2008
Wi en effet je l'ai oublié! :)
Signaler
Saros
Messages postés
921
Date d'inscription
vendredi 20 décembre 2002
Statut
Membre
Dernière intervention
23 septembre 2010
If TotalProb <> 1 Then LancerLeDé = 0
D'accord, mais après ? Il faudrait quitter la fonction ou assimilé...

Voilà... Sinon j'ai pas grand chose à dire :)
S'inscrire maintenant

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.

Du même auteur (BozzoDodo)