N1h1l1sT - 1 year ago 77
Vb.net Question

I have a list of integers containing the number of times a particular number combination occurred within a set of lots in which 20 numbers from 1 to 80 occur in each iteration.

Let's say LotCount = 1 and that we're calculating the nChoose2 combinations.
The list of Integers count will be 80Choose2 = 3,160 and each combination will have occurred a minimum of 0 times and a maximum of 1 (because LotCount = 1). In this example we'll have exactly 20Choose2=190 1's and the rest 0's, but for LotCount=2 or more it'll be a max of 20Choose2*LotCount and a min of 20Choose2.

This gets easily out of hand as even of the LotCount remains 1, when probing greater than "2" combinations, its number raises exponentially. 20Choose3=82,160 - 20Choose4=1,581,580 and so on

What I want to do is calculate the occurrences but concurrently and in a multi-threaded manner so that all CPU Cores get to work because it's a very time consuming task.

I tried to do this searching google and stuff but I think I only got the "concurrent" side because the application's CPU usage on my 8-threaded computer gets up to 13%

This was my original code:

``````        Dim DBNumFrom As New List(Of Integer)
Dim DBNumTo As New List(Of Integer)
Dim k As Integer = CInt(nudFindNGrams.Value)
Dim KinoCombinations As New List(Of List(Of Integer))
Dim KinoCombinationsFrequencyIndexes As New List(Of clsNGram)
KinoCombinations = nChooseK(KinoNumbers, k)
...............................
Sub()
For i = 0 To KinoCombinations.Count - 1
KinoCombinationsFrequencyIndexes.Add(New clsNGram With {.nGramCombination = KinoCombinations(i), .Occurrences = 0})

For l = 0 To DBNumFrom.Count - 1
For j = DBNumFrom(l) To DBNumTo(l) Step -1
Dim CombinationIsContainedInCurrentLot As Boolean = True
For f As Integer = 0 To k - 1
If Not KinoGames.Item(j).NumbersArray.Contains(KinoCombinations(i)(f)) Then
CombinationIsContainedInCurrentLot = False
Exit For
End If
Next

If CombinationIsContainedInCurrentLot Then KinoCombinationsFrequencyIndexes(i).Occurrences += 1
Next
Next

Next
End Sub)
``````

After some reading I changed it into:

[The function I call later for concurrency]

``````Private Async Function CalcKinoCombinations(ByVal FromIndex As Integer, ByVal ToIndex As Integer, ByVal k As Integer, ByVal KinoCombinations As List(Of List(Of Integer)), DBNumFrom As List(Of Integer), DBNumto As List(Of Integer)) As Task(Of List(Of clsNGram))
Dim KinoCombinationsFrequencyIndexes As New List(Of clsNGram)
Dim Counter As Integer = -1
For i = FromIndex To ToIndex
Counter += 1
KinoCombinationsFrequencyIndexes.Add(New clsNGram With {.nGramCombination = KinoCombinations(i), .Occurrences = 0})

For l = 0 To DBNumFrom.Count - 1
For j = DBNumFrom(l) To DBNumto(l) Step -1
Dim CombinationIsContainedInCurrentLot As Boolean = True
For f As Integer = 0 To k - 1
If Not KinoGames.Item(j).NumbersArray.Contains(KinoCombinations(i)(f)) Then
CombinationIsContainedInCurrentLot = False
Exit For
End If
Next

If CombinationIsContainedInCurrentLot Then KinoCombinationsFrequencyIndexes(Counter).Occurrences += 1
Next
Next

Next
Return KinoCombinationsFrequencyIndexes
End Function
``````

[The code inside the button sub]

``````        Dim CountSwarmsTasksQuery As New List(Of Task(Of List(Of clsNGram)))
If KinoCombinations.Count > CoresCount Then
Dim intCombinationsPerIteration As Integer = CInt(Math.Floor(KinoCombinations.Count / CoresCount))
For i As Integer = 1 To CoresCount
If i = 1 Then
ElseIf i < CoresCount Then
CountSwarmsTasksQuery.Add(CalcKinoCombinations((intCombinationsPerIteration * i) - intCombinationsPerIteration + 1, intCombinationsPerIteration * i, k, KinoCombinations, DBNumFrom, DBNumTo))
Else
CountSwarmsTasksQuery.Add(CalcKinoCombinations((intCombinationsPerIteration * i) - intCombinationsPerIteration + 1, KinoCombinations.Count - 1, k, KinoCombinations, DBNumFrom, DBNumTo))
End If
Next

Else
End If
For Each item In CountSwarmsLstClsNGram
Next
``````

But as I said, from what I gather the concurrency is there, but it all happens inside 1 thread and as this is a cpu-hungry task I get no benefit from that. I need both concurrency and each task on a separate thread.

[Info]

What I did was basically to take the list of nChoosek count and divide it into 8 (the CoreCount variable returns 8 on my computer).
The order does play a role and I love how ".WhenAll" will return in in the order I called them

How do I put each of the 8 tasks into a different thread and then get the functions results (List(Of clsNGram))) in the order I called them?

I really appreciate the help - thank you anyone

As it turns out, I figured it myself and I thought I'll post it in case someone else want to accomplish the same task (of dividing a task into several sub-tasks that run in a concurrent and multi-threaded manner)

## Here is the code:

``````Public Structure MyStructure
Dim DateAndTime As Date
Dim Numbers() As Integer
Public Overrides Function ToString() As String
Return DateAndTime.ToString("dd/MM/yyyy HH:mm") & " " & Numbers(0).ToString & " " & Numbers(1).ToString & " " & Numbers(2).ToString
End Function
End Structure

Public Class Form1

Dim MyDesign As New List(Of MyStructure)
Dim strMyDesign As New List(Of String)

Public Async Function LoadMyDesign(ByVal FromLineIndex As Integer, ByVal ToLineIndex As Integer, ByVal FilePaths() As String) As Task(Of List(Of MyStructure))
Dim CurMyDesign As New List(Of MyStructure)

Sub()
For j As Integer = FromLineIndex To ToLineIndex
Dim FileLines() As String = File.ReadAllLines(FilePaths(j))

For i = 0 To FileLines.Length - 1
Dim LineContent() As String = FileLines(i).Split(","c)
Dim NewDesign As New MyStructure With {.DateAndTime = Date.Parse(LineContent(0)), .Numbers = (From Num In LineContent Skip 1 Select CInt(Num)).ToArray}

Next
Next
End Sub)

Return CurMyDesign
End Function

Private Async Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim DesignsQuery As New List(Of Task(Of List(Of MyStructure)))
Dim FilesPaths() As String = Directory.GetFiles("c:\users\giannism\documents\visual studio 2015\Projects\WindowsApplication2\WindowsApplication2\bin\Release" & "\Files\")
Dim FilesPaths() As String = Directory.GetFiles(My.Application.Info.DirectoryPath & "\Files\")
Dim IndicesPerIteration As Integer = CInt(Math.Floor(FilesPaths.Length / Environment.ProcessorCount))

MyDesign.Clear()
strMyDesign.Clear()
Button1.Enabled = False

If FilesPaths.Length >= Environment.ProcessorCount Then
For i = 1 To Environment.ProcessorCount
Dim CurIteration As Integer = i
If CurIteration = 1 Then
ElseIf CurIteration < Environment.ProcessorCount Then
Else
End If
Next

Dim sth As List(Of MyStructure)() = Await Task.WhenAll(DesignsQuery)
For Each Item As List(Of MyStructure) In sth
Next

Else
MyDesign = Await LoadMyDesign(0, FilesPaths.Length - 1, FilesPaths)
End If

strMyDesign.AddRange((From l As MyStructure In MyDesign Select (l.ToString())).Take(10))
ListBox1.DataSource = Nothing
ListBox1.DataSource = strMyDesign
Button1.Enabled = True
End Sub

Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
MyDesign.Clear()
strMyDesign.Clear()
ListBox1.DataSource = Nothing
End Sub

End Class
``````

For it to work there need be sever files in the directory pointed by the "FilesPaths" variable

## Files must contain lines like this:

``````28/8/2016 18:00, 1, 2, 3
28/8/2016 18:01, 4, 5, 6
28/8/2016 18:02, 7, 8, 9
28/8/2016 18:03, 10, 11, 12
28/8/2016 18:04, 1, 2, 3
28/8/2016 18:05, 4, 5, 6
28/8/2016 18:06, 7, 8, 9
28/8/2016 18:07, 10, 11,12
28/8/2016 18:08, 1, 2, 3
28/8/2016 18:09, 4, 5, 6
28/8/2016 18:10, 7, 8, 9
28/8/2016 18:11, 10, 11, 12
28/8/2016 18:12, 1, 2, 3
28/8/2016 18:13, 4, 5, 6
28/8/2016 18:14, 7, 8, 9
28/8/2016 18:15, 10, 11, 12
``````

(P.S. If you found this helpful, please give me + reputation because there several things that need a reputation of 15+ and I'm new here so haven't rly gotten to that part yet)

Recommended from our users: Dynamic Network Monitoring from WhatsUp Gold from IPSwitch. Free Download