Just getting my feet wet with Delphi's new(ish) parallel library.
Below I have a simple VCL test form with a button where a random array of integer values is created and then sorted using a traditional, recursive QuickSort algorithm. This works fine, of course.
I've then tried to create and use a parallelized (sp?) version of the algorithm by making the recursive sub-partitioning calls from within a TTask.Future<Boolean>.
Unfortunately that does not have the expected outcome - instead, the code seems to keep spawning new threads and doesn't complete - at least not within a reasonable time (I let it run for several minutes where the non-parallel version completes in less than a second).
So what am I doing wrong here? (I'm using Delphi XE8, update1 here, in case that matters).
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;
type
TForm5 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form5: TForm5;
implementation
uses
System.Threading;
{$R *.dfm}
type
TIntArray = array[0..1000000-1] of Integer;
PIntArray = ^TIntArray;
procedure InitializeArray(IA: PIntArray);
var
i, j, tmp: Integer;
begin
// init
for i := 0 to 1000000-1 do
IA[i] := i;
// shuffle
for i := 0 to 1000000-1 do begin
j := random(1000000);
tmp := IA[i];
IA[i] := IA[j];
IA[j] := tmp;
end;
end;
{- traditional recursive QuickSort}
procedure Sort1R(IA: PIntArray; Left, Right: Integer);
var
L, R, Pivot, Tmp: Integer;
begin
Pivot := IA[(Left + Right) shr 1];
L := Left;
R := Right;
repeat
while IA[L] < Pivot do
inc(L);
while IA[R] > Pivot do
dec(R);
if L <= R then begin
if L < R then begin
Tmp := IA[L];
IA[L] := IA[R];
IA[R] := Tmp;
end;
inc(L);
dec(R);
end;
until L > R;
if Left < R then
Sort1R(IA, Left, R);
if Right > L then
Sort1R(IA, L, Right);
end;
{- call traditional recursive QuickSort}
procedure Sort1(IA: PIntArray);
begin
Sort1R(IA, 0, 999999);
end;
{- parallelized QuickSort using TTask.Future }
function Sort2R(IA: PIntArray; Left, Right: Integer): Boolean;
var
L, R, Pivot, Tmp: Integer;
FirstValue, SecondValue: IFuture <Boolean>;
begin
Pivot := IA[(Left + Right) shr 1];
L := Left;
R := Right;
repeat
while IA[L] < Pivot do
inc(L);
while IA[R] > Pivot do
dec(R);
if L <= R then begin
if L < R then begin
Tmp := IA[L];
IA[L] := IA[R];
IA[R] := Tmp;
end;
inc(L);
dec(R);
end;
until L > R;
FirstValue := TTask.Future<Boolean>(
function: Boolean
begin
if Left < R then
Sort2R(IA, Left, R);
Result := True;
end);
SecondValue := TTask.Future<Boolean>(
function: Boolean
begin
if Right > L then
Sort2R(IA, L, Right);
Result := True;
end);
Result := FirstValue.Value and SecondValue.Value;
end;
{- call parallel recursive QuickSort}
procedure Sort2(IA: PIntArray);
begin
Sort2R(IA, 0, 999999);
end;
{ - check that array got sorted}
procedure Check(IA: PIntArray);
var
i: Integer;
begin
for I := 1 to 999999 do
if IA[I-1] > IA[I] then
raise Exception.Create('Not sorted');
end;
{- test}
procedure TForm5.Button1Click(Sender: TObject);
var
IA1, IA2: PIntArray;
begin
Button1.Enabled := False;
Caption := 'Initializing';
Application.ProcessMessages;
new(IA1);
InitializeArray(IA1);
{ copy randomized array }
new(IA2);
IA2^ := IA1^;
{ sort traditionally }
Caption := 'Sorting1';
Application.ProcessMessages;
Sort1(IA1);
Caption := 'Checking1';
Application.ProcessMessages;
Check(IA1);
{ sort using parallel library }
Caption := 'Sorting2';
Application.ProcessMessages;
Sort2(IA2);
Caption := 'Checking2';
Application.ProcessMessages;
Check(IA2);
Caption := 'Done';
Button1.Enabled := True;
end;
end.
The problem here is recursively creating futures (tasks) that are not in context to each other. So the PPL does not know anything about their relation and happily creates threads for each of them (call that a design flaw and report it if you want).
So make a quick sort properly perform in parallel you need to partition the input data and then pass it to several tasks once and not recursively. So the fix would be to call Sort1R inside the future and not Sort2R.
For further information I suggest doing a research what sorting algorithms are working well in parallel.
The PPL is not a magic silver bullet that turns any code in well performing parallel code. It just simplifies and abstracts the API required to handle tasks/threads.