Competition Scheduling

General FreeBASIC programming questions.
Post Reply
rpkelly
Posts: 52
Joined: Sep 03, 2016 22:36

Competition Scheduling

Post by rpkelly »

I've started gathering various ways of generating a generic pairings schedule for sporting competitions. After Mr Google and I spent some time together, I decided to start with a round robin pairings. My initial rough effort is below. Is there a better way to implement a round robin algorithm?

Code: Select all

Type Pairings

  Pair1 AS UShort
  Pair2 AS UShort
   
END TYPE

DIM iTotalTeams AS UShort
DIM iTotalRounds AS UShort
DIM arPairings() AS Pairings

DIM lEvenTeams AS Boolean
DIM arTeams() AS UShort
DIM iTeam AS UShort
DIM iRound AS UShort
DIM iIndex AS UShort
DIM iHalfTeams AS UShort
DIM uPairings AS Pairings
DIM iPairings AS UShort = 0
DIM iByeTeam AS UShort = 0

   iTotalTeams = 12   ' Set to the number of contestants/teams

   ERASE arPairings
   iTotalRounds = 0
   
' Three individuals/teams minimum required

   If iTotalTeams > 2 THEN
      
' If total teams is odd, add 1 to make it an even number

      lEvenTeams = IIF(iTOtalTeams MOD 2 = 0,True,False)
      iTotalTeams = iTotalTeams + IIF(lEvenTeams = True,0,1)
      
' Total rounds is one less than the number of teams

      iTotalRounds = iTotalTeams - 1
      
' Array offset where second group starts

      iHalfTeams = iTotalTeams / 2
      
' If odd number of teams, randomly pick one to be the phantom bye

      If lEvenTeams = False THEN
         
         Randomize ,5
         iByeTeam = (INT(1 + Rnd * 100000000) MOD iTotalTeams) + 1
         
      END IF
      
' Allocate array sizes

      REDIM arTeams(0 to iTotalTeams - 1)
      REDIM arPairings(0 to ((iTotalRounds * iTotalTeams) / 2) - 1)
      
' Load Team/Individual ID's

      For iIndex = 0 to iHalfTeams - 1
         
          arTeams(iIndex) = iIndex + 1
          
      NEXT iIndex
         
' Reverse second half Team/Individual ID's

      iIndex = iHalfTeams
      
      FOR iTeam = iTotalTeams to iHalfTeams + 1 Step -1
         
          arTeams(iIndex) = iTeam
          iIndex = iIndex + 1
         
      NEXT iTeam
      
' Start the rounds

      for iRound = 0 to iTotalRounds - 1
         
          FOR iTeam = 0 to iHalfTeams - 1
             
' Build the pairing from first and second groups

              uPairings.Pair1 = arTeams(iTeam)
              uPairings.Pair2 = arTeams(iHalfTeams + iTeam)
              
' Check for possible bye. When found, set Pair1 = Pair2 to identify

              If uPairings.Pair1 = iByeTeam THEN
                 
                 uPairings.Pair1 = uPairings.Pair2
                 
              ELSE
                 
                 if uPairings.Pair2 = iByeTeam THEN
                    
                    uPairings.Pair2 = uPairings.Pair1
                    
                 END IF
                 
              END IF
              
              arPairings(iPairings) = uPairings
              iPairings = iPairings + 1
              
          NEXT iTeam    
              
' Rotate teams - index 0 is fixed

' Swap index 0 with first ID of second group

          SWAP arTeams(0), arTeams(iHalfTeams)
             
' Rotate index 0 back to beginning

          FOR iIndex = iHalfTeams to 1 Step -1
                
              SWAP arTeams(iIndex), arTeams(iIndex - 1)
                
          NEXT iIndex
             
' Rotate first ID of second group to end

          FOR iIndex = iHalfTeams to iTotalTeams - 2
                
              SWAP arTeams(iIndex), arTeams(iIndex + 1)
                
          NEXT iIndex
       
      NEXT iRound
      
   END IF
   
' Show pairings results
   
FOR iRound = 1 to iTotalRounds

print ""
print "Round " + str(iRound)
print ""
      
FOR iTeam = 0 to iHalfTeams - 1

print str(arPairings(iRound * iHalfTeams - iHalfTeams + iTeam).Pair1) + _
IIF(arPairings(iRound * iHalfTeams - iHalfTeams + iTeam).Pair1 = _
arPairings(iRound * iHalfTeams - iHalfTeams + iTeam).Pair2, _
"-Bye","v" + str(arPairings(iRound * iHalfTeams - iHalfTeams + iTeam).Pair2))
         
NEXT iTeam
      
NEXT iRound
   
   Print "press q to quit"
Do
     Sleep 1, 1
Loop Until Inkey = "q"
Post Reply