Devo finire questo progetto per lunedì e ho dei gravi problemi su questo algoritmo di generazione casuale delle partite delle giornate di un campionato di calcio, vi allego anche le variabili globali.
l'algoritmo funziona per un massimo di 6 squadre (non sempre), se le squadre aumentano va sempre peggio..quando non riesce va in loop e gira in eterno,(in un altra procedura la funzione viene richiamata finche non restituisce true);datemi correzioni, nuovi algoritmi o cosigli..ma aiutatemiiiii.....aiuto....ve ne preggoooo
se vi viene piu comodo mandate la risp a auridevil@hotmail.com
Option Explicit
Const TMAX = 120
Type s_partite
GolFatti As Integer
GolSubiti As Integer
GaPunti As Integer
End Type
Type s_calcio
Id As Integer
Nome As String * 20
Punti As Integer
VittorieTot As Integer
SconfitteTot As Integer
PareggiTot As Integer
GolFatti As Integer
GolSubiti As Integer
DiffReti As Integer
Provenienza As String * 20
IdAvv() As Integer
Partite() As s_partite
End Type
Public Scontri() As String
Public SquadreCalcio() As s_calcio
Public LungCalcio As Integer
Public Giornate As Integer
Public Ritorno As Boolean
Public Function GeneraGiornate() As Boolean
Call Randomize
Dim i As Integer
Dim Num() As Integer
Dim j As Integer
Dim k As Integer
Dim flag As Boolean
Dim cnt As Integer
Dim t1 As Single
Dim t2 As Single
ReDim Num(LungCalcio) As Integer
ReDim Scontri(LungCalcio, LungCalcio - 1)
t1 = Timer
For i = 1 To (LungCalcio - 1)
Do
cnt = 0
Do
cnt = cnt + 1
For j = 1 To LungCalcio
Num(j) = Int(LungCalcio * Rnd + 1)
Next j
flag = False
For j = 1 To LungCalcio
For k = 1 To LungCalcio
If ((Num(j) = Num(k)) And (j <> k)) Then
flag = True
Exit For
End If
Next k
Next j
If (cnt = 32000) Then
GeneraGiornate = False
Exit Function
End If
Loop While (flag = True)
flag = False
For k = 1 To i
For j = 1 To LungCalcio Step 2
If (SquadreCalcio(Num(j)).IdAvv(k) = Num(j + 1)) Then
flag = True
Exit For
End If
If (SquadreCalcio(Num(j + 1)).IdAvv(k) = Num(j)) Then
flag = True
Exit For
End If
Next j
If (flag = True) Then Exit For
Next k
t2 = Timer
If ((t2 - t1) > TMAX) Then
GeneraGiornate = False
Exit Function
End If
Loop While flag
For j = 1 To LungCalcio Step 2
SquadreCalcio(Num(j)).IdAvv(i) = Num(j + 1)
SquadreCalcio(Num(j + 1)).IdAvv(i) = Num(j)
Next j
Next i
Call SetScontri
GeneraGiornate = True
End Function
Rispondi quotando
