user3151836
user3151836

Reputation: 25

More effective loop

I'm making a player-match-up program in Visual Basic. The program is supposed to pick random registered players and and pair them. I'm currently working on the odd-number-of-players-part.

The solution I have is working but is perhaps not that effective. Is there a better way for me to write this code?

The code is supposed to pick the random players and make sure they are not picked again. As you see, for the code to work i must make it loop thousands of times. If I don't some of the players won't show up in the listbox. Is there a better solution???

In case it's confusing "spiller" is norwegian for "player"

For i As Integer = 0 To 100000
            Dim spiller1 As Integer
            Dim spiller2 As Integer

            Do
                spiller1 = CInt(Math.Floor(Rnd() * spillerListe.Count))
                spiller2 = CInt(Math.Floor(Rnd() * spillerListe.Count))

            Loop Until CBool(spiller1 <> spiller2)

            If brukteSpillere(spiller1) = False And brukteSpillere(spiller2) = False Then
                brukteSpillere(spiller1) = True
                brukteSpillere(spiller2) = True
                lstSpillere.Items.Add(spillerListe(spiller1).ToString + " VS. " + spillerListe(spiller2).ToString())
            End If
        Next i

Upvotes: 1

Views: 102

Answers (4)

John Alexiou
John Alexiou

Reputation: 29244

Try this:

Module Module1
Dim rnd As New Random

Sub Main()

    Dim RegisteredPlayers As New List(Of Player)
    ' Fill List (example 100 players)
    For index As Integer = 1 To 100
        RegisteredPlayers.Add(New Player(String.Format("Player{0}", index)))
    Next
    'Sort Players using a random number
    Dim SortedPlayersArray = RandomSortItems(RegisteredPlayers.ToArray())

    'Pair players by selecting 2 consequative ones from randomly sorted array
    Dim Matches As New List(Of Match)
    For index As Integer = 1 To SortedPlayersArray.Length Step 2
        Dim m As Match = New Match(SortedPlayersArray(index - 1), SortedPlayersArray(index))
        Matches.Add(m)
        Debug.WriteLine(m.ToString())
    Next
    ' Match Player48 vs. Player79
    ' Match Player3 vs. Player53
    ' Match Player18 vs. Player43
    ' Match Player85 vs. Player1
    ' Match Player47 vs. Player56
    ' Match Player23 vs. Player66
    ' etc..

End Sub

Public Function RandomSortItems(Of T)(ByVal items As T()) As T()
    Dim sorted As T() = New T(items.Length-1) {}
    Array.Copy(items, sorted, sorted.Length)
    Dim keys As Double() = New Double(items.Length-1) {}
    For i As Integer = 1 To items.Length
        keys(i - 1) = rnd.NextDouble()
    Next
    Array.Sort(keys, sorted)
    Return sorted
End Function
End Module1

Public Class Player
    Dim m_name As String
    Public Sub New(ByVal player_name As String)
        m_name = player_name
    End Sub
    Public ReadOnly Property Name() As String
        Get
            Return m_name
        End Get
    End Property

    Public Overrides Function ToString() As String
        Return m_name
    End Function
End Class

Public Class Match
    Dim m_player_1 As Player, m_player_2 As Player

    Public Sub New(ByVal player_1 As Player, ByVal player_2 As Player)
        m_player_1 = player_1
        m_player_2 = player_2
    End Sub

    Public ReadOnly Property Player1() As Player
        Get
            Return m_player_1
        End Get
    End Property
    Public ReadOnly Property Player2() As Player
        Get
            Return m_player_2
        End Get
    End Property
    Public Overrides Function ToString() As String
        Return String.Format("Match {0} vs. {1}", Player1, Player2)
    End Function
End Class

Edit 1:

An alternate random sorter (which should be faster) is

Public Function RandomSortItems(Of T)(ByVal items As T()) As T()
    Dim slist As New SortedList(Of Double, T)
    For i As Integer  = 1 to items.Length
        slist.Add(rnd.NextDouble(), items(i-1) )
    Next i
    return slist.Values.ToArray()
End Function

Upvotes: 0

Steve
Steve

Reputation: 216293

Instead of working with integers, what if you keep your players name in a list and, after picking a player you remove it from the list. Probably this will not be the best performant solution, but it is clear what are you trying to do

Dim lstSpillere = new List(Of String)() ' Just for the example below
Dim spillerListe = new List(Of String)() from {"Marc", "John", "Steve", "George", "David", "Jeremy", "Andrew" }

Dim rnd = new Random()
While spillerListe.Count > 1
    Dim firstPlayer = spillerListe(rnd.Next(0, spillerListe.Count))
    spillerListe.Remove(firstPlayer)
    Dim secondPlayer = spillerListe(rnd.Next(0, spillerListe.Count))
    spillerListe.Remove(secondPlayer)
    lstSpillere.Add(firstPlayer + " VS. " + secondPlayer)
    ' for debug purpose....
    Console.WriteLine(firstPlayer & " VS. " & secondPlayer)
End While

if spillerListe.Count > 0 Then
   Console.WriteLine("Excluded from play list is:" & spillerListe(0))
End if

The important key here is the generation of Random instance that should be outside the loop to avoid to generate the same number in the short time period required by the loop to execute.

Upvotes: 0

Victor Zakharov
Victor Zakharov

Reputation: 26424

There are two efficient ways in approaching this problem:

  1. Sort your player list by random number, then match up 1 with 2, 3 with 4 and so on.

    Dim r As New Random
    Dim randomListe = spillerListe.OrderBy(Function() r.Next).ToList
    
  2. Generate two random numbers from your range, match up those players into a separate List, remove players from the original list. General two more random numbers from a smaller range (original minus 2), match up, etc.

EDIT: Having looked at MSDN, List has O(n) performance for RemoveAt, so it's not quite efficient, better be using a dictionary, which is O(1) at removing items, so instead of spillerListe have some spillerDicte, where you would add entries in a form (key = index, value = item).

Upvotes: 2

the_lotus
the_lotus

Reputation: 12748

This is a mess... Have a List(Of Integer) with all the available index.

Loop while availableIndex.Count > 1
   Pick a random index from availableIndex and remove it from that list
   Pick a random index from availableIndex and remove it from that list

   Add these two index to the list of pairs
End Loop

that way you don't need to check if the random values are the same or if they were already picked.

Now, if you don't want to create a list. Then threat the random number not as an index, but as the number of items to check.

Delta = RandomNumber
x = 0

For i As Integer = 0 To itemList.Count-1
  If Not itemList(i).IsChoosen Then
    x += 1

    If x = Delta Then
       ' i is now your item to pick
       itemList(i).IsChoosen = True
       Exit For
    End If
  End If
Next

Upvotes: 4

Related Questions