Summing up decimals returned within task - vb.net

I'm trying to run through a list of 1-X items and process them in Tasks in order to speed up completion of processing (they make web requests that can sometimes take a short while to finish). I'm trying to sum up a decimal that is returned when the processing is finished without looping through the list a second time. As it is right now, the sum is overwritten by each task instead of being added to.
I can insert a short pause before adding the decimal to the sum and this seems to work fine, but I'm sure there is a better solution out there.
I've seen mentions of SyncLock but I can't use it on a Decimal.
Here is some code I wrote for testing. The .Process method just waits a random number of seconds and sets the .Value property to a random decimal.
Any suggestions for improvement and calculating the sum in a proper way?
Try
Dim lstItem As List(Of clsItem) = GetList()
Dim lstViewItem As New List(Of ListViewItem)
Dim lstTasks As New List(Of Task)()
Dim decTotal As Decimal = 0.0
For i As Int32 = 0 To lstItem.Count - 1
Dim j As Int32 = i
Dim t As Task = Task.Run(Sub()
lstViewItem.Add(New ListViewItem(New String() {j, lstItem(j).Process()}))
'System.Threading.Thread.Sleep(j * 1000)
decTotal += lstItem(j).Value
End Sub)
lstTasks.Add(t)
Next
Task.WaitAll(lstTasks.ToArray())
lstView.Items.AddRange(lstViewItem.ToArray())
lstView.Items.Add("")
lstView.Items.Add(decTotal)
Catch ex As Exception
Debug.WriteLine(ex.Message)
End Try

You should be able to use SyncLock to resolve your issue. SyncLock can only be used on reference types. All that's needed is to create a new object that is within the scope of the current instance and then let SyncLock lock on that object.
Here's a short little console application that utilizes SyncLock. I significantly simplified what you had. I didn't really feel like making listViews and such, and rather than returning a random decimal it just returns 1 so that the results should be the number of loop iterations.
Option Strict On
Option Explicit On
Imports System.Threading.Tasks
Module Module1
Sub Main()
Dim lstTasks As New List(Of Task)()
Dim SyncLockedTotal As Decimal = 0D
Dim decTotal As Decimal = 0D
Dim sLock As New Object
For i As Int32 = 1I To 1000I
Dim t As Task = Task.Run(Sub()
Dim tempDecimal As Decimal = clsItem.Process()
decTotal += tempDecimal
SyncLock sLock
SyncLockedTotal += tempDecimal
End SyncLock
End Sub)
lstTasks.Add(t)
Next
Task.WaitAll(lstTasks.ToArray())
Console.WriteLine(String.Format("Value for decTotal: {0}", decTotal.ToString))
Console.WriteLine(String.Format("Value for SyncLockedTotal: {0}", SyncLockedTotal.ToString))
Console.ReadLine()
End Sub
End Module
Public Structure clsItem
Public Shared Function Process() As Decimal
Dim rnd As New Random(DateTime.Now.Millisecond)
Threading.Thread.Sleep(rnd.Next(10I))
Return 1D
End Function
End Structure
NOTE: Your application settings must target .NET 4.5 in order to use Task.Run(), if you are targetting .NET 4 you will have to use Task.Factory.StartNew(). If you are targeting .NET 3.5 or lower, this won't work for you because you won't have the System.Threading.Tasks namespace available.

Related

Arraylist.Contains Doesn't Return True VB.NET

comps.Contains doesn't return TRUE even though comps contains it.
I debugged it step by step and I can't see where the problem is.
By the way the purpose of the code is to show the pairs that sum up to SUM value. (If the sum is 5 and theres 1 and 4 then the code should return 1 and 4)
Public Function getPairs(ByVal array As ArrayList, ByVal sum As Integer)
Dim comps, pairs As New ArrayList
For index = 0 To array.Count - 1
If (comps.Contains(array(index)) = True) Then
pairs.Add(array(index))
Else
comps.Add(sum - array(index))
End If
Next
Return pairs
End Function
Sub Main()
' 1,3,2,5,46,6,7,4
' k = 5
'Dim arraylist As New ArrayList()
Console.Write("Enter your array :")
Dim arraylist As New ArrayList
arraylist.AddRange(Console.ReadLine().Split(","))
Console.Write("Enter the sum:")
Dim sum As Integer = Console.ReadLine()
getPairs(arraylist, sum)
Console.ReadKey()
End Sub
The ArrayList you populate from user input contains strings (results from splitting the user input string). The comps ArrayList contains integers (results from subtraction). When it tries to find the string "2" in the ArrayList that contains a 2, it fails.
You should convert your user input to integers so that you are comparing the same data types.
First, turn on Option Strict. Tools Menu -> Options -> Projects and Solutions -> VB Defaults. This will point out problems with your code and help you to avoid runtime errors.
ArrayList is not used much in new code but is around for backward compatibility. List(Of T) is a better choice for new code.
Module Module1
Sub Main()
' 1,3,2,5,46,6,7,4
' k = 5
'Dim arraylist As New ArrayList()
Console.Write("Enter your array :")
Dim arraylist As New ArrayList
'Option Strict would not allow this line to compile
'.Split takes a Char, the same c tells the compiler that "," is a Char
arraylist.AddRange(Console.ReadLine().Split(","c))
Console.Write("Enter the sum:")
'Option Strict would not allow a string to be dumped into an integer
Dim sum As Integer
Dim Pairs As New ArrayList
If Integer.TryParse(Console.ReadLine, sum) Then
'Your Function returns an array list but you
'throw it away by not setting up a variable to receive it
Pairs = getPairs(arraylist, sum)
Else
Console.WriteLine("Program aborted. Sum was not a number.")
End If
For Each item In Pairs
Console.WriteLine(item)
Next
Console.ReadKey()
End Sub
'Functions need a return data type in the declaration
Public Function getPairs(ByVal array As ArrayList, ByVal sum As Integer) As ArrayList
Dim comps, pairs As New ArrayList
For index = 0 To array.Count - 1
'I don't see how this can ever be true since comps is empty
If comps.Contains(array(index)) Then 'Since .Contains returns a Boolean, no = True is necessary
pairs.Add(array(index))
Else
'Ideally each item in array should be tested to see if it is a number
'You will get an exception if CInt fails
comps.Add(sum - CInt(array(index)))
'You never use the comps ArrayList
End If
Next
'The pairs ArrayList is empty
Return pairs
End Function
End Module
I don't see how this code could accomplish what you describe as your goal. I think you should start again. Talk through how you would accomplish your task. Then write it out on paper, not in code. Then you will see more clearly how to code your project.
The big problem is the original code is this line:
Dim comps, pairs As New ArrayList
That code creates two ArrayList reference variables, but only one ArrayList object. comps remains null/Nothing.
But beyond that, the ArrayList type has been dead since .Net 2.0 came out back in 2005... more than 10 years now. It only exists today for backwards compatibility with old code. Don't use it!
This is better practice, especially in conjunction with Option Strict and Option Infer:
Public Function getPairs(ByVal items As IEnumerable(Of Integer), ByVal sum As Integer) As IEnumerable(Of Integer)
Dim comps As New HashSet(Of Integer)()
Dim result As New List(Of Integer)()
For Each item As Integer In items
If Not comps.Add(item) Then
result.Add(sum - item)
End If
Next
Return result
End Function
Sub Main()
Console.Write("Enter your array: ")
Dim input As String = Console.ReadLine()
Dim list As List(Of Integer) = input.Split(",").Select(Function(item) CInt(item)).ToList()
Console.Write("Enter the sum: ")
Dim sum As Integer = CInt(Console.ReadLine())
Dim pairs = getPairs(list, sum).Select(Function(s) s.ToString())
Console.WriteLine("Pairs are: {0}", String.Join(", " pairs))
Console.ReadKey()
End Sub

Index was out of range. Must be non-negative and less than the size of the collection. Parameter name: chunkLength

I am trying to use Parallel.ForEachLoop for a iterations of almost million records in My windows application. I am facing an error while fails on a convert to string on a string builder due to some threading problem although i use a object for lock.
I Tried looking at shared resource for Parallel.ForEach could not find a proper answer.
dtProd has 900 000 records
Dim sbFile As New StringBuilder
messagesLock As Object = New Object()
Dim sbRecord As New StringBuilder
Dim dtDet As New Data.DataTable
Dim dtProd As New Data.DataTable
Public Sub CreateFeedFile()
Try
GetData()
Dim temporaryEnumerable As IEnumerable(Of DataRow) = dtProd.Rows.Cast(Of DataRow)()
sbRecord.AppendLine(dtFeed(0).Item("HeaderText"))
Parallel.ForEach(temporaryEnumerable, Sub(dtDet)
RunLoop(DetCount)
End Sub)
sbRecord.AppendLine(dtFeed(0).Item("FooterText"))
Catch ex As Exception
Dim a = ex.Message.ToString()
End Try
End Sub
Private Sub RunLoop(ByRef DetCount As Integer)
For Each drDet As DataRowView In dvDet 'loop detail records of field values
.. .. .. Append info to sbRecord
Next
Try
SyncLock Me.messagesLock
sbFile.AppendLine(sbRecord.ToString())
sbRecord.Clear()
End SyncLock
Catch ex As Exception
Dim a = ex.Message.ToString() --Fails Here on the statement sbRecord.ToString()
End Try
The problem is that you have one StringBuilder (sbRecord) that is shared by the parallel threads. You need to move sbRecord to be a local variable inside RunLoop.
I think you also want the .AppendLine(...) calls in CreateFeedFile to be on sbFile rather than sbRecord.

Handle more than 64 thread at the same time

I was reading a tutorial about Thread pooling in VB. There was an example with Fibonacci calculations:
Imports System.Threading
Module Module1
Public Class Fibonacci
Private _n As Integer
Private _fibOfN
Private _doneEvent As ManualResetEvent
Public ReadOnly Property N() As Integer
Get
Return _n
End Get
End Property
Public ReadOnly Property FibOfN() As Integer
Get
Return _fibOfN
End Get
End Property
Sub New(ByVal n As Integer, ByVal doneEvent As ManualResetEvent)
_n = n
_doneEvent = doneEvent
End Sub
' Wrapper method for use with the thread pool.
Public Sub ThreadPoolCallBack(ByVal threadContext As Object)
Dim threadIndex As Integer = CType(threadContext, Integer)
Console.WriteLine("thread {0} started...", threadIndex)
_fibOfN = Calculate(_n)
Console.WriteLine("thread {0} result calculated...", threadIndex)
_doneEvent.Set()
End Sub
Public Function Calculate(ByVal n As Integer) As Integer
If n <= 1 Then
Return n
End If
Return Calculate(n - 1) + Calculate(n - 2)
End Function
End Class
<MTAThread()>
Sub Main()
Const FibonacciCalculations As Integer = 9 ' 0 to 9
' One event is used for each Fibonacci object
Dim doneEvents(FibonacciCalculations) As ManualResetEvent
Dim fibArray(FibonacciCalculations) As Fibonacci
Dim r As New Random()
' Configure and start threads using ThreadPool.
Console.WriteLine("launching {0} tasks...", FibonacciCalculations)
For i As Integer = 0 To FibonacciCalculations
doneEvents(i) = New ManualResetEvent(False)
Dim f = New Fibonacci(r.Next(20, 40), doneEvents(i))
fibArray(i) = f
ThreadPool.QueueUserWorkItem(AddressOf f.ThreadPoolCallBack, i)
Next
' Wait for all threads in pool to calculate.
WaitHandle.WaitAll(doneEvents)
Console.WriteLine("All calculations are complete.")
' Display the results.
For i As Integer = 0 To FibonacciCalculations
Dim f As Fibonacci = fibArray(i)
Console.WriteLine("Fibonacci({0}) = {1}", f.N, f.FibOfN)
Next
End Sub
End Module
I've start this module and it works correctly and this just handle 9 calculations:
Const FibonacciCalculations As Integer = 9
I've increase that limits, but this can just handle up to 63 calculations. From 64th calculation exception is raised that said:
waithandle must be less than 64
I would this application will handle N calculations. A good idea could be set a cap to pool of threads (for instance: 6). The N calculations will be handle using at most 6 thread at once. How could I edit the code to handle this removing the waitHandle error?
The winapi restriction on the number of handles you can wait on at the same time is a pretty hard one. It is just not necessary, you'll get the exact same outcome if you wait for each individual one:
' Wait for all threads in pool to calculate.
For i As Integer = 0 To FibonacciCalculations
doneEvents(i).WaitOne()
Next
And note how you can now combine this with the next loop, making your program more efficient since you overlap the calculation with the display. So you really want to favor this instead:
' Display the results.
For i As Integer = 0 To FibonacciCalculations
doneEvents(i).WaitOne()
Dim f As Fibonacci = fibArray(i)
Console.WriteLine("Fibonacci({0}) = {1}", f.N, f.FibOfN)
Next
If you want to wait for X task completions where X>63, use a countdown: ONE atomic int and ONE MRE. Initialize the int to [no. of tasks], start your tasks and wait on the MRE with WaitForSingleObject() / WaitOne(). When a task is complete, it atomically decrements the int. Any task, running on any thread, that decrements it to zero signals the MRE.
In fact, use this mechanism for X<63 :)
There is no real advantage to using that many threads on a machine with 4 cores or 2 cores. You really, ideally, only want the same number of threads as you have cores.
If you have more you start losing on parallelism as threads need to be context switched out to let others run. You also may run into contention issues, depending on how your algorithm is written.
The point of a threadpool is really to tell your system to maximally use some number of threads and leave the rest up to the system to figure out what is best.
It may be that your system cannot support more than 64 objects in WaitHandle, see here:
http://msdn.microsoft.com/en-us/library/z6w25xa6.aspx
You can find a workaround for this issue here:
Workaround for the WaitHandle.WaitAll 64 handle limit?
However, as the other answers state, you probably would not gain from having this many threads anyway.

How to throttle concurrent Async webrequests

I often need to make a large number of webrequests, without overloading the network
I currently do this by running synchronous requests in parallel, utilizing ThreadPool.SetMinThreads and MaxDegreeOfParallelism to exactly specify how many requests run concurrently
Now this works just fine, but it feels wrong.
I would really like to utilize async methods, but i cant work out how to limit the number of concurrent requests.
A simplified example of my parallel way of doing this( using a webclient and no error handling for brevity):
Private Function SearchSitesForKeywordInParallel(ByVal keyword As String, ByVal sites As String(), ByVal maxConcurrency As Integer) As String()
Dim po As New ParallelOptions
po.MaxDegreeOfParallelism = maxConcurrency
Threading.ThreadPool.SetMinThreads(maxConcurrency, 2)
Dim sitesContainingKeyword As New Concurrent.ConcurrentBag(Of String)
Parallel.For(0, sites.Count, po, Sub(i)
Dim wc As New Net.WebClient
wc.Proxy = Nothing
Dim pageSource As String = wc.DownloadString(sites(i))
If pageSource.Contains(keyword) Then
sitesContainingKeyword.Add(sites(i))
End If
End Sub)
Return sitesContainingKeyword.ToArray
End Function
This is a blocking function, which is what i require.
Now i have tested the webclient.downloadStringAsync method in a regular for loop, and it will fire all the requests pretty much at once, overloading the network.
What i would like to do is initially make X requests, then make new ones as each response comes back.
I am fairly sure tasks is the way to go, and im positive a have read some very nice implementations in c#, but my c# experience is limited, and i have a hard time translating c# lambadas to vb.net.
I am also limited to vs2010 and .net4, so the niceties of .net4.5 async await are not an option for me.
Any help very much appreciated
Not sure, if I understand completey, what exactly you want to achieve, but if you want to use aync methods, you can do it like this:
Dim google As String = "http://www.google.com/#&q="
Dim qsites As New Concurrent.ConcurrentQueue(Of String)
For Each k In {"foo", "bar", "john", "jack", "stackoverflow", "basic", "ship", "car", "42"}
qsites.Enqueue(google & k)
Next
Dim cde As New System.Threading.CountdownEvent(qsites.Count)
Dim strings As New Concurrent.ConcurrentBag(Of String)
Dim completedhandler = Sub(wco As Object, ev As Net.DownloadStringCompletedEventArgs)
Dim wc = DirectCast(wco, Net.WebClient)
Debug.Print("got one!")
strings.Add(ev.Result)
cde.Signal()
Dim s As String = String.Empty
If qsites.TryDequeue(s) Then
Debug.Print("downloading from {0}", s)
wc.DownloadStringAsync(New Uri(s))
End If
End Sub
Dim numthreads As Integer = 4
System.Threading.Tasks.Task.Factory.StartNew(Sub()
For i = 1 To numthreads
Dim s As String = String.Empty
If qsites.TryDequeue(s) Then
Dim wc As New Net.WebClient
wc.Proxy = Nothing
AddHandler wc.DownloadStringCompleted, completedhandler
Debug.Print("downloading from {0}", s)
wc.DownloadStringAsync(New Uri(s))
End If
Next
End Sub)
cde.Wait()
You only need to "start" the async downloads in a different thread/task because (afaik) the WC's downloadcompleted events fire in the UI thread (or currentsync..context) and the cde.wait would then not allow the events to be handled.
I just want to add another answer to this as I have recently solved a similar problem (note the code snippet is in C#, but should give the idea).
I used to have number of parallel http synchronous requests sent to http server on different thread and used to limit the number of requests I sent using semaphore.
Now, I have adapted to new TPL (c# 5.0 - aysn/await - quite handy (basically continuation introduced in TPL sound natural to me - and with async/await it has become much easier to use)), to invoke network I/O asynchronously.
i.e. ideally now I will be using only one thread in caller (unless I really need to get results before continuing), and let .net, os and I/o completion port threads work together to invoke my continuation code in thread pool to complete operation (basically 'callback' in APM, on completed event in event based pattern, 'continuation' in TPL, code after await in C# 5.0 (4.5 .net))
The principle I followed when I have embraced async i/o is simple - don't let thread wait and waste CPU and resources, unless it is really necessary!
You can do this asynchronously in VB.NET using the Wintellect Powerthreading library's AsyncEnumerator class, which you can get from NuGet.
This gives you some of the functionality of Await but works in VS2010 with .Net 2.0 to 4.0 while giving you an upgrade path to the 4.5 async features.
The downside is that the WebClient async methods require an EAP-to-APM shim based on Task<> to be used with AsyncEnumerator, so the code is quite a lot more complicated.
The simplest way to control the number of concurrent requests is to initiate X async operations, then just initiate another every time one completes.
Example code:
Imports System.Collections.Generic
Imports System.Runtime.CompilerServices
Imports System.Threading.Tasks
Imports System.Net
Imports Wintellect.Threading.AsyncProgModel
Module TaskExtension
REM http://msdn.microsoft.com/en-us/library/hh873178.aspx
<Extension()>
Public Function AsApm(Of T1)(ByVal task As Task(Of T1), callback As AsyncCallback, state As Object) As IAsyncResult
If (task Is Nothing) Then
Throw New ArgumentNullException("task")
End If
Dim tcs = New TaskCompletionSource(Of T1)(state)
task.ContinueWith(Sub(t As Task(Of T1))
If (t.IsFaulted) Then
tcs.TrySetException(t.Exception.InnerExceptions)
ElseIf t.IsCanceled Then
tcs.TrySetCanceled()
Else : tcs.TrySetResult(t.Result)
End If
If (Not callback Is Nothing) Then
callback(tcs.Task)
End If
End Sub, TaskScheduler.Default)
Return tcs.Task
End Function
End Module
Module ApmAsyncDownload
Public Function DownloadStringAsync(url As Uri) As Task(Of String)
Dim tcs As New TaskCompletionSource(Of String)
Dim wc As New WebClient()
AddHandler wc.DownloadStringCompleted, Sub(s As Object, e As System.Net.DownloadStringCompletedEventArgs)
If (Not (e.Error Is Nothing)) Then
tcs.TrySetException(e.Error)
ElseIf e.Cancelled Then
tcs.TrySetCanceled()
Else : tcs.TrySetResult(e.Result)
End If
End Sub
wc.DownloadStringAsync(url)
Return tcs.Task
End Function
Public Function BeginDownloadString(url As Uri, callback As AsyncCallback, state As Object) As IAsyncResult
Return DownloadStringAsync(url).AsApm(callback, state)
End Function
Public Function EndDownloadString(asyncResult As IAsyncResult) As String
Dim castToTask As Task(Of String) = asyncResult
Return castToTask.Result
End Function
End Module
Public Class AsyncIterators
Private Shared Iterator Function SearchUrl(ae As AsyncEnumerator(Of Boolean), keyword As String, uri As Uri) As IEnumerator(Of Int32)
ae.Result = False
ApmAsyncDownload.BeginDownloadString(uri, ae.End(0, AddressOf ApmAsyncDownload.EndDownloadString), Nothing)
Yield 1
If (ae.IsCanceled()) Then
Return
End If
Try
Dim page As String = ApmAsyncDownload.EndDownloadString(ae.DequeueAsyncResult)
ae.Result = page.Contains(keyword)
Catch ex As AggregateException
End Try
End Function
Public Shared Iterator Function SearchIterator(ae As AsyncEnumerator(Of List(Of String)), keyword As String, urls As List(Of Uri)) As IEnumerator(Of Int32)
ae.Result = New List(Of String)
'Control how many searches are started asynchonously
Dim startSearches = Math.Min(3, urls.Count)
Dim enumerator = urls.GetEnumerator
Dim toBeCompleted = urls.Count
Do Until (toBeCompleted <= 0)
While (startSearches > 0)
If enumerator.MoveNext Then
Dim subAe = New AsyncEnumerator(Of Boolean)()
subAe.SyncContext = Nothing
subAe.BeginExecute(SearchUrl(subAe, keyword, enumerator.Current), ae.End(0, Function(ar As IAsyncResult) As AsyncEnumerator.EndObjectXxx
subAe.EndExecute(ar)
End Function), enumerator.Current)
End If
startSearches = startSearches - 1
End While
'Wait for first async search to complete
Yield 1
toBeCompleted = toBeCompleted - 1
If (ae.IsCanceled()) Then
Exit Do
End If
'Get result of the search and add to results
Dim result = ae.DequeueAsyncResult()
Dim completedAe = AsyncEnumerator(Of Boolean).FromAsyncResult(result)
If (completedAe.EndExecute(result)) Then
Dim uri As Uri = result.AsyncState
ae.Result.Add(uri.OriginalString)
End If
'Start 1 more search
startSearches = startSearches + 1
Loop
End Function
End Class
Module Module1
Sub Main()
Dim searchAe = New AsyncEnumerator(Of List(Of String))()
searchAe.SyncContext = Nothing
Dim urlStrings = New List(Of String) From {"http://www.google.com", "http://www.yahoo.com", "http://www.dogpile.com"}
Dim uris = urlStrings.Select(Function(urlString As String) As Uri
Return New Uri(urlString)
End Function).ToList()
For Each Str As String In searchAe.EndExecute(searchAe.BeginExecute(AsyncIterators.SearchIterator(searchAe, "search", uris), Nothing, Nothing))
Console.WriteLine(Str)
Next
Console.ReadKey()
End Sub
End Module
And I now see what you mean about translating c# lambdas!

queing jobs in threadpool vb.net

i have 20,000 items in a queue, and i want to process them using the threadpool.
will this be the best way to do it?
for i as integer = 0 to 19999
ThreadPool.QueueUserWorkItem (PerformTask, ListTask(i))
next
Sub PerformTask(i as string)
' do the work here
end sub
How can i return or set ui control from the PerformTask sub?
You cannot.
However, you can allocate a container (array, list) with a different slot for each result, and write into it. Alternatively, you could pass an object into the worker method that holds both the input and the result. I’d use this method:
Class TaskObject
Dim Input As String
Dim Result As Whatever
End Class
Dim tasks As TaskObject() = New TaskObject(20000) { }
For i as Integer = 0 to tasks.Length - 1
ThreadPool.QueueUserWorkItem(PerformTask, tasks(i))
next
Sub PerformTask(arg As Object)
Dim task As TaskObject = DirectCast(arg, TaskObject)
' do the work here
end sub
Unrelated: you should always enable Option Strict in your projects. No exception. Your code has type errors that the compiler should detect.