Delphi TParallel.for比经典慢

Question

我需要用大量TJsonArray填充TJsonObject（TJsonArray和TJsonObject来自JsonDataObjects）。我正在尝试通过TParallel.For()单元中的System.Threading来提高性能，但是我的TParallel.For()比经典的for循环要慢。

这是我的测试代码：

var
  aLock:  TCriticalSection;
  jItems: TJsonArray;
  jItem:  TJsonObject;
  aStart: Cardinal;
  aEnd:   Cardinal;
  i:      integer;
begin
  // array of json objects
  jItems  := TJsonArray.Create;

  // ASYNC FOR LOOP
  // ----------------------------
  aLock  := TCriticalSection.Create;
  aStart := GetTickCount;
  TParallel.&For(0, 10000000,
    procedure(k: Integer)
    var
      xItem: TJsonObject;
    begin
      aLock.Enter;
      try
        // add new object to the array
        xItem := jItems.AddObject;
      finally
        aLock.Leave;
      end;
      // populate some object property for test
      xItem.I['I'] := k; // .I for integer
      xItem.F['F'] := k; // .F for float
      xItem.S['S'] := IntToStr(k); // .S for string
      xItem.D['D'] := Now; // .D for date
    end
  );
  aEnd := GetTickCount;
  Writeln('ASYNC ', aEnd-aStart);
  // ----------------------------

  aLock.Free;
  jItems.Clear;

  // SYNC FOR LOOP
  // ----------------------------
  aStart := GetTickCount;
  for i := 0 to 10000000 do begin
    jItem := jItems.AddObject;
    jItem.I['I'] := i;
    jItem.F['F'] := i;
    jItem.S['S'] := IntToStr(i);
    jItem.D['D'] := Now;
  end;
  aEnd := GetTickCount;
  Writeln('SYNC ', aEnd-aStart);
  // ----------------------------

  jItems.Free;
end;

这是结果（数字是经过的时间（以毫秒为单位））：

我认为我的TParallel.For()实现是错误的。我在做什么错了？

Answer 1

正如其他人所提到的，您在TJsonArray周围使用关键部分会序列化线程，并且可能是主要的瓶颈。尝试摆脱关键部分，在进入循环之前预先分配阵列，然后让每次循环迭代仅根据需要填充阵列的现有插槽。这样，您就更有机会同时并行地将多个对象插入数组。

var
  jItems: TJsonArray;
  jItem:  TJsonObject;
  aStart: Cardinal;
  aEnd:   Cardinal;
  i:      integer;
begin
  // array of json objects
  jItems  := TJsonArray.Create;

  // ASYNC FOR LOOP
  // ----------------------------
  jItems.Count := 10000001; // <-- add this!
  aStart := GetTickCount;
  TParallel.&For(0, 10000000,
    procedure(k: Integer)
    var
      xItem: TJsonObject;
    begin

      // create new object
      xItem := TJsonObject.Create;

      // populate some object property for test
      xItem.I['I'] := k; // .I for integer
      xItem.F['F'] := k; // .F for float
      xItem.S['S'] := IntToStr(k); // .S for string
      xItem.D['D'] := Now; // .D for date

      // add new object to the array
      jItems.O[k] := xItem;
    end
  );
  aEnd := GetTickCount;
  Writeln('ASYNC ', aEnd-aStart);
  // ----------------------------

  jItems.Clear;

  // SYNC FOR LOOP
  // ----------------------------
  aStart := GetTickCount;
  for i := 0 to 10000000 do begin
    jItem := jItems.AddObject;
    jItem.I['I'] := i;
    jItem.F['F'] := i;
    jItem.S['S'] := IntToStr(i);
    jItem.D['D'] := Now;
  end;
  aEnd := GetTickCount;
  Writeln('SYNC ', aEnd-aStart);
  // ----------------------------

  jItems.Free;
end;

Answer 2

您的代码在功能上没有任何问题，这只是使用多线程加速的错误问题。这里的主要瓶颈只是用于创建TJSONObject的堆分配，因此，即使您不增加线程和锁的开销，您仍将在内存管理器的争用中，无论如何它将序列化所有这些分配。

在这一点上，如果性能是一个问题，那么可能是时候考虑完全不同的体系结构了。您可以尝试使用自定义的多线程内存管理器强制执行此多线程想法，但实际上付出的努力可能不值得。 JSON对于大型数据集不是最佳的。如果您需要快速编码和传输1000万条记录，那么另一种技术可能是正确的答案。