N1h1l1sT N1h1l1sT - 3 months ago 12
Vb.net Question

Concurrent/Simultaneous Multi-threaded task (VB.NET)

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)
...............................
Await Task.Run(
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
CountSwarmsTasksQuery.Add(CalcKinoCombinations(0, intCombinationsPerIteration, k, KinoCombinations, DBNumFrom, DBNumTo))
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
CountSwarmsTasksQuery.Add(CalcKinoCombinations(0, KinoCombinations.Count - 1, k, KinoCombinations, DBNumFrom, DBNumTo))
End If
Dim CountSwarmsTasks As Task(Of List(Of clsNGram))() = CountSwarmsTasksQuery.ToArray
Dim CountSwarmsLstClsNGram() As List(Of clsNGram) = Await Task.WhenAll(CountSwarmsTasks)
For Each item In CountSwarmsLstClsNGram
KinoCombinationsFrequencyIndexes.AddRange(item)
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

Answer

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)

    Await Task.Run(
        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}

                    CurMyDesign.Add(NewDesign)
                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
                DesignsQuery.Add(LoadMyDesign(0, IndicesPerIteration - 1, FilesPaths))
            ElseIf CurIteration < Environment.ProcessorCount Then
                DesignsQuery.Add(LoadMyDesign(((IndicesPerIteration) * (CurIteration - 1)), ((IndicesPerIteration) * CurIteration) - 1, FilesPaths))
            Else
                DesignsQuery.Add(LoadMyDesign(((IndicesPerIteration) * (CurIteration - 1)), FilesPaths.Length - 1, FilesPaths))
            End If
        Next

        Dim sth As List(Of MyStructure)() = Await Task.WhenAll(DesignsQuery)
        For Each Item As List(Of MyStructure) In sth
            MyDesign.AddRange(Item)
        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)

Comments