League Fixtures

[Mossoft]

Here's one that I ponder in my spare time. And if I have pondered it, I expect others have as well:

I need a program that will organise a fixture list for a league.
The league has N teams.
Each team plays every other team twice, once at home and once away.
Matches for each team must alternate between home and away e.g. Week 1 - Home, Week 2 - Away
Don't worry about dates - just week numbers will be fine.

There are other rules like Team A cannot play at home if Team B are at home. But this can come later.

The program should create the schedule.

Don't care if it is written in Access, VB, Excel, Sandscrit, Klingon....

Any ideas? Getting a list of matches is the easy bit but allocating them to weeks is proving tricky.

M :-(

 

[Mossoft]

I should have said that the challenge is to create the schedule using the least number of weeks (2*(N-1) would be nice!!).

M

 

[MichaelRed]

Well, yes - BUT this appears to violate one of the requirements, specifically alternating the home/away week for the individual teams. At the very least, this would require an "off week" for some teams, which in many instances would be viewed as an advantage/disadvantage for some team.

I suppose doing the schedual with an unequal number of home/away games would also be an advantage/disdvantage issue. Your (overall) schedual could be shortened somewhat by allowing some number of Home-Home and Away-Away weeks - but maintaining the home-away paiors between teams. This APPEARS to be the wat the "Pros" do it.

MichaelRed
m.red@att.net

There is never time to do it right but there is always time to do it over

 

[MichaelRed]

Hmmmmmmmmmmmmm,

Either you don't want to discuss the possabilities, don't really care what goes on, have given up (at least for the day) or ...

Still, I have put some effort into looking through the process, and just CAN'T bear to see it left only on MY system, so at least Tek-Tips will have a record of this much.

We do NOT meet all of the criteria, but as I noted previously I do not think it is possible within the constraints imposed. There IS an attempt to not schedual sequential Home games, but it is NOT universally achieved.

So, without further ado:

The table
HomeTeam AwayTeam WeekNo

A	        B	        1
A	        C	        3
A	        D	        5
A	        E	        7
A	        F	        9
B	        A	        4
B	        C	        6
B	        D	        3
B	        E	        8
B	        F	        10
C	        A	        2
C	        B	        5
C	        D	        1
C	        E	        9
C	        F	        8
D	        A	        8
D	        B	        7
D	        C	        10
D	        E	        12
D	        F	        12
E	        A	        6
E	        B	        2
E	        C	        4
E	        D	        11
E	        F	        1
F	        A	        12
F	        B	        12
F	        C	        7
F	        D	        4
F	        E	        3

The code to generate the table

Public Function basLeagueSched()

    'To Produce the Home / Away Schedual for a "League"
    'A-La the NFL sixteen Weeks; 32 teams; 16 (or less) Games per week

    'The league has N teams.
    'Each team plays every other team twice, once at home and once away.
    'Matches for each team must alternate between home and away
    'e.g. Week 1 - Home, Week 2 - Away

    Dim dbs As DAO.Database
    Dim rst As DAO.Recordset
    Dim qdfClear As QueryDef

    Dim Idx As Integer          'Loop counter/Index
    Dim Jdx As Integer

    Dim AtHome As String        'Home Team
    Dim AtAway As String        'Away Team
    Dim SkipFlg As Boolean

    Dim Kdx As Integer          'Week Index for Game
    Dim Ldx As Integer

    Const NTeams = 6            'Number of teams in League

    Dim GameMatch(NTeams, (NTeams * 2) - 1) As String     'The "matched" Pairs

    Set dbs = CurrentDb
    Set rst = dbs.OpenRecordset("tblLeagueSched", dbOpenDynaset)
    Set qdfClear = dbs.CreateQueryDef("", "Delete * From tblLeagueSched;")

    qdfClear.Execute

    'First, Create the 'matchups'
    For Jdx = 1 To NTeams               'Home Team
        For Idx = 1 To NTeams           'Away Team
            If (Jdx <> Idx) Then        'Check Team is NOT schedualed to play itself
                AtHome = Chr(64 + Jdx)
                AtAway = Chr(64 + Idx)
                With rst
                    rst.AddNew
                        rst!HomeTeam = AtHome
                        rst!AwayTeam = AtAway

                        For Ldx = 1 To UBound(GameMatch, 2)     'Weeks

                            SkipFlg = False

                            For Kdx = 1 To UBound(GameMatch, 1) 'Teams
                                If (GameMatch(Kdx, Ldx) = AtHome Or _
                                    GameMatch(Kdx, Ldx) = AtAway Or _
                                    GameMatch(Kdx, Ldx - 1) = AtHome) Then
                                    SkipFlg = True
                                    Exit For
                                End If
                            Next Kdx

                            If (SkipFlg = False) Then
                                GameMatch(Idx, Ldx) = AtHome
                                GameMatch(Jdx, Ldx) = AtAway
                                Exit For
                            End If

                        Next Ldx

                        !WeekNo = Ldx

                    rst.Update
                End With
            End If
        Next Idx
    Next Jdx

End Function

MichaelRed
m.red@att.net

There is never time to do it right but there is always time to do it over

 

[Mossoft]

Sorry didnt reply earlier - I'm the other side of the pond and had to sleep.

The rule about alternating Home and Away matches is the one that can be 'flexed' in order for the schedule to be reduced. However, not to the point where a team has all its Home games then all its Away games!!!!

I'll try your code and let you know.
At first glance there does seem to be a problem in week 12 where Team F has 3 matches. I suppose with extra checks those games could be spread over to weeks 13 and 14 (in practise I would prefer them as weeks 1 and 2).

Cheers.

M

 

[MichaelRed]

Actually, now that you point out the issue, there are numerous problems. Not enough checking on my part. I will give it another 'go' later.

Weeks 2, 5, 6, 9, & 10 are all "missing" one 'game', week 11 is missiing 2 games, and week 12 has 4 games (Team f three times and team d Twice). Loks 'fixable', but could take me a while.

MichaelRed
m.red@att.net

There is never time to do it right but there is always time to do it over

 

[Mossoft]

I think it is one of those "looks easy at first glance" sort of problems. BTW if you use 12 teams, team L has a game every day in the last week!!!
Please note: This is a curiosity program/challenge - dont bust a gut on it...and there is no time limit.

M

 

[Sawatzky]

dear mossoft,

(tables are looking a bit messy)
having an even number of teams the problem seems to be unsolvable

week 1 to six could be:
[tt]
week1 week2
home away home away
1 2 2 1
3 4 4 3
5 6 6 5

week 3 week 4
home away home away
1 4 4 1
3 6 6 3
5 2 2 5

week 5 week 6
home away home away
1 6 6 1
3 2 2 3
5 4 4 5
[/tt]

now all the teams with even number have played against each team with odd number
remaing the games where even plays against even and odd plays againt odd

so in the next week any of the remaining combinations
odd combinations even combinations
[tt]
1 3 2 4
3 1 4 2
3 5 4 6
5 3 6 4
1 5 2 6
5 1 6 2
[/tt]
would make play a team at home which should play away

and week 7 would be a week with ony 2 games: 1 odd combination and 1 even combination
the remaining 2 teams have already played against each other.

if n modulo 4 = 0

you can arange the games so only 2*(n-1) weeks are needed, but you can't solve the problem with changing home/away every week.

In fact you can't write code for a problem that cannot be solved at all. ;-)

regards Astrid

 

[Mossoft]

As mentioned earlier in thread, the rule about alternating home and away is one that can be flexed.
In your approach - in week 7 "the other 2 teams have already played" - couldn't the match between the idle teams be played in week 7 instead of week x?
To me, if this problem is solvable at all, it will require an amount of iteration in order to shuffle the fixtures around for the best fit of a) shortness of 'season' and b) the most alternating fixtures.

M

 

[Sawatzky]

Dear Mossoft,

'couldn't the match between the idle teams be played in week 7 instead of week x? '

If so, you would have only 2 games in week x , instead.

if we have for example 8 teams (8 mod 4 = 0) then the problem could be solved in 2*(n-1) weeks having 1 Week where the alteration between home and away is skipped for some teams.

I did not think about odd number of teams, yet.

shuffeling the fixtures, would IMHO only mean to rename team 1 to team 2 or something similar, but not really change the solution.

regards astrid

correct me if I am wrong

 

[MichaelRed]

The Below set of procedures appears to work, at least accomplishing the schedualing of the round-robin natches. It does not accomplsh the alternating of Homw and away matches for each team. In fact, this 'rule' was specifically omitted from the process (see comment in procedure [basLeagueSched].

If I get some more 'slack time', I'll look into including this. Preliminary attempts to do this causes the overall schedual length to grow by ~~ 30%.

Public Function basLeagueSched()

    'To Produce the Home / Away Schedual for a "League"

    'The league has N teams.
    'Each team plays every other team twice, once at home and once away.
    'Matches for each team must alternate between home and away
    'e.g. Week 1 - Home, Week 2 - Away

    Dim dbs As DAO.Database
    Dim rst As DAO.Recordset
    Dim qdfClear As QueryDef

    Dim MySchedItem() As MySchItemType      'All teams
    Dim TeamSched() As MySchItemType        'To "Shuffle" the matches
    Dim WkUsed() As Integer

    Dim Idx As Integer          'Loop counter/Index
    Dim Jdx As Integer
    Dim Kdx As Integer          'Week Index for Game
    Dim Ldx As Integer
    Dim Mdx As Integer          'Index for Structure
    Dim Ndx As Integer

    Dim MyHome As String        'Home Team
    Dim MyAway As String        'Away Team
    Dim MyWeek As Integer
    Dim SkipFlg As Boolean

    Const NTeams = 6            'Number of teams in League
    Dim NWeeks As Integer       'Weeks to Schedual

    Set dbs = CurrentDb
    Set rst = dbs.OpenRecordset("tblLeagueSched", dbOpenDynaset)
    Set qdfClear = dbs.CreateQueryDef("", "Delete * From tblLeagueSched;")

    qdfClear.Execute

    Mdx = 1                             'Init UDT Pointer
    ReDim MySchedItem(Mdx)              'Initalize Structure

    For Jdx = 1 To NTeams               'Home Team
        For Idx = 1 To NTeams           'Away Team

            If (Jdx <> Idx) Then        'Check Team is NOT schedualed to play itself

                With MySchedItem(Mdx)       'Preliminary Entry in Array for This Match
                    .AtHome = Chr(64 + Jdx)
                    .AtAway = Chr(64 + Idx)
                    .WeekNo = 0             'Phoney for Week Number
                End With

                Mdx = Mdx + 1
                ReDim Preserve MySchedItem(Mdx)

            End If

        Next Idx
    Next Jdx

    Mdx = Mdx - 1
    ReDim Preserve MySchedItem(Mdx)
    'Arrive here w/ All matches in [MySchedItem], All Weeks == 0

    basShuffle MySchedItem()        'randomize the Match Lists

    'Assign Each Game/Match to SOME Week
    NWeeks = (NTeams - 1) * 4                   'Min # of Weeks) +
    For Idx = 1 To UBound(MySchedItem)          'Each Game/Match in List

        ReDim TeamSched(NWeeks)                 'Hold the home/Away Games for AtHome
        ReDim WkUsed(NWeeks)                    'Clear Weeks Used in Schedual for Teams

        'Just Select Teams in Current Game/Match
        MyHome = MySchedItem(Idx).AtHome        'Home Team
        MyAway = MySchedItem(Idx).AtAway        'Away Team

        'Collect All Games for Home & Away Teams - Except Current Match
        Kdx = 1
        For Jdx = 1 To UBound(MySchedItem)
            If (Jdx <> Idx) Then                'Dont Check for Current Game/Match
                
                With MySchedItem(Jdx)

                    If (MyHome = .AtHome Or _
                        MyHome = .AtAway Or _
                        MyAway = .AtHome Or _
                        MyAway = .AtAway) Then
                        
                        'Game w/ MyHome or MyAwayTeams
                        TeamSched(Kdx) = MySchedItem(Jdx)   'Add to Team Sched
                        If (WkUsed(MySchedItem(Jdx).WeekNo) = 0) Then
                            WkUsed(MySchedItem(Jdx).WeekNo) = MySchedItem(Jdx).WeekNo
                        End If
                        Kdx = Kdx + 1                       'Incr Counter
    
                    End If

                End With
            End If
        Next Jdx


        'Here with WeekUsed() as a list of Weeks (Sorted)
        'Where Either Team is already involved in a Game/Match
        For Jdx = 1 To NWeeks                   'Try Each Possible Week
            SkipFlg = False                     'Clear Flag
            If (WkUsed(Jdx) = 0) Then           'Already Schedualed?

                'If [AtHome] was [AtHome] or[AtAway] was [AtAway] for the Prev Week.
                'Try to Sched for Next (or some Other) Week

                MySchedItem(Idx).WeekNo = Jdx
                    With rst
                        .AddNew
                            !HomeTeam = MySchedItem(Idx).AtHome
                            !AwayTeam = MySchedItem(Idx).AtAway
                            !WeekNo = MySchedItem(Idx).WeekNo
                        .Update
                    End With
                    SkipFlg = True
                Exit For                    'Quit Checking this Trial
            End If

        Next Jdx

        If (SkipFlg <> True) Then
            'Oops.  Can't Schedual this Match in the Weeks Avail
            NWeeks = NWeeks + 1
            MySchedItem(Idx).WeekNo = Jdx
        End If

    Next Idx

End Function

Public Function basShuffle(MySchedItem() As MySchItemType)

    Dim WkUsed As Variant
    Dim Idx As Integer
    Dim TeamSched() As MySchItemType

    ReDim WkUsed(UBound(MySchedItem))       'Size to hold Values for order of Matched
    'Gen a random List of Integers
    
    WkUsed = basShuffleN(UBound(MySchedItem))

    ReDim TeamSched(UBound(MySchedItem))
    For Idx = 1 To UBound(MySchedItem)
        TeamSched(Idx) = MySchedItem(WkUsed(Idx))
    Next Idx

    For Idx = 1 To UBound(MySchedItem)
        MySchedItem(Idx) = TeamSched(Idx)
    Next Idx

End Function

[code]
 Public Function basShuffleN(intNum As Integer) As Variant
 
    'To Return an Array of Integers (1 to intNum) which will be
    'filled with randomized integers in the range of 1 to intNum

    Dim PlaceArray() As Single
    Dim rtnArray() As Integer
    Dim Idx As Integer
    Dim Sorted As Boolean
    Dim strTemp As String

    ReDim PlaceArray(intNum, 2)
    ReDim rtnArray(intNum)

    'Create an array with the Integers and a Random Number
    For Idx = 1 To UBound(rtnArray)
        PlaceArray(Idx, 1) = Idx
        PlaceArray(Idx, 2) = Rnd()
    Next Idx

    'Sort acording to the Random Number
    Do While Not Sorted
        Sorted = True
        For Idx = 1 To UBound(PlaceArray) - 1
            If (PlaceArray(Idx, 2) > PlaceArray(Idx + 1, 2)) Then
                'Swap
                Sorted = False
                PlaceArray(0, 1) = PlaceArray(Idx, 1)
                PlaceArray(0, 2) = PlaceArray(Idx, 2)
                PlaceArray(Idx, 1) = PlaceArray(Idx + 1, 1)
                PlaceArray(Idx, 2) = PlaceArray(Idx + 1, 2)
                PlaceArray(Idx + 1, 1) = PlaceArray(0, 1)
                PlaceArray(Idx + 1, 2) = PlaceArray(0, 2)
            End If
        Next Idx
    Loop

    'Collect the 'Randomized" Integers into a String
    For Idx = 1 To UBound(PlaceArray, 1)
        rtnArray(Idx) = PlaceArray(Idx, 1)
    Next Idx

    'Return the delimited String
    basShuffleN = rtnArray

End Function
[code] MichaelRed
m.red@att.net

There is never time to do it right but there is always time to do it over