多线程 – 使用OmniThreadLibrary并行写入比使用串行写入慢的数

我已经将代码简化为其本质以测试并行化,并且缩减版本表现出相同的问题：并行版本比串行版本慢.

关键是我传递了多个动态数组,应该为每个成员编写一个输出.每个数组都有一个专用于填充成员的维度,因此对于每个填充成员,访问一组不同的数组索引.这也意味着在并行实现中,没有2个线程将写入同一个数组元素.

在我用来测试的代码下面(差异进化中的实际代码有一个带有更多const参数和var数组的DoWork过程)

unit Unit1;

interface

type
  TGoalFunction = reference to function(const X,B: array of extended): extended;
  TArrayExtended1D = array of extended;
  TArrayExtended2D = array of TArrayExtended1D;

  TClassToTest = class abstract
  private
    class procedure DoWork(const AGoalFunction: TGoalFunction; const AInputArray: TArrayExtended2D; var AOutputArray1: TArrayExtended1D; var AOutputArray2: TArrayExtended2D; const AIndex,AIndex2: integer);
  public
    class procedure RunSerial;
    class procedure RunParallel;
  end;

function HyperSphere(const X,B: array of extended): extended;

const
  DIMENSION1 = 5000;
  DIMENSION2 = 5000;
  LOOPS = 10;

implementation

uses
  OtlParallel;

function HyperSphere(const X,B: array of extended): extended;
var
  I: Integer;
begin
  Result := 0;
  for I := 0 to Length(X) - 1 do
    Result := Result + X[I]*X[I];
end;

{ TClassToTest }

class procedure TClassToTest.DoWork(const AGoalFunction: TGoalFunction; const AInputArray: TArrayExtended2D; var AOutputArray1: TArrayExtended1D; var AOutputArray2: TArrayExtended2D; const AIndex,AIndex2: integer);
var
  I: Integer;
begin
  AOutputArray1[AIndex] := AGoalFunction(AInputArray[AIndex],[]);
  for I := 0 to Length(AOutputArray2[AIndex]) - 1 do
    AOutputArray2[AIndex,I] := Random*AIndex2;
end;

class procedure TClassToTest.RunParallel;
var
  LGoalFunction: TGoalFunction;
  LInputArray: TArrayExtended2D;
  LOutputArray1: TArrayExtended1D;
  LOutputArray2: TArrayExtended2D;
  I,J,K: Integer;
begin
  SetLength(LInputArray,DIMENSION1,DIMENSION2);
  for I := 0 to DIMENSION1 - 1 do
  begin
    for J := 0 to DIMENSION2 - 1 do
      LInputArray[I,J] := Random;
  end;
  SetLength(LOutputArray1,DIMENSION1);
  SetLength(LOutputArray2,DIMENSION2);

  LGoalFunction := HyperSphere;

  for I := 0 to LOOPS - 1 do
  begin
    Parallel.ForEach(0,DIMENSION1 - 1).Execute(
      procedure (const value: integer)
      begin
        DoWork(LGoalFunction,LInputArray,LOutputArray1,LOutputArray2,value,I);
      end
    );

    for J := 0 to DIMENSION1 - 1 do
    begin
      for K := 0 to DIMENSION2 - 1 do
        LInputArray[J,K] := LOutputArray2[J,K];
    end;
  end;
end;

class procedure TClassToTest.RunSerial;
var
  LGoalFunction: TGoalFunction;
  LInputArray: TArrayExtended2D;
  LOutputArray1: TArrayExtended1D;
  LOutputArray2: TArrayExtended2D;
  I,DIMENSION2);

  LGoalFunction := HyperSphere;

  for I := 0 to LOOPS - 1 do
  begin
    for J := 0 to DIMENSION1 - 1 do
    begin
      DoWork(LGoalFunction,I);
    end;

    for J := 0 to DIMENSION1 - 1 do
    begin
      for K := 0 to DIMENSION2 - 1 do
        LInputArray[J,K];
    end;
  end;
end;

end.

我期待在我的8核处理器上加速大约x6,但是面临轻微的减速.我应该更改什么来提高并行运行DoWork过程的速度？

请注意,我宁愿保留DoWork过程中的实际工作,因为我必须能够在有和没有并行化(布尔标志)的情况下调用相同的算法,同时保持代码的主体共享以便于维护