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
Related
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.
I am currently working on a homework assignment for Visual basic. The homework is to display the square value of only the odd numbers 1-9. I have to use a For Next to do so as specified by the assignment. I do not want the answer but a point to the right direction. Here is my code currently it only displays the square value of 9 but will not display the square value of the other odd numbers. I have done a couple tutorials but I can not figure out why it ill not continue the loop.
Public Class MainForm
Private Sub exitButton_Click(sender As Object, e As EventArgs) Handles exitButton.Click
Me.Close()
End Sub
Private Sub displayButton_Click(sender As Object, e As EventArgs) Handles displayButton.Click
'Start/end values and retainer for the values
Dim startVal As Integer
Dim endVal As Integer
Dim squareVal As Integer
startVal = 1
endVal = 9
'For loop to separate the odd and even numbers to square the odd numbers.
For _val As Integer = startVal To endVal Step 1
If _val Mod 2 <> 0 Then
squareVal = _val * _val
squaresLabel.Text = squareVal.ToString() & ControlChars.NewLine
_val += 1
Else
squaresLabel.Text = _val.ToString() & ControlChars.NewLine
_val += 1
End If
Next _val
End Sub
End Class
You are overwriting the text stored in squaresLabel each pass through the loop. Look at the assignment statement:
squaresLabel.Text = squareVal.ToString() & ControlChars.NewLine
I think you are just repeating the calculation not actually output each value. So I suggest you define an array and store them inside of it. Also do trouble shooting for each value. Hope it helps.
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.
Recently when creating a program for my client as part of my computing project in visual basic .net I've came across a problem, which looks like following; In order to receive additional marks for my program I must take an advantage of either Binary Search or Insertion Sort subroutine declared recursively, so far the only place I can use it on is my View form which displays all reports generated by program but the problem with this is since I'm using MS Access to store my data all of the data is downloaded and placed in listview in load part of form. So the only way I can use it is by running it on listview which is a major problem for me due to the fact that I'm not very experienced in vb.
For binary search I have tried downloading all of the items in specified by user column into an array but that's the bit I was struggling on the most because I'm unable to download all items from only one column into an array. Also instead of searching every single column user specifies in my form in which column item is located (For example "19/02/2013" In Column "Date"), In my opinion if I manage to download every single entry in specified column into an array it should allow me to run binary search later on therefore completing the algorithm. Here's what I've got so far.
Sub BinarySearch(ByVal Key As String, ByVal lowindex As String, ByVal highindex As String, ByVal temp() As String)
Dim midpoint As Integer
If lowindex > highindex Then
MsgBox("Search Failed")
Else
midpoint = (highindex + lowindex) / 2
If temp(midpoint) = Key Then
MsgBox("found at location " & midpoint)
ElseIf Key < temp(midpoint) Then
Call BinarySearch(Key, lowindex, midpoint, temp)
ElseIf Key > temp(midpoint) Then
Call BinarySearch(Key, midpoint, highindex, temp)
End If
End If
End Sub
Private Sub btnSearch_Click(sender As System.Object, e As System.EventArgs) Handles btnSearch.Click
Dim Key As String = txtSearch.Text
Dim TargetColumn As String = Me.lstOutput.Columns(cmbColumns.Text).Index
Dim lowindex As Integer = 0
Dim highindex As Integer = lstOutput.Items.Count - 1
'Somehow all of the items in Target column must be placed in temp array
Dim temp(Me.lstOutput.Items.Count - 1) As String
' BinarySearch(Key, lowindex, highindex, temp)
End Sub
For Insertion sort i don't even have a clue how to start, and the thing is that I have to use my own subroutine instead of calling system libraries which will do it for me.
Code which I have to use looks like following:
Private Sub InsertionSort()
Dim First As Integer = 1
Dim Last As Integer = Me.lstOutput.
Dim CurrentPtr, CurrentValue, Ptr As Integer
For CurrentPtr = First + 1 To Last
CurrentValue = A(CurrentPtr)
Ptr = CurrentPtr - 1
While A(Ptr) > CurrentValue And Ptr > 0
A(Ptr + 1) = A(Ptr)
Ptr -= 1
End While
A(Ptr + 1) = CurrentValue
Next
Timer1.Enabled = False
lblTime.Text = tick.ToString
End Sub
Any ideas on how to implement this code will be very appreciated, and please keep in my mind that I'm not very experienced in this language
Perhaps this might give you a place to begin. If you already have a ListView with "stuff" in it you could add a button to the form with the following code to copy the Text property for each item into an array:
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Dim myArray(Me.ListView1.Items.Count - 1) As String
Dim i As Integer
' load array
For i = 0 To Me.ListView1.Items.Count - 1
myArray(i) = Me.ListView1.Items(i).Text
Next
' show the results
Dim s As String = ""
For i = 0 To UBound(myArray)
s &= String.Format("myArray({0}): {1}", i, myArray(i)) & vbCrLf
Next
MsgBox(s, MsgBoxStyle.Information, "myArray Contents")
' now go ahead and manipulate the array as needed
' ...
End Sub
I have exhausted all of my options and am very desperate for help since I cannot figure out where the bug in my code is, or if there is something I don't understand.
I'm trying to create a "methinks it is a weasel!" mimmick from Richard Dawkins' late 80s documentary about evolution. The goal is to progress through a genetic algorithm until the algorithm guesses the correct answer through mutation and fitness tournaments.
Now, here's the problem:
Private Function fitnessTourney(ByVal editGuess() As Guess, ByVal popIndex As Integer, ByVal tourneySize As Integer, ByVal popNum As Integer)
Dim randInt(tourneySize - 1) As Integer
Dim loopCount1 As Integer = 0
Dim fitnessWinner As New Guess
fitnessWinner.setFitness(-50)
...
And, this loop is where I am experiencing the critical error
...
For i = 0 To tourneySize - 1
Randomize()
randInt(i) = Int(Rnd() * popNum)
While editGuess(randInt(i)).Used = True
If loopCount1 > tourneySize Then
loopCount1 = 0
For i2 = 0 To popNum - 1
editGuess(i2).setUsed(False)
Next
i = -1
Continue For
End If
loopCount1 += 1
randInt(i) = Int(Rnd() * popNum)
End While
editGuess(randInt(i)).determineFitness(correctPhrase)
editGuess(randInt(i)).setUsed(True)
Next
For i = 0 To popNum - 1
editGuess(i).setUsed(False)
Next
What this loop is trying to do is pick out four random instances of the editGuess array of objects. This loop tries to prevent one from being used multiple times, as the population is competing to one of the 10 members (highest fitness of the 4 chosen candidates is supposed to win).
The critical error is that I mysteriously get an endless loop where any instances of editGuess(randInt(i)).Used will always evaluate to true. I have tried to fix this by resetting all instances to False if it loops too many times.
The stumper is that I'll have all instances evaluate to False in the debugger. Then, when I reach "editGuess(randInt(i)).setUsed(True)" (the exact same thing as "editGuess(randInt(i)).Used = True"), it sets this value for EVERY member of the array.
Is there anyone who can see what is happening? I am so close to completing this!
Here's the Guess class:
Public Class Guess
Dim Fitness As Integer
Dim strLength As Integer
Dim strArray(30) As String
Dim guessStr As String
Dim Used As Boolean
Public Sub New()
Fitness = 0
guessStr = ""
strLength = 0
Used = 0
End Sub
Public Sub determineFitness(ByVal correctPhrase As String)
Dim lowerVal
If guessStr.Length <= correctPhrase.Length Then
lowerVal = guessStr.Length
Else
lowerVal = correctPhrase.Length
End If
strArray = guessStr.Split("")
Fitness = 0 - Math.Abs(correctPhrase.Length - guessStr.Length)
For i = 0 To lowerVal - 1
If correctPhrase(i) = guessStr(i) Then
Fitness = Fitness + 1
End If
Next
End Sub
Public Sub Mutate(ByVal mutatepercentage As Decimal, ByVal goodLetters As String)
If mutatepercentage > 100 Then
mutatepercentage = 100
End If
If mutatepercentage < 0 Then
mutatepercentage = 0
End If
mutatepercentage = mutatepercentage / 100
If Rnd() < mutatepercentage Then
strLength = Int(Rnd() * 25) + 5
If strLength < guessStr.Length Then
guessStr = guessStr.Remove(strLength - 1)
End If
End If
For i = 0 To strLength - 1
If Rnd() < mutatepercentage Then
If i < guessStr.Length Then
guessStr = guessStr.Remove(i, 1).Insert(i, goodLetters(Int(Rnd() * goodLetters.Length)))
Else
guessStr = guessStr & goodLetters(Int(Rnd() * goodLetters.Length))
End If
End If
Next
End Sub
Public Sub setFitness(ByVal num As Integer)
Fitness = num
End Sub
Public Sub setStrLength(ByVal num As Integer)
strLength = num
End Sub
Public Sub initializeText()
End Sub
Public Sub setUsed(ByVal bVal As Boolean)
Used = bVal
End Sub
End Class
And, finally, here's where and how the function is called
Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
population1(counter) = fitnessTourney(population1, counter, 4, 10)
population2(counter) = fitnessTourney(population2, counter, 4, 10)
population1(counter).Mutate(2, goodLetters)
population2(counter).Mutate(20, goodLetters)
Label1.Text = population1(counter).guessStr
Label2.Text = population2(counter).guessStr
counter += 1
If counter > 9 Then
counter = 0
End If
End Sub
End Class
EDIT 1:
Thank you guys for your comments.
Here is the custom constructor I use to the form. This is used to populate the population arrays that are passed to the fitnessTourney function with editGuess.
Public Sub New()
InitializeComponent()
Randomize()
For i = 0 To 9
population1(i) = New Guess
population2(i) = New Guess
Next
counter = 0
correctPhrase = "Methinks it is a weasel!"
goodLetters = "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ !##$%^&*()_+-=?></.,;\|`'~"
goodLettersArr = goodLetters.Split("")
For i = 0 To 9
population1(i).setStrLength(Int(Rnd() * 25) + 5)
population2(i).setStrLength(Int(Rnd() * 25) + 5)
For i2 = 0 To population1(i).strLength
population1(i).guessStr = population1(i).guessStr & goodLetters(Int(Rnd() * goodLetters.Length))
Next
For i2 = 0 To population2(i).strLength
population2(i).guessStr = population2(i).guessStr & goodLetters(Int(Rnd() * goodLetters.Length))
Next
Label1.Text = population1(i).guessStr
Label2.Text = population2(i).guessStr
Next
population1(0).guessStr = correctPhrase
population1(0).determineFitness(correctPhrase)
End Sub
I haven't studied all of your code thoroughly, but one big problem is that you are calling Randomize from within the loop. Every time you call Randomize, it re-seeds the random numbers with the current time. Therefore, if you call it multiple times before the clock changes, you will keep getting the first "random" number in the sequence using that time which will always evaluate to the same number. When generating "random" numbers, you want to re-seed your random number generator as few times as possible. Preferably, you'd only seed it once when the application starts.
As a side note, you shouldn't be using the old VB6 style Randomize and Rnd methods. Those are only provided in VB.NET for backwards compatibility. You should instead be using the Random class. It's easier to use too. With the Random class, you don't even need to call a randomize-like method, since it automatically seeds itself at the point in time when you instantiate the object. So, in the case of the Random class, the thing to be careful is to make sure that you only instantiate the object once before entering any loop where you might be using it. If you create a new Random object inside a loop, it will similarly keep generating the same numbers.