Vet inte var denna fråga passar in bäst så det fick bli detta forumet?
Kanske skulle vara vb för att jag visar lite vbkod men frågan är allmän?

Har suttit och klurat på hur jag ska kunna skapa ett matchprogram hoppas nu att någon annan har ett bra förslag?

Hur kan man skapa ett matchprogram om har ett okänt antal lag och alla ska möta alla en gång så rättvist det går med hemma och borta och man ska även hålla koll på vilken omgång matchen tillhör.

tex. skapa en array med strMatchprogram(100,3) ska använda databas men det är enklare att testa med array.

strMatchprogram(x,0) = hemmalag
strMatchprogram(x,1) = bortalag
strMatchprogram(x,2) = omgång

om man har 4 lag blir arrayen ungefär så här.

Lagens namn är A,B,C,D

A,B,1
C,A,2
A,D,3
D,c,1
B,D,2
B,C,3


obs. Om det är ojämt antal lag måste ett lag stå över varje omgång.


Här är några uträkningar för att ta reda på hur många matcher och hur många omgångar om det är till någon hjälp?

For x = 1 To (lngAntalLag - 1)
lngAntalMatcher = lngAntalMatcher + x
Next x

lngAntalOmgangar = lngAntalMatcher / ((lngAntalLag - (lngAntalLag Mod 2)) / 2)



Jag tycker det ska kunna gå att lösa med två nästlade loopar och några variabler? eller....


Ska gå och se fotboll nu. Det brukar vara bra att lämna det ett tag när man kört fast.


/DH

'alla lag i en array
dim lag(3) as string
lag(0) = "aporna"
lag(1) = "kossorna"
lag(2) = "nördarna"
lag(3) = "aliens"


<code>

dim z as long

'räkna ut samtliga mtachantalet...
if ubound(lag) and 1 = 1 then
'jämt antal lag
z = ubound(lag)
z = z * ((z + 1) / 2)
else
'ojämt
z = ubound(lag)
z = ((z) / 2)
z = ((bound(lag) - z) * lag(ubound(lag))) + (ubound(lag) / 2)
end if


dim vs(z)(2) as long

dim i as long
dim x as long
dim v as long
v = 0
for i = 0 to ubound(lag)
for x = i + 1 to ubound(lag)
vs(v)(0) = i
vs(v)(1) = x
vs(v)(2) = 'omgång...? Vad är det? Inte insatt i sport...
v = v + 1
next
next

</code>



vs(x)(0) = lag1
vs(x)(1) = lag2
vs(x)(2) = 'omgång?

En omgång är fullständig när alla lag har spelat en match och som jag skrev när det är ojämt antal lag måste ett lag stå över varje omgång.

Alltså om det är 6 lag i serie och det är två lag i varje match då blir det 6/2=3 matcher i varje omgång.

Och det är ju lätt att ta ut vilka matcher som blir men svårigheten är att få till att hemma/borta blir så rättvist som möligt och att man håller reda på vilka omgångar det är.


Nu ska jag det ett försök till och se om jag tänker lite klarare :)

Hm... Nu hänger jag inte riktigt med... Varför skall någon stå över? Jag får inte riktigt ihop det...

Den koden jag körde är alla-mot-alla matcher... Och då spelar det ingen roll?

En liknande diskussion har förts tidigare i forumet. Titta på : [problem med slumpning]

Tack Hultan den koden funkade perfekt. Har inte kollat om hemma/borta funkar alltid men dom jag testade var resultatet perfekt. Var kanske lite mer komplicerat än vad jag trodde behövdes ;)


onkelborg:
Om det är t.ex. 7 lag och 2 lag spelar per match 7/2 = ojämt tal. Då måste ett lag bli över per omgång. Men det måste vara olika lag som står varje omgång.



*edit
Men jag hade rätt att det gickatt lösa med två nästlade loopar och några variabler ;)

Nu när jag la in koden i det riktiga programmet och testade lite mer så funkade det inte med hemma och borta som jag ville. Tänkte väl att det inte kunde vara så bra ;)
Han som frågade behövde inte hålla reda på det så det var ganska väntat.

Jag vill ha så att hemmamatcher och bortamatcher ska vara jämt fördelat så länge det går men max 1 match skillnad mellan den som har mest och minst.

Och det andra man ska försöka eftersträva är att man helst ska spela varanna hemma och varannan borta men det går inte alltid att få men max två hemmamatcher i rad och samma med borta matcher.

Ska fortsätta med resten av programmet men måste komma tillbaka till detta förr eller senare.
Jag kommer troligast inte kunna fixa till den koden så det löser dom här problemen så jag kommer att få göra en extra kontroll efter den funktionen om jag fixar det ;)

Det finns en del intressant att läsa i detta ämne på

Dr. Maths site.

http://www.drmath.com/dr.math/

sök i arkivet på round AND robin så får du en del intressant information.

//

Janne

Ja där kan man lära sig en del men fanns inget jag har nytta av nu. Kanske om jag lägger in en fråga.

Trodde jag kom på en bra lösning men den verkar efter en del testning fixa det ena problemet men inte riktigt fixa det andra med hemma/borta.


<code>

ReDim lag(lstLag.ListCount) As String
ReDim lagSlumpad(lstLag.ListCount) As String
Dim N As Integer, R As Integer, x As Integer
Dim sql As String, intTal As Integer
Dim i As Integer, lngNR As Long

'Detta tar bort matchstatistik man skapat innan. Så det inte blir dubbletter
sql = "delete from matchuppgifter where serieid ='" & Trim(cboSerie.ItemData(cboSerie.ListIndex)) & "' AND sasong ='" & Trim(cboSasong.ItemData(cboSasong.ListIndex)) & "'"
Con.Execute sql
lstMatchProgram.Clear

N = lstLag.ListCount
lngNR = 0

For x = 0 To lstLag.ListCount - 1
lag(x) = lstLag.List(x)
Next x
Randomize

'Dra slumpmässigt lag från tombolan
For i = 0 To N - 1
Do
intTal = (N - 1) * Rnd
If lag(intTal) <> "0" Then
lagSlumpad(i) = lag(intTal)
lag(intTal) = "0"
End If
Loop While (lagSlumpad(i) = "")

Next i

'Om ojämnt antal lag lägg till ett dummy som sedan plockas bort i varje omgång
If (lstLag.ListCount Mod 2) <> 0 Then
lagSlumpad(lstLag.ListCount) = "dummy"
N = N + 1
End If

'Använd permutationer för lösa problemet.
For R = 1 To N - 1
Dim M%, P1%, P2%, O As Integer
For M = 1 To N / 2
Dim t1 As Integer
t1 = (M + R - 2) Mod (N - 1) + 1
If M = N / 2 Then
P1 = 1
P2 = 0
Else
P1 = 0
P2 = 1
End If

Dim t2 As Integer
t2 = P1 * N + P2 * ((N - M + R - 2) Mod (N - 1) + 1)
If lagSlumpad(t1 - 1) <> "dummy" And lagSlumpad(t2 - 1) <> "dummy" Then

lngNR = lngNR + 1
If lag(t1 - 1) < lag(t2 - 1) Then
sql = "insert into matchuppgifter (serieid, sasong, omgang, hemmalag, bortalag) " & _
"values('" & Trim(cboSerie.ItemData(cboSerie.ListIndex)) & "','" & Trim(cboSasong.ItemData(cboSasong.ListIndex)) & "','" & R & "','" & lagSlumpad((t1 - 1)) & "','" & lagSlumpad((t2 - 1)) & "')"
lag(t1 - 1) = lngNR
Else
sql = "insert into matchuppgifter (serieid, sasong, omgang, hemmalag, bortalag) " & _
"values('" & Trim(cboSerie.ItemData(cboSerie.ListIndex)) & "','" & Trim(cboSasong.ItemData(cboSasong.ListIndex)) & "','" & R & "','" & lagSlumpad((t2 - 1)) & "','" & lagSlumpad((t1 - 1)) & "')"

lag(t2 - 1) = lngNR
End If
Con.Execute sql

End If
Next M
Next R

</code>