From 1adf30f4a855256e8720d25d027ad89f3ff49e15 Mon Sep 17 00:00:00 2001 From: Jed Barber Date: Fri, 7 Jul 2017 01:09:41 +1000 Subject: Experimental multithreaded version of Read_Bundles added --- src/bundles-containers.adb | 131 ++++++++++++++++++++++++++++++++++++++++++++- src/bundles-containers.ads | 10 ++++ threads.txt | 43 +++++++++++++++ 3 files changed, 183 insertions(+), 1 deletion(-) create mode 100644 threads.txt diff --git a/src/bundles-containers.adb b/src/bundles-containers.adb index d1b1130..0550f6d 100644 --- a/src/bundles-containers.adb +++ b/src/bundles-containers.adb @@ -2,19 +2,148 @@ with - Ada.Strings.Unbounded, + Ada.Strings.Unbounded.Text_IO, Ada.Text_IO, CSV; +use + + Ada.Strings.Unbounded.Text_IO, + Ada.Text_IO; + package body Bundles.Containers is + package My_CSV is new CSV; package SU renames Ada.Strings.Unbounded; + protected type Preference_Input is + procedure Open (Filename : in String); + procedure Read_Line + (Line : out SU.Unbounded_String; + EOF : out Boolean); + procedure Close; + private + Source : File_Type; + end Preference_Input; + + + protected body Preference_Input is + procedure Open (Filename : in String) is + begin + Open (Source, In_File, Filename); + end Open; + procedure Read_Line + (Line : out SU.Unbounded_String; + EOF : out Boolean) is + begin + if End_Of_File (Source) then + EOF := True; + else + EOF := False; + Line := Get_Line (Source); + end if; + end Read_Line; + procedure Close is + begin + Ada.Text_IO.Close (Source); + end Close; + end Preference_Input; + + + + + type Paper_Array is array (Valid_CandidateID) of Paper_Vectors.Vector; + type Paper_Array_Array is array (1 .. Num_Threads) of Paper_Array; + + + Empty_Paper_Array : Paper_Array := + (others => Paper_Vectors.Empty_Vector); + + + + + task type Parse_Worker + (Input : access Preference_Input; + Output : access Paper_Array_Array) is + entry Start (On : in Positive); + end Parse_Worker; + + + task body Parse_Worker is + use type Candidates.CandidateID; + + Work_On : Positive; + + Current_Line : SU.Unbounded_String; + Current_Record : My_CSV.CSV_Record; + Current_Prefs : Given_Prefs.Preference_Array; + Are_We_Done_Yet : Boolean; + begin + accept Start (On : in Positive) do + Work_On := On; + end Start; + loop + Input.Read_Line (Current_Line, Are_We_Done_Yet); + exit when Are_We_Done_Yet; + Current_Record := My_CSV.Parse_Line (SU.To_String (Current_Line)); + if Integer (Current_Record.Length) > 0 then + Current_Prefs := Given_Prefs.Parse_Preferences + (SU.To_String (Current_Record.Last_Element)); + if Current_Prefs (Given_Prefs.Preference_Range'First) /= + Candidates.No_Candidate + then + Output (Work_On) (Current_Prefs (Given_Prefs.Preference_Range'First)).Append + (Current_Prefs); + end if; + end if; + end loop; + end Parse_Worker; + + + + + procedure Read_Bundles_Threaded + (Filename : in String; + Result : out Bundle_Collection) + is + use type Bundle_Vector; + + Input : aliased Preference_Input; + Outputs : aliased Paper_Array_Array := + (others => Empty_Paper_Array); + begin + Result := (others => Bundle_Vectors.Empty_Vector & Empty_Bundle); + Input.Open (Filename); + + declare + Workers : array (1 .. Num_Threads) of Parse_Worker + (Input'Access, Outputs'Access); + begin + for I in Workers'Range loop + Workers (I).Start (I); + end loop; + end; + + Input.Close; + for CID in Valid_CandidateID loop + for O of Outputs loop + Result (CID).Reference (1).Papers.Append (O (CID)); + O (CID) := Paper_Vectors.Empty_Vector; + end loop; + if Result (CID).Reference (1) = Empty_Bundle then + Result (CID).Delete (1); + end if; + end loop; + end Read_Bundles_Threaded; + + + + procedure Read_Bundles (Filename : in String; Result : out Bundle_Collection) diff --git a/src/bundles-containers.ads b/src/bundles-containers.ads index 8caf263..1361026 100644 --- a/src/bundles-containers.ads +++ b/src/bundles-containers.ads @@ -8,6 +8,7 @@ with generic Min_Valid : Candidates.CandidateID; Max_Valid : Candidates.CandidateID; + Num_Threads : Positive := 2; package Bundles.Containers is @@ -26,6 +27,15 @@ package Bundles.Containers is Result : out Bundle_Collection); + -- Current implementation slightly faster, but not worth it. + -- Probably needs to be reworked to read in the entire file at once for decent + -- increase in speed, but that would involve approx doubling memory usage, + -- which is unacceptable. + procedure Read_Bundles_Threaded + (Filename : in String; + Result : out Bundle_Collection); + + end Bundles.Containers; diff --git a/threads.txt b/threads.txt new file mode 100644 index 0000000..774e272 --- /dev/null +++ b/threads.txt @@ -0,0 +1,43 @@ + + +Experimental data regarding threading + + + + +single thread tas 6 +48.7 seconds +54.3MB memory + + +multithread tas 6, 2 threads +44.7 seconds +61.7MB memory + + +multithread tas 6, 3 threads +46 seconds +70MB memory + + +multithread tas 6, 4 threads +49 seconds +70.6MB memory + + + + +single thread sa 6 +2 min, 47 seconds +239MB memory + + +multithread sa 6, 2 threads +2 min, 43.8 seconds +245.9MB memory + + +multithread sa 6, 4 threads +2 min, 39.6 seconds +236MB memory + -- cgit