Sujet Précédent Sujet Suivant

CADEAU Mon Random nickel

Résolu
whombat Messages postés 188 Date d'inscription mercredi 12 octobre 2005 Statut Membre Dernière intervention 19 novembre 2011 - 1 avril 2006 à 06:25
Renfield Messages postés 17287 Date d'inscription mercredi 2 janvier 2002 Statut Modérateur Dernière intervention 27 septembre 2021 - 1 avril 2006 à 22:36
Bonjour,

Le problème des Random c'est qu'ils donnent souvent la même série de chiffres. Le code est bref, certes, mais le résultat n'est pas à la hauteur des attentes.

Mon Random, que j'appelle Hasard, est basé sur 2 critères distincts : les nombres premiers depuiis le 201 ème jusqu'au 300 ème et le nombre de secondes depuis minuit. 2 fonctions, rangées une fois pour tous dans un module ou une dll et voilà :

Function NombresPremiers()

Dim Pr(), V As String
Dim PREM As Long, IND As Integer, IND2 As Integer
Dim NB As Integer, X As Integer

ReDim Preserve Pr(4)
Pr(0) = 1
Pr(1) = 2
Pr(2) = 3
Pr(3) = 5
PREM = 7
IND = 1
IND2 = 3
NB = 0
X = 1

Do While (PREM < 1000000)

IND = 1
Do While (PREM / Pr(IND) >= Pr(IND))

T = 0
If (PREM / Pr(IND) = 0) Then
T = 1
Exit Do
Else
IND = IND + 1
End If
Loop

If (T = 1) Then
PREM = PREM + 2
'continue
End If

IND2 = IND2 + 1

ReDim Preserve Pr(IND2)
Pr(IND2) = PREM
NB = NB + 1
V = Str(PREM) + " "

ReDim Preserve TabNombPrem(X)
If X >= 200 And X <= 300 Then 'Utilise que les nombres premiers à
TabNombPrem(X) = V ' partir du 200 ème jusqu'au 300 ème
ElseIf X > 300 Then ' et les charge dans un tableau ( à
Exit Do ' déclarer au niveau feuille ou module
End If
X = X + 1

'If (NB > 2000) Then ' Pour utiliser ce calcul pour obtenir
'NB = 0 ' des millions de nombres premiers
'If MsgBox("Calculer les 2000 suivants?", 289, Me.Caption) = 2 Then
'Exit Function
'PREM = 1000001
'End If
'End If

PREM = PREM + 2

GoSub VasY ' reposer le processeur

Loop

Exit Function

VasY:
Sleep (10)
Return

End Function

Function Hasard(NB As Integer)

Dim Ref As Long

DepuisMinuit = Time

Hr = Val(Left(DepuisMinuit, 2))
Mn = Val(Mid(DepuisMinuit, 4, 2))
Sc = Val(Right(DepuisMinuit, 2))
Ref = TabNombPrem(Sc + 200)

Hr = Hr * 60 * 60
Mn = Mn * 60

Total = ((Hr + Mn + Sc) * Ref)
LeTotal = CStr(Total)
LeHasard = Left(LeTotal, Len(CStr(NB)))
Hasard = Val(LeHasard)

Do While Hasard > NB
Hasard = Hasard - NB
Loop

End Function

J'ai besoin d'un carte sur 52 ? NumCarte=Hasard(52)
J'ai besoin d'un jour sur 365 ? NumJour=Hasard(365)

Si ça vous plaît, laissez-moi un petit mot.

4 réponses

Réponse 1 / 4
Renfield Messages postés 17287 Date d'inscription mercredi 2 janvier 2002 Statut Modérateur Dernière intervention 27 septembre 2021 74
1 avril 2006 à 22:36
la même série de chiffres ?



tu as simplement du oublier le 'Randomize' ...

Renfield
Admin CodeS-SourceS - MVP Visual Basic
3
Réponse 2 / 4
Renfield Messages postés 17287 Date d'inscription mercredi 2 janvier 2002 Statut Modérateur Dernière intervention 27 septembre 2021 74
1 avril 2006 à 07:25
pourquoi ne pas utiliser la fonction RND ?



Randomize '# ici, on allume le générateur de nombres aléatoires





a = fix(25 * rnd + 2 ) '# là, un nombre entier, sis entre 2 et 25

Renfield
Admin CodeS-SourceS - MVP Visual Basic
0
Réponse 3 / 4
whombat Messages postés 188 Date d'inscription mercredi 12 octobre 2005 Statut Membre Dernière intervention 19 novembre 2011
1 avril 2006 à 10:21
Je l'ai expliqué au début, cela donne souvent la même série de chiffres.
0
Réponse 4 / 4
mcs2006 Messages postés 58 Date d'inscription dimanche 19 mars 2006 Statut Membre Dernière intervention 1 mai 2006
1 avril 2006 à 18:52
Renfield > Laisse, si ça se trouve, c'est comme ça que la "Française des jeux" détermine les tirages du "rapido" et on pourrait se faire plein de fric si c'est le bon algo. Mais ça m'étonnerait beaucoup.
0

Discussions similaires

Math.random() en java
nicegirle -
nicegirle -

2 réponses
fonction random en Delphi
alexyou -
KingRamses -

4 réponses
random sans deux fois la meme valeur
laupif -
devilsfire -

6 réponses
procédure random
ayllau -
ni69 -

3 réponses
Option RANDOM Delphi
florian060190 -
Anonymous340 -

16 réponses
Rejoignez-nous