I have to work with multiple big 2-dimensional arrays (1024 x 128 for example) and in a section of my code I need to transpose some (up to 12 of them).
The procedure takes a fair amount of time and I'm trying to speed it up as much as possible. Knowing that VB.NET supports multi-threading I gave a read here and there to different sources and could come up with the following code in the main subroutine:
RunXTransposingThreads(Arr1, Arr2, Arr3, ...)
Using BackgroundWorkers as a part of my solution:
Private Sub RunXTransposingThreads(ParamArray ArraysToTranspose() As Array)
Dim x = CInt(ArraysToTranspose.GetLength(0)) - 1
Dim i As Integer
For i = 0 To x
Dim worker As New System.ComponentModel.BackgroundWorker
AddHandler worker.DoWork, AddressOf RunOneThread
AddHandler worker.RunWorkerCompleted, AddressOf HandleThreadCompletion
worker.RunWorkerAsync(ArraysToTranspose(i))
Next
End Sub
Private Sub RunOneThread(ByVal sender As System.Object, ByVal e As System.ComponentModel.DoWorkEventArgs)
Dim Transposed(,) As Single = Array.CreateInstance(GetType(Single), 0, 0) ' I need this to be like that in order to use other functions later
Transposed = Transpose2dArray(CType(e.Argument, Single(,)))
e.Result = Transposed
End Sub
Private Sub HandleThreadCompletion(ByVal sender As Object, ByVal e As System.ComponentModel.RunWorkerCompletedEventArgs)
Debug.Print("Process complete")
End Sub
Function Transpose2dArray(Of Array)(ByVal inArray As Array(,)) As Array(,)
Dim x = CInt(inArray.GetLength(1))
Dim y = CInt(inArray.GetLength(0))
Dim outArray(x - 1, y - 1) As Array
For i = 0 To x - 1
For j = 0 To y - 1
outArray(i, j) = inArray(j, i)
Next
Next
Transpose2dArray = outArray
End Function
The threads seem to work, because at some point after the execution of RunXTransposingThreads, I see on my screen a number of "Process complete". The question is: how do I stop the code in main from being executed if I don't have yet transposed arrays?
As others have said, BackgroundWorker is obsolete. Fortunately there are many other modern ways of doing this.
Therefore I won't show you something that makes your code works with BackgroundWorker. Instead I'll show you how to do the same thing by using Tasks, one of those modern ways. Hope it helps.
Function RunXTransposingTasks(ParamArray ArraysToTranspose() As Array) As Array
Dim taskList = New List(Of Task(Of Single(,))) ' our tasks returns Arrays
For Each arr In ArraysToTranspose
Dim r = arr
taskList.Add(Task.Run(Function() Transpose2dArray(r)))
Next
Task.WhenAll(taskList) ' wait for all tasks to complete.
Return taskList.Select(Function(t) t.Result).ToArray()
End Function
Function Transpose2dArray(inArray As Array) As Single(,)
Dim x = inArray.GetLength(1) - 1
Dim y = inArray.GetLength(0) - 1
Dim outArray(x, y) As Single
For i = 0 To x
For j = 0 To y
outArray(i, j) = inArray(j, i)
Next
Next
Return outArray
End Function
' Usage
' Dim result = RunXTransposingTasks(Arr1, Arr2, Arr3, ...)
You could try using build-in function to copy data
Array.Copy(inArray, outArray, CInt(inArray.GetLength(1)) * CInt(inArray.GetLength(0)))
There's also some great example on how to use Parallel.ForEach.
Related
I am attempting to implement an array using the shell sort algorithm. The program will sort the array and output each element to the Listbox after the button was clicked. However, the first item output is always 0. I have included a piece of my source code and a photo of the form below;
Dim randGen As New Random()
Dim unstArray() As Integer
Dim unstArrayCopy() As Integer
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click 'Generates random number to save in array.
Dim i As Integer = CInt(TextBox1.Text)
ReDim unstArray(i)
ReDim unstArrayCopy(i)
For x = 0 To i
unstArray(x) = randGen.Next(1, 10001)
Next
Array.Copy(unstArray, unstArrayCopy, i)
End Sub
Private Sub ShllSrtBtn_Click(sender As Object, e As EventArgs) Handles shllSrtBtn.Click
shellsort(unstArrayCopy, unstArrayCopy.GetUpperBound(0))
End Sub
Sub shellsort(ByRef shellSort() As Integer, ByVal max As Integer)
Dim stopp%, swap%, limit%, temp%, k%
Dim x As Integer = CInt((max / 2) - 1)
Do While x > 0
stopp = 0
limit = max - x
Do While stopp = 0
swap = 0
For k = 0 To limit
If shellSort(k) > shellSort(k + x) Then
temp = shellSort(k)
shellSort(k) = shellSort(k + x)
shellSort(k + x) = temp
swap = k
End If
Next k
limit = swap - x
If swap = 0 Then stopp = 1
Loop
x = CInt(x / 2)
Loop
For i = 0 To shellSort.GetUpperBound(0)
ListBox1.Items.Add(shellSort(i))
Next i
End Sub
The problem is here:
ReDim unstArray(i)
ReDim unstArrayCopy(i)
In VB, when you initialize an array, you must give it the maximum index you want to use, not the intended array length as in other languages like C#.
Because of that, your code creates an array of length i+1, but you only loop from 0 to i when filling the array. So the last element at index i will always be zero.
You should set the initializer in these lines to i-1.
VB Array Reference
I'm a beginner working on my first application using Visual Basic in Visual Studio 2019.
I want to calculate this:
I have all Wi in (list view) and also (text box).
I have all Hi in (list view).
My problem is how could I multiply wi list view (or Wi text box) by hi list view and get this result in a third list view ?
I expect that the biggest problem you have found is getting the data from the ListViews - please note that using a Control to store data is usually a bad idea.
Note that array indexes in VB.NET (and C# and many other computer languages) start at zero (i.e. they are offsets, rather than indices as used in maths).
Once you have the data in arrays, it is easy to perform the calculation. Coming up with meaningful names for the methods and variables is also a problem.
With ListViews named ListViewW, ListViewH, and ListViewF I came up with this:
Public Class Form1
Dim rand As New Random()
Function Fvalues(Fb As Double, weights As Double(), values As Double()) As Double()
If weights.Length <> values.Length Then
Throw New ArgumentException("Number of weights does not equal number of values.")
End If
'TODO: Possibly more argument checking.
Dim total = 0.0
For i = 0 To weights.Length - 1
total += weights(i) * values(i)
Next
'TODO: Check for total = 0.
Dim F(weights.Length - 1) As Double
For i = 0 To weights.Length - 1
F(i) = Fb * weights(i) * values(i) / total
Next
Return F
End Function
Function ListViewToDoubles(lv As ListView) As Double()
Dim d As New List(Of Double)
For i = 0 To lv.Items.Count - 1
Dim dbl As Double
If Double.TryParse(lv.Items(i).Text, dbl) Then
d.Add(dbl)
End If
Next
Return d.ToArray()
End Function
Sub CreateSampleData()
For i = 1 To 5
ListViewW.Items.Add(rand.NextDouble().ToString())
ListViewH.Items.Add(rand.Next(0, 11).ToString())
Next
End Sub
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
CreateSampleData()
Dim weights = ListViewToDoubles(ListViewW)
Dim values = ListViewToDoubles(ListViewH)
Dim f = Fvalues(0.5, weights, values)
For Each x In f
ListViewF.Items.Add(x.ToString())
Next
End Sub
End Class
I am use VB.net to help solve some equations by interating them. It is taking a long time using one thread so I hoping someone can help me Multithread the code. Here is an over simplified example of what I am trying to achieve.
Public Class Form1
Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click
Dim Evens(6) As Integer
Dim Odds(6) As Integer
For i = 0 To 6
Evens(i) = i * 2
Odds(i) = i * 2 + 1
Next
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Evens = RunLoop(Evens, 0, 6) 'The best way to Multi thread this part please.
Odds = RunLoop(Odds, 0, 6)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
For i = 0 To 6
TextBox1.AppendText(Evens(i) & vbNewLine)
TextBox1.AppendText(Odds(i) & vbNewLine)
Next
End Sub
Private Function RunLoop(Numbers() As Integer, Start As Integer, Last As Integer)
For i = Start To Last
Numbers(i) *= Numbers(i)
Next
Return Numbers
End Function
End Class
I need to past data back to the main thread, so I can compare the results from each thread against each other. I have created a class for the data I need to past back from the function.
The time spend in each for loop can be different lengths.
You could run them in parallel, with a Parallel For Loop, just need to be careful that the order things are executed isn't important. This loop only guarantees that each item in the iteration will be done, they will not happen in any kind of specific order...
To implement that with your code, you would simply need to make the following change:
Private Function RunLoop(Numbers() As Integer, Start As Integer, Last As Integer)
'For i = Start To Last
' Numbers(i) *= Numbers(i)
'Next
'Run every iteration in the loop in parallel:
Parallel.For(Start, Last + 1, Sub(i) Numbers(i) *= Numbers(i))
Return Numbers
End Function
this is my first time posting so please accept my apologies if im not doing this right and please feel free to correct me for any formatting or posting guidelines. I am doing this in VB.Net with .NET Framework 4.5.2.
I have a large collection called gBoard in a class.
Private gBoard As Collection
It contains roughly 2000 instances of a class.
What i am trying to achieve is for each item in the class, i want to look at each other item in the class and then update the first item based on variables in the second.
Currently i have the following code:
In the main class:
Private gBoard As New Collection ' This is populated elsewhere in the code
Private Sub CheckSurroundings()
For i As Integer = 1 To (xBoxes)
For j As Integer = 1 To (yBoxes)
For x = 1 As Integer To (xBoxes)
For y = 1 As Integer To (yBoxes)
Tile(New Point(i, j)).CheckDistance(Tile(New Point(x, y)))
Next y
Next x
Next j
Next i
End Sub
Private Function Tile(ByVal aPoint As Point) As clsTile
Return gBoard.Item("r" & aPoint.Y & "c" & aPoint.X)
End Function
In clsTile i have the following (as well as other items):
Private Function SurroundingTerrain(ByVal aTer As String) As clsTerrain
Return mySurroundings.Item(aTer) ' a small collection (6 items of clsTerrain type)
End Function
Public Sub CheckDistance(ByRef aTile As clsTile)
SurroundingTerrain(aTile.Terrain).CheckDistance(CalcDistance(Location, aTile.Location))
End Sub
Private Function CalcDistance(ByVal myPoint As Point, ByVal aPoint As Point) As Double
Dim myReturn As Double = 0
Dim xDiff As Integer = 0
Dim yDiff As Integer = 0
Dim tDiff As Integer = 0
xDiff = Math.Abs(myPoint.X - aPoint.X)
yDiff = Math.Abs(myPoint.Y - aPoint.Y)
tDiff = xDiff + yDiff
myReturn = (MinInt(xDiff, yDiff) * 1.4) + (tDiff - MinInt(xDiff, yDiff))
Return myReturn
End Function
Private Function MinInt(ByVal a As Integer, ByVal b As Integer) As Integer
Dim myReturn As Integer = a
If b < myReturn Then
myReturn = b
End If
Return myReturn
End Function
in clsTerrain i have the following sub that is called:
Public Sub CheckDistance(ByVal aDist As Double)
If aDist < Distance Then
Distance = aDist
End If
End Sub
This runs and works file but as you can guess it runs so slow... I have been trying to work out how to make this run faster and i looked into threading/tasks but it doesnt seem to work. There are no errors but the objects don't appear to update correctly (or at all). The code i tried was:
In the main class:
Private Sub CheckSurroundings()
Dim tasks As New List(Of Task)
Dim pTile As clsTile
For Each pTile In gBoard
tasks.Add(Task.Run(Sub() TileToCheck(pTile)))
Next
Task.WaitAll(tasks.ToArray())
End Sub
Private Sub TileToCheck(ByRef aTile As clsTile)
For x As Integer = 1 To (xBoxes)
For y As Integer = 1 To (yBoxes)
aTile.CheckDistance(Tile(New Point(x, y)))
Next y
Next x
End Sub
Does anyone have any suggestions or ideas for how to get this to work?
Sorry for any headaches or facepalms caused...
Here is my code,
Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
For Each kthread As Thread In _threads
If kthread.Name = "123" Then
_threads.Remove(kthread)
kthread.Abort()
killedthreads += 1 'a integer
End If
Next
End Sub
I added the killedthreads integer at last as a check, vb executes the whole function good but at the last line it always throw the error said in title.
Not sure why, if killedthreads += 1 is not there then the error goes to kthread.Abort()
I had the same problem with C# with a different app earlier this year.
Edit,
Public Sub KillThread(kThread As Thread)
For i As Integer = (_threads.Count - 1) To 0 Step -1
If _threads.Item(i).Name = kThread.Name Then
_threads.Item(i).Abort()
_threads.RemoveAt(i)
End If
Next
End Sub
I did this code as Eminem said it. This gets in kThread from the running threads if something is not good or it has finished all its functions. But my problem is that, only the first thread that sends it gets abort and removed from list, others seem to get stuck once the first thread is aborted.
I create threads using,
Public Sub multiThreader(int As Integer, link As String)
Dim tCount As Integer = _threads.Count
If tCount >= Form1.ListView1.Items.Count Then
Else
Dim dy As Integer = DateTime.Now.Day
Dim mo As Integer = DateTime.Now.Month
Dim fileNum As String = dy.ToString() + "-" + mo.ToString() + "_" + int.ToString
botThread = New Thread(Sub() MainThread(fileNum, link, botThread, int.ToString()))
botThread.IsBackground = True
botThread.Name = String.Format("AutoBotThread{0}", fileNum)
_threads.Add(botThread)
botThread.Start()
End If
End Sub
and _threads is publicly, Public _threads As New List(Of Thread)
MainThread is a Public Sub which runs functions and gets return and send KillThread under certain conditions.
The problem is that you remove an item from an enumeration, before you finished iterating through it.
It's like trying to iterate from 0 to list.count, when the count changes from an iteration to another. As Bjørn-Roger Kringsjå said, you should do something like this:
For i As Integer = (_threads.count - 1) to 0 Step -1
If _threads.Item(i).Name = "123" Then
_threads.Item(i).Abort
_threads.RemoveAt(i)
killedthreads += 1 'a integer
End If
Next
By using Step -1 you make sure that an Index was out of range error will not occur, and make sure that your operations are fitted, and execute on the right order/item.