'
' Welcome to GDB Online.
' Biname 03 mai 2022
' Source pb : https://forums.futura-sciences.com/mathematiques-superieur/920897-statistiques-probabilise-de-marcher-un-nid.html
' Champ 50x250m, 10 nids diam 10cm, un pas ecrase 3 nids
' 1 case = 1 nid = 78.5398 cm², champ = 50x250/0.007854 ~= 1591545 cases = 1600000, 1 pas piétine 3 case
Module VBModule
' Parametres
Const NBR_CASES As Integer = 1600000 ' nombre de cases dans le champ
Const NBR_PAS_MAX As Integer = 1000000 ' max nombre de pas, 3 fois plus de cases pietinees
Const CASE_PAR_PAS As Integer = 3 ' nombre de cases pietinees par pas
Const NBR_NIDS As Integer = 10 ' nombre de nids
Const NBR_PARCOURS As Integer = 100 ' nombre de parcours de max = NBR_PAS_MAX
'
' Un tableau Champ de cNBR_CASES est cree
' Dans le tableau champ toutes les cases sont initialisees a 0
' Lorsqu'un nid est place sur une case, la valeur correspondant du tableau passe a -1
' Lorsqu'on pietine une case sans nid, la case correspondante du tableau est incrementee
' lorsqu'on pietine une case portant un nid, la case correspondante du tableau est decrementee,
' case qui sera consideree maintenant comme sans nid, car sa valeur dans le tableau sera de -2 ou < -1
' >=0 case sans nid, =-1 nid non ecrase, < -1 nid deja ecrase. On compte ainsi aussi les passages sur les cases.
Dim Shared Champ(NBR_CASES + 1) As Integer ' debute a 0
Dim Shared sLine As String ' une ligne au format .csv
'
Const EST_UN_NID As Integer = -1 ' < 0 pour compte nbr de fois pietine
Const EST_PAS_UN_NID As Integer = 0
Const VERBOSE As Boolean = FALSE
'
Dim Shared iCountNidEcrases As Integer
Dim Shared sngChrono As Single
'
Sub placeLesNids ()
Dim iNid, iRnd As Integer
For iNid = 1 To NBR_NIDS
iRnd = 1 + Int(NBR_CASES * Rnd) ' index case au hasard
While Champ(iRnd) <> EST_PAS_UN_NID ' pas deux nids sur la même case
iRnd = 1 + Int(NBR_CASES * Rnd)
End While
Champ(iRnd) = EST_UN_NID ' nid en iRnd
If VERBOSE = TRUE Then Console.WriteLine (" Nid(" + Str(iNid) + ") place en case #" + Str(iRnd))
Next iNid
End Sub
'
Sub rndPietineCase(iCasesPietinees As Integer)
Dim iRnd As Integer
iRnd = 1 + Int(NBR_CASES * Rnd) ' tire une case au hasard
If Champ(iRnd) = EST_UN_NID Then
sLine += "," + Str(iCasesPietinees)
Champ(iRnd) -= 1 ' < -1 n'est un nid vivant ;-)
iCountNidEcrases += 1
If VERBOSE = TRUE Then Console.WriteLine(Str(iCountNidEcrases) + "eme nid ecrase en case " + Str(iRnd))
End If
End Sub
'
Function pietineLeChamp (iParcours As Integer) As Integer
Dim iCasesPietinees As integer
Dim sngChrono2 As Single
sngChrono2 = Timer
iCountNidEcrases = 0
Randomize ' evite de toujours placer les nids dans les mêmes cases
placeLesNids()
' Entete colonnes csv
Randomize ' evite de retirer chaque fois la meme serie de cases
sLine = Str(iParcours)
For iCasesPietinees = 1 To NBR_PAS_MAX * 3
rndPietineCase(iCasesPietinees)
If iCountNidEcrases = 10 Then Exit For
Next iCasesPietinees
' nid pas ecrases
While iCountNidEcrases < 10
iCountNidEcrases += 1
sLine += "," + Str(1 + NBR_PAS_MAX * 3)
End While
sLine += "," + Str(Int (1000000*(Timer - sngChrono2)))
Console.WriteLine(sLine)
End Function
'
Sub Main()
Dim n As Integer
sngChrono = Timer
If VERBOSE = TRUE Then Console.WriteLine (VBCRLF + "Champ de" + Str(NBR_CASES) + "cases dont" _
+ Str(NBR_NIDS) + " portent 1 nids, apres" + Str(NBR_PAS_MAX) _
+ " on arrete le parcours du champ" + VBCRLF)
Console.WriteLine (VBCRLF + " Parcours #,Nid_1,Nid_2,Nid_3,Nid_4,Nid_5,Nid_6,Nid_7,Nid_8,Nid_9,Nid_10,t_us")
For n = 1 To NBR_PARCOURS:pietineLeChamp(n):Next n
Console.WriteLine(VBCRLF +" Termine en" + Str(Int (1000*(Timer - sngChrono))) + " ms")
End Sub
End Module
