Is it possible to use multiple threads program to speed up the process of my program?
my program is the following
1- generate a random number
2- query by this number one remote server
3- store the result in text file
the problem is basically when i query the remote server it takes 10 seconds
instead of waiting this time I wanted to generate 100 or 1000 number and send them separately and then when the result come I will keep them in buffer and save them later to text
any help or idea in that ?
I would look at using Microsoft's Reactive Framework (NuGet Rx-Main).
This would be your code:
Dim rnd = New Random()
Dim query = _
From i In Observable.Range(0, 1000) _
From n In Observable.Start(Function () rnd.Next()) _
From r in Observable.Start(Function (x) CallWebService(x)) _
Select r
File.WriteAllLines(filePath, _
String.Join(Environment.NewLine, query.ToEnumerable()))
All run on background threads with maximum throughput.
Done!
Module Module1
Sub main()
Randomize()
Dim r = New Random
Dim rLock = New Object
Dim results As New Concurrent.ConcurrentBag(Of Tuple(Of Integer, String))
Dim getRandom = New Func(Of Integer)(Function()
SyncLock rLock
Return r.Next(0, Integer.MaxValue)
End SyncLock
End Function)
' total number of loops
' v
System.Threading.Tasks.Parallel.For(0, 100, Sub(i)
Dim aRandom = getRandom()
'process the query
Dim output = "-server-response-" 'or whatever the outcome of processing
results.Add(New Tuple(Of Integer, String)(aRandom, output))
End Sub)
For Each itm In results
Console.WriteLine(itm.Item1 & vbTab & itm.Item2)
Next
End Sub
End Module
Related
Is it possible to speed up this code using Parallel.For loop?
I have List of few millions Integer arrays and need to remove all arrays that doesn't meet compare criteria. How can I use multi-threading to speed-up the loop through the List if I need to remove some items from it?
(This is simple code example, real code has more complex criteria checks inside the loop)
Function NewList(iList As List(Of Integer())) As List(Of Integer())
Dim i As Integer
Dim j As Integer
Dim compareArray As Integer() = {0, 1, 2, 3, 4}
Dim item As Integer()
For i = iList.Count - 1 To 0 Step -1
item = iList.Item(i)
For j = 0 To UBound(compareArray )
If compareArray(j) > 0 AndAlso Not item.Contains(compareArray(j)) Then
iList.RemoveAt(i)
GoTo nextIteration
End If
Next j
nextIteration:
Next i
Return iList
End Function
I would try something like this (untested):
Public Shared Function GetFilteredList(valueList As List(Of Int32()), mustIncludeList As Int32()) As List(Of Int32())
'Check args
If (valueList Is Nothing) Then Throw New ArgumentNullException(NameOf(valueList))
If (mustIncludeList Is Nothing) OrElse (Not mustIncludeList.Any()) Then Return New List(Of Int32())(valueList) 'A new instance to avoid side effects. Could be optimized if not needed
'Normalize args
mustIncludeList = (From e In mustIncludeList.Distinct() Where e > 0 Order By e).ToArray() 'Normalize it, remove duplicates and values < 1 (don't do it 1 million times inside the loop)
'Initialize the filter
Dim myFilter As Func(Of Int32(), Boolean) = Function(valueArray As Int32())
'As all of the values must be included we can skip all arrays that are shorter
If (valueArray Is Nothing) OrElse (valueArray.Length < mustIncludeList.Length) Then Return False
'Try out if the next line gives a better performance (depends a bit the size of the arrays)
Dim myValues As New HashSet(Of Int32)(valueArray)
For Each myMustInclude As Int32 In mustIncludeList
If (Not myValues.Contains(myMustInclude)) Then Return False
Next
Return True
End Function
'Apply filter and return new list
Return valueList.AsParallel().Where(myFilter).ToList()
End Function
EDITED
Thanks to everybody and especially for #Christoph advice to assign "Nothing" to items instead of deleting them and then to clear "Nothing"s from List. Also useful advice to normalize/prepare compare array once outside the loop and not check it millions times [this advice is not implemented here )]
Result speed increased from "minutes" to "seconds"
The following code returns new list in milliseconds with over 2 millions items.
Function NewList(iList As List(Of Integer())) As List(Of Integer())
Dim compareArray As Integer() = {12, 15, 24}
'//Note that "j" and "item" should be declared inside enclosed Sub
'Parallel.For(0, iList.Count - 1, Sub(i)
Parallel.For(0, iList.Count, Sub(i)
'//changed upper limit for loop /see comment below code/
Dim j As Integer
Dim item As Integer()
item = iList.Item(i)
For j = 0 To UBound(compareArray)
If compareArray(j) > 0 AndAlso Not item.Contains(compareArray(j)) Then
iList(i) = Nothing
GoTo nextIteration
End If
Next j
nextIteration:
End Sub)
'//parallel.for looped instantly with 2,118,760 items
'//then removing "Nothing" in usual loop have taken more than a minute,
'//so speed-up failed
'Dim k As Integer
'For k = iList.Count - 1 To 0 Step -1
' If iList(k) Is Nothing Then
' iList.RemoveAt(k)
' End If
'Next
'//but using RemoveAll Function cleared List instantly
iList.RemoveAll(Function(itm) IsNothing(itm))
Return iList
End Function
I've tested Parallel.For approach (more complex than in my own answer) but with passing parameters to be checked to main Function. And result was not always correct. Using #Christoph Function (with AsParallel) - results are ok.
With loop until iList.Count - 1: the last list was not checked, I changed upper loop limit to iList.Count -> and results are correct.
Have to read documentation attentively...(upper loop value is Exclusive)
public static System.Threading.Tasks.ParallelLoopResult For (int
fromInclusive, int toExclusive,
System.Threading.Tasks.ParallelOptions parallelOptions,
Action<int,System.Threading.Tasks.ParallelLoopState> body);
I am currently trying to produce a sound using a custom beep class. One of the methods of the beep class is to produce multiple octaves of a sound with a given frequency, so one sound is the frequency, another is the frequency * 2, another is the frequency * 4, etc.
I am attempting to use threading to make these all sound together by giving each sound its own thread. However, I notice that it still plays sounds once-at-a-time. I can confirm that the sounds are not interrupting the flow of the program itself, however, so the threading is working in that capacity.
Here is the code I am using. The idea is that for NumOctave times, a new frequency is generated based off the first (and amplitude), and is set to sound in its own thread. However, it appears that the threads are queuing, rather than truly executing asynchronously from each other. What would be the best way to get the intended behavior?
Shared Sub OctBeep(ByVal Amplitude As Integer,
ByVal Frequency As Integer, ByVal NumOctaves As Integer,
ByVal Duration As Integer, ByVal NewThread As Boolean)
Dim threads As List(Of Thread) = New List(Of Thread)
Dim powTwo As Integer = 1
Dim powTen As Integer = 1
For oct As Integer = 1 To NumOctaves
Dim thisOct As Integer = oct
Dim thisThread As New Thread(
Sub()
Dim newFreq, newAmp As Integer
newFreq = Frequency * powTwo
newAmp = Amplitude / powTen
BeepHelp(newAmp, newFreq, Duration)
End Sub
)
thisThread.IsBackground = True
thisThread.Start()
powTwo *= 2
powTen *= 10
Next
End Sub
Here is BeepHelp()
Shared Sub BeepHelp(ByVal Amplitude As Integer,
ByVal Frequency As Integer,
ByVal Duration As Integer)
Dim A As Double = ((Amplitude * 2 ^ 15) / 1000) - 1
Dim DeltaFT As Double = 2 * Math.PI * Frequency / 44100
Dim Samples As Integer = 441 * Duration \ 10
Dim Bytes As Integer = Samples * 4
Dim Hdr() As Integer = {&H46464952, 36 + Bytes, &H45564157,
&H20746D66, 16, &H20001, 44100,
176400, &H100004, &H61746164, Bytes}
Using MS As New MemoryStream(44 + Bytes)
Using BW As New BinaryWriter(MS)
For I As Integer = 0 To Hdr.Length - 1
BW.Write(Hdr(I))
Next
For T As Integer = 0 To Samples - 1
Dim Sample As Short = CShort(A * Math.Sin(DeltaFT * T))
BW.Write(Sample)
BW.Write(Sample)
Next
BW.Flush()
MS.Seek(0, SeekOrigin.Begin)
Using SP As New SoundPlayer(MS)
SP.PlaySync()
End Using
End Using
End Using
End Sub
End Class
I ran into this same issue before writing a speech synthesizer class. There is a difference between Multi-threading(Just moves to a different thread so main program still works) & Parallel Processing(Moves the process to its own processor). You want to look into Parallel Processing instead
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.
So I'm trying to generate a random number on button click. Now this number needs to be between two numbers that are inside my text file with various other things all separated by the "|" symbol. The number is then put into the text of a textbox which is being created after i run the form. I can get everything to work perfectly once, but as soon as i try to generate a different random number it gives me the error: "Index was out of range, must be non-negative and less than the size of the collection." Here is the main code as well as the block that generates the textbox after loading the form. As well as the contents of my text file.
Private Sub generate()
Dim newrandom As New Random
Try
Using sr As New StreamReader(itemfile) 'Create a stream reader object for the file
'While we have lines to read in
Do Until sr.EndOfStream
Dim line As String
line = sr.ReadLine() 'Read a line out one at a time
Dim tmp()
tmp = Split(line, "|")
rows(lineNum).buybutton.Text = tmp(1)
rows(lineNum).buyprice.Text = newrandom.Next(tmp(2), tmp(3)) 'Generate the random number between two values
rows(lineNum).amount.Text = tmp(4)
rows(lineNum).sellprice.Text = tmp(5)
rows(lineNum).sellbutton.Text = tmp(1)
lineNum += 1
If sr.EndOfStream = True Then
sr.Close()
End If
Loop
End Using
Catch x As Exception ' Report any errors in reading the line of code
Dim errMsg As String = "Problems: " & x.Message
MsgBox(errMsg)
End Try
End Sub
Private Sub Form2_Load(sender As Object, e As EventArgs) Handles MyBase.Load
rows = New List(Of duplicate)
For dupnum = 0 To 11
'There are about 5 more of these above this one but they all have set values, this is the only troublesome one
Dim buyprice As System.Windows.Forms.TextBox
buyprice = New System.Windows.Forms.TextBox
buyprice.Width = textbox1.Width
buyprice.Height = textbox1.Height
buyprice.Left = textbox1.Left
buyprice.Top = textbox1.Top + 30 * dupnum
buyprice.Name = "buypricetxt" + Str(dupnum)
Me.Controls.Add(buyprice)
pair = New itemrow
pair.sellbutton = sellbutton
pair.amount = amounttxt
pair.sellprice = sellpricetxt
pair.buybutton = buybutton
pair.buyprice = buypricetxt
rows.Add(pair)
next
end sub
'textfile contents
0|Iron Sword|10|30|0|0
1|Steel Sword|20|40|0|0
2|Iron Shield|15|35|0|0
3|Steel Shield|30|50|0|0
4|Bread|5|10|0|0
5|Cloak|15|30|0|0
6|Tent|40|80|0|0
7|Leather Armour|50|70|0|0
8|Horse|100|200|0|0
9|Saddle|50|75|0|0
10|Opium|200|500|0|0
11|House|1000|5000|0|0
Not sure what else to add, if you know whats wrong please help :/ thanks
Add the following two lines to the start of generate():
Private Sub generate()
Dim lineNum
lineNum = 0
This ensures that you don't point to a value of lineNum outside of the collection.
I usually consider it a good idea to add
Option Explicit
to my code - it forces me to declare my variables, and then I think about their initialization more carefully. It helps me consider their scope, too.
Try this little modification.
I took your original Sub and changed a little bit take a try and let us know if it solve the issue
Private Sub generate()
Dim line As String
Dim lineNum As Integer = 0
Dim rn As New Random(Now.Millisecond)
Try
Using sr As New StreamReader(_path) 'Create a stream reader object for the file
'While we have lines to read in
While sr.Peek > 0
line = sr.ReadLine() 'Read a line out one at a time
If Not String.IsNullOrEmpty(line) And Not String.IsNullOrWhiteSpace(line) Then
Dim tmp()
tmp = Split(line, "|")
rows(lineNum).buybutton.Text = tmp(1)
rows(lineNum).buyprice.Text = rn.Next(CInt(tmp(2)), CInt(tmp(3))) 'Generate the random number between two values
rows(lineNum).amount.Text = tmp(4)
rows(lineNum).sellprice.Text = tmp(5)
rows(lineNum).sellbutton.Text = tmp(1)
lineNum += 1
End If
End While
End Using
Catch x As Exception ' Report any errors in reading the line of code
Dim errMsg As String = "Problems: " & x.Message
MsgBox(errMsg)
End Try
End Sub
the vb.net code below permutates a given word...the problem i have is that it does not accept larger words like "photosynthesis", "Calendar", etc but accepts smaller words like "book", "land", etc ...what is missing...Pls help
Module Module1
Sub Main()
Dim strInputString As String = String.Empty
Dim lstPermutations As List(Of String)
'Loop until exit character is read
While strInputString <> "x"
Console.Write("Please enter a string or x to exit: ")
strInputString = Console.ReadLine()
If strInputString = "x" Then
Continue While
End If
'Create a new list and append all possible permutations to it.
lstPermutations = New List(Of String)
Append(strInputString, lstPermutations)
'Sort and display list+stats
lstPermutations.Sort()
For Each strPermutation As String In lstPermutations
Console.WriteLine("Permutation: " + strPermutation)
Next
Console.WriteLine("Total: " + lstPermutations.Count.ToString)
Console.WriteLine("")
End While
End Sub
Public Sub Append(ByVal pString As String, ByRef pList As List(Of String))
Dim strInsertValue As String
Dim strBase As String
Dim strComposed As String
'Add the base string to the list if it doesn't exist
If pList.Contains(pString) = False Then
pList.Add(pString)
End If
'Iterate through every possible set of characters
For intLoop As Integer = 1 To pString.Length - 1
'we need to slide and call an interative function.
For intInnerLoop As Integer = 0 To pString.Length - intLoop
'Get a base insert value, example (a,ab,abc)
strInsertValue = pString.Substring(intInnerLoop, intLoop)
'Remove the base insert value from the string eg (bcd,cd,d)
strBase = pString.Remove(intInnerLoop, intLoop)
'insert the value from the string into spot and check
For intCharLoop As Integer = 0 To strBase.Length - 1
strComposed = strBase.Insert(intCharLoop, strInsertValue)
If pList.Contains(strComposed) = False Then
pList.Add(strComposed)
'Call the same function to review any sub-permutations.
Append(strComposed, pList)
End If
Next
Next
Next
End Sub
End Module
Without actually creating a project to run this code, nor knowing how it 'doesn't accept' long words, my answer would be that there are a lot of permutations for long words and your program is just taking much longer than you're expecting to run. So you probably think it has crashed.
UPDATE:
The problem is the recursion, it's blowing up the stack. You'll have to rewrite your code to use an iteration instead of recursion. Generally explained here
http://www.refactoring.com/catalog/replaceRecursionWithIteration.html
Psuedo code here uses iteration instead of recursion
Generate list of all possible permutations of a string