使用 TTask.Future<> 的并行快速排序似乎挂起

Question

刚刚接触 Delphi 的新（差不多）并行库。

下面我有一个简单的 VCL 测试表单，其中有一个按钮，其中创建了随机整数值数组，然后使用传统的递归 QuickSort 算法对其进行了排序。当然，这很好用。

然后我尝试通过在 TTask.Future<Boolean>.

中进行递归子分区调用来创建和使用该算法的并行化 (sp?) 版本

不幸的是，没有达到预期的结果 - 相反，代码似乎不断产生新线程并且没有完成 - 至少没有在合理的时间内完成（我让它运行几分钟，其中非并行版本在不到一秒内完成。

那我做错了什么？（我在这里使用 Delphi XE8，update1，以防万一）。

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.

Answer 1

这里的问题是递归地创建彼此不相关的未来（任务）。所以 PPL 对它们的关系一无所知，并愉快地为它们中的每一个创建线程（称之为设计缺陷，如果你愿意，可以报告）。

因此，要使快速排序正确地并行执行，您需要对输入数据进行分区，然后将其一次传递给多个任务，而不是递归地传递给多个任务。所以解决方法是在将来调用 Sort1R 而不是 Sort2R.

要了解更多信息，我建议研究哪些排序算法并行运行良好。

PPL 不是灵丹妙药，可以将任何代码转化为性能良好的并行代码。它只是简化和抽象了处理 tasks/threads.

所需的 API

使用 TTask.Future<> 的并行快速排序似乎挂起

Parallel QuickSort using TTask.Future<> appears to be hanging

delphi

parallel-processing

delphi-xe8