Vb.Net 2D Dictionary - very slow - vb.net

I need to create a 2D dictionary/keyvalue pair.
I tried something like this.
Dim TwoDimData As New Dictionary(Of String, Dictionary(Of String, String))
'Create an empty table
For Each aid In AIDList '(contains 15000 elements)
TwoDimData.Add(aid, New Dictionary(Of String, String))
For Each bid In BIDList 'contains 30 elements
TwoDimData.Item(aid).Add(bid, "")
Next
Next
'Later populate values.
[some code here to populate the table]
'Now access the value
'The idea is to access the info as given below (access by row name & col name)
Msgbox TwoDimData.Item("A004").Item("B005") ' should give the value of 2
Msgbox TwoDimData.Item("A008").Item("B002") ' should return empty string. No error
Issue:
The issue is in Creating the empty table. It takes 70 seconds to create the TwoDimData table with empty values. Everything else seems to be fine. Is there any way to improve the performance - may be instead of using Dictionary?

I suggest you try Dictionary(Of Tuple(Of String, String), String) instead. That is, the keys are pairs of strings (Tuple(Of String, String)) and the values are strings. That would appear to correspond nicely to the diagram in your question.
Dim matrix As New Dictionary(Of Tuple(Of String, String), String)
' Add a value to the matrix:
matrix.Add(Tuple.Create("A003", "B004"), "3")
' Retrieve a value from the matrix:
Dim valueAtA003B004 = matrix(Tuple.Create("A003", "B004"))
Of course you can define your own key type (representing a combination of two strings) if Tuple(Of String, String) seems too generic for your taste.
Alternatively, you could also just use (possibly jagged) 2D arrays, but that would potentially waste a lot of space if your data is sparse (i.e. if there are many empty cells in that 2D matrix); and you'd be forced to use numeric indices instead of strings.
P.S.: Actually, consider changing the dictionary value type from String to Integer; your example matrix suggests that it contains only integer numbers, so it might not make sense to store them as strings.
P.P.S.: Do not add values for the "empty" cells to the dictionary. That would be very wasteful. Instead, instead of simply retrieving a value from the dictionary, you check whether the dictionary contains the key:
Dim valueA As String = "" ' the default value
If matrix.TryGetValue(Tuple.Create("A007", "B002"), valueA) Then
' the given key was present, and the associated value has been retrieved
…
End If

I would think that a simple structure would suffice for this?
Public Structure My2DItem
Public Row As Integer
Public Col As Integer
Public Value As String
End Structure
Public My2DArray As Generic.List(Of My2DItem) = Nothing
Public Size As Integer
Public MaxRows As Integer
Public MaxCols As Integer
'
Sub Initialise2DArray()
'
Dim CountX As Integer
Dim CountY As Integer
Dim Item As My2DItem
'
'initialise
MaxRows = 15000
MaxCols = 30
Size = MaxRows * MaxCols
My2DArray = New Generic.List(Of My2DItem)
'
'Create an empty table
For CountY = 1 To 15000
For CountX = 1 To 30
Item = New My2DItem
Item.Row = CountY
Item.Col = CountX
Item.Value = "0"
My2DArray.Add(Item)
Item = Nothing
Next
Next
'
End Sub
And to read the data out of the array,
Function GetValue(Y As Integer, X As Integer) As String
'
Dim counter As Integer
'
GetValue = "Error!"
If My2DArray.Count > 0 Then
For counter = 0 To My2DArray.Count - 1
If My2DArray(counter).Row = Y Then
If My2DArray(counter).Col = X Then
GetValue = My2DArray(counter).Value
Exit Function
End If
End If
Next
End If
'
End Function
And to read your sample cell A004 B005
MyStringValue = GetValue(4,5)

I would suggest creating a class that has properties for the AID and BID and use this as the basis for the values you want to store
Public Class AIdBId
Public Property AId As Integer
Public Property BId As Integer
Public Sub New(aId As Integer, bId As Integer)
Me.AId = aid
Me.BId = bid
End Sub
End Class
Note that I have used integers for everything because it seems that is all you need and it is more efficient that using a string
Then you can add values where they are non-zero:
'define your dictionary
Dim valueMatrix As New Dictionary(Of AIdBId, Integer)
'add your values
valueMatrix.Add(New AIdBId(1, 1), 1)
valueMatrix.Add(New AIdBId(2, 3), 1)
valueMatrix.Add(New AIdBId(4, 3), 3)
valueMatrix.Add(New AIdBId(5, 8), 8)
'check if a value exixts
Dim valueExixsts As Boolean = valueMatrix.ContainsKey(New AIdBId(9, 9))
'get a value
Dim i As Integer = valueMatrix(New AIdBId(4, 3))
So you can now combine these two to return the value if there is one or zero if not:
Private Function GetValue(valuematrix As Dictionary(Of AIdBId, Integer), aId As Integer, bId As Integer) As Integer
Dim xRef As New AIdBId(aId, bId)
If valuematrix.ContainsKey(xRef) Then
Return valuematrix(xRef)
Else
Return 0
End If
End Function

Related

two-dimensional array to an array in visual basic

I've got a question about using two-dimensional array.
Public twolist(,) As String
For i As Integer = 0 To twolist.length()-1
If Func(twolist(i, )) Then 'this part is hard for me
'doing something
End If
Public Function Func(ByVal CancelInput() As String) As Boolean
What i want to do is Passing two-dimensional array to an array.
I want to read one row in two-dimensional array and pass to function(Func), which is using an array.
Hope You can understand my question... and Thank you!
As an alternative to the For Next Loop, you could use Linq (if you are confortable with it) to perform the same task.
This transforms each element of the source array to a String, groups them in an IEnumerable(Of String) and the result is converted to an unidimensional Array of Strings:
Dim twolist(N, N) As String
Dim CancelInput() As String = twolist.Cast(Of String).Select(Function(str) str).ToArray()
Dim result As Boolean = Func(CancelInput)
I have just used an arbitrary size for your array. You need nested For loops to iterate through a 2 dimensional array. The outer loop goes through the rows and the inner loop adds the value in each field to another array that you are passing to your Function. Each row is passed individually as a single dimension array.
Private Sub TwoDimensionalArray()
Dim twolist(,) As String
ReDim twolist(10, 5)
'First you will need to add data to your array
For x As Integer = 0 To 10
Dim arrayRow(5) As String
For y As Integer = 0 To 5
arrayRow(y) = twolist(x, y)
Next
If Func(arrayRow) Then 'this part is hard for me
'doing something
End If
Next
End Sub
Public Function Func(ByVal CancelInput() As String) As Boolean
Return True
End Function
Mary's answer is good, but assumes you know the length of each dimension.
I have changed it slightly to use the Array.GetLength function:
Private Sub TwoDimensionalArray()
Dim twolist(,) As String
ReDim twolist(10, 5)
'First you will need to add data to your array
For x As Integer = 0 To 10
'Fetch the length of this dimension:
Dim i As Integer = twolist.GetLength(x)
Dim arrayRow(i) As String
For y As Integer = 0 To i - 1
arrayRow(y) = twolist(x, y)
Next
If Func(arrayRow) Then
'do something
End If
Next
End Sub
Public Function Func(ByVal CancelInput() As String) As Boolean
Return True
End Function
Note:
In VB.Net, ReDim twoList(10,5) actually gives you an array of (11,6).
Array.GetLength(0) will return 6 (0,1,2,3,4,5).
In short, Dim specifies the maximum index in each dimension, Length & GetLength return the count of elements.

Generate a property name in a loop

I'm trying to find a way of loading a single record with 25 columns into a datatable.
I could list all 25 variables called SPOT1 to SPOT25 (columns in the datatable) but I'm looking for more concise method like using a loop or dictionary.
The code below shows two methods, a 'long' method which is cumbersome, and a 'concise' method which I'm trying to get help with.
Public dctMC As Dictionary(Of String, VariantType)
Dim newMC As New MONTE_CARLO()
'long method: this will work but is cumbersome
newMC.SPOT1=999
newMC.SPOT2=887
...
newMC.SPOT25=5
'concise method: can it be done more concisely, like in a loop for example?
Dim k As String
For x = 1 To 25
k = "SPOT" & CStr(x)
newMC.K = dctMC(k) 'convert newMC.k to newMC.SPOT1 etc
Next
'load record
DATA.MONTE_CARLOs.InsertOnSubmit(newMC)
Per the others, I think there are better solutions, but it is possible...
Public Class MONTE_CARLO
Private mintSpot(-1) As Integer
Property Spot(index As Integer) As Integer
Get
If index > mintSpot.GetUpperBound(0) Then
ReDim Preserve mintSpot(index)
End If
Return mintSpot(index)
End Get
Set(value As Integer)
If index > mintSpot.GetUpperBound(0) Then
ReDim Preserve mintSpot(index)
End If
mintSpot(index) = value
End Set
End Property
End Class
Usage...
Dim newMC As New MONTE_CARLO
For i As Integer = 0 To 100
newMC.Spot(i) = i
Next i
MsgBox(newMC.Spot(20))

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
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
There are two efficient ways in approaching this problem:
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
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).
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.
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

How to merge two list to have a distinct list without duplicate values in vb.net

I have this problem in vb.net. Lets say I got 2 Lists ListA and ListB both holds objects of same type.
Eg., one of the property of the object is ID. (ID is written in brackets)
ListA ListB
---------------------------
A(3818) A(3818)
B(3819) B(3819)
C(3820) C(3820)
D(3821) D(3821)
E(3823) F(0)
H(3824) G(0)
I(3825)
How do I merge these two Lists to have a new distinct list which holds objects only once whose ID matches and all other objects(whose ID dont match) are simply added to the new list.
Sample output be,
New List
--------
A(3818)
B(3819)
C(3820)
D(3821)
E(3823)
F(0)
G(0)
H(3824)
I(3825)
When I searched I found that AddRange() and Union are some of the methods to do the merge. But i am not able to find if this works for non standard objects(apart from Integer, String)
Use addRange() and then linq with distinct to filter out the duplicates.
Dim b = YourCollection.Distinct().ToList()
Could use a collection bucket
Dim oCol As New Collection
AddTitems(oCol, oListA)
AddTitems(oCol, olistB)
Public Function AddTitems(oSummaryList As Collection, oList As List(Of thing)) As Collection
For Each oThing As thing In oList
If Not oSummaryList.Contains(CStr(oThing.ID)) Then oSummaryList.Add(oList, CStr(oThing.ID))
Next
Return oSummaryList
End Function
Here are a couple simple functions that should do that for you. I'm not sure how efficient they are though. I don't think there is anything built in.
Private Function nameOfFunction(list1 as list(of type), list2 as list(of type)) as list(of type)
Dim result as new list(of type)
for a as integer = 0 to math.max(list1.count, list2.count) - 1 step 1
If a < list1.count AndAlso resultHasID(result, list1(a).ID) = False Then
result.add(list1(a))
end if
If a < list2.count AndAlso resultHasID(result, list2(a).ID) = False Then
result.add(list2(a))
end if
next
End Function
Private Function resultHasID(testList as list(of type), s as string) as boolean
Dim result as Boolean = False
for a as integer = 0 to testlist.count - 1 step 1
if(testlist(a).ID = s) then
result = true
exit for
End if
Next
Return result
End function
For each item as String in ListA
If Not ListB.Contains(item) Then
ListB.Add(item)
End If
Next

VB dictionary contains value return key

I have a problem...
I am trying to put into a list of String dictionary keys values if condition of containsvalue is true:
But, this is not correct :(
here is a code:
Private listID As New List(Of String) ' declaration of list
Private dictionaryID As New Dictionary(Of String, Integer) ' declaration of dictionary
'put a keys and values to dictionary
dictionaryID.Add("first", 1)
dictionaryID.Add("second", 2)
dictionaryID.Add("first1", 1)
If dictionaryID.ContainsValue(1) Then ' if value of dictinary is 1
Dim pair As KeyValuePair(Of String, Integer)
listID.Clear()
For Each pair In dictionaryID
listID.Add(pair.Key)
Next
End If
And now, list must have two elements... -> "first" and "first1"
Can you help me?
Thank you very much!
You are looping through the whole dictionary and add all the elements to the list. You should put an if statement in the For Each or use a LINQ query like this:
If listID IsNot Nothing Then
listID.Clear()
End If
listID = (From kp As KeyValuePair(Of String, Integer) In dictionaryID
Where kp.Value = 1
Select kp.Key).ToList()
Using an if statement:
listID.Clear()
For Each pair As KeyValuePair(Of String, Integer) In dictionaryID
If pair.Value = 1 Then
listID.Add(pair.Key)
End If
Next
My VB.Net is a little rusty, but it looks like you were adding all of them, no matter if their value was 1 or not.
Private listID As New List(Of String) ' declaration of list
Private dictionaryID As New Dictionary(Of String, Integer) ' declaration of dictionary
'put a keys and values to dictionary
dictionaryID.Add("first", 1)
dictionaryID.Add("second", 2)
dictionaryID.Add("first1", 1)
If dictionaryID.ContainsValue(1) Then ' if value of dictinary is 1
Dim pair As KeyValuePair(Of String, Integer)
listID.Clear()
For Each pair In dictionaryID
If pair.Value = 1 Then
listID.Add(pair.Key)
End If
Next
End If