3

我正在研究差分进化优化算法的实现，并希望通过并行计算总体成员来加快计算时间。我正在使用 OmniThread 库，并成功地并行化了我的循环，却发现它比串行实现运行得更慢。

我已经将代码简化为本质来测试并行化，而简化版本也出现了同样的问题：并行版本比串行版本慢。

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

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

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, DIMENSION1, 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, 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, DIMENSION1, DIMENSION2);

  LGoalFunction := HyperSphere;

  for I := 0 to LOOPS - 1 do
  begin
    for J := 0 to DIMENSION1 - 1 do
    begin
      DoWork(LGoalFunction, LInputArray, LOutputArray1, LOutputArray2, J, 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;

end.

我原本预计我的 8 核处理器的加速速度约为 6 倍，但遇到了轻微的减速。我应该改变什么来获得并行运行DoWork过程的加速？

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

4

3 回答 3

4

这是由于Random. 其中的实现是：

// global var
var
  RandSeed: Longint = 0;    { Base for random number generator }

function Random: Extended;
const
  two2neg32: double = ((1.0/$10000) / $10000);  // 2^-32
var
  Temp: Longint;
  F: Extended;
begin
  Temp := RandSeed * $08088405 + 1;
  RandSeed := Temp;
  F  := Int64(Cardinal(Temp));
  Result := F * two2neg32;
end;

因为RandSeed是一个全局变量，通过调用来修改Random，线程最终会争用对 的写入RandSeed。那些有争议的写入会导致您的性能问题。它们有效地序列化您的并行代码。严重到使其比真正的串行代码慢。

将下面的代码添加到单元的实现部分的顶部，您会看到不同之处：

threadvar
  RandSeed: Longint;

function Random: Double;
const
  two2neg32: double = ((1.0/$10000) / $10000);  // 2^-32
var
  Temp: Longint;
  F: Double;
begin
  Temp := RandSeed * $08088405 + 1;
  RandSeed := Temp;
  F  := Int64(Cardinal(Temp));
  Result := F * two2neg32;
end;

通过这种避免共享、竞争性写入的更改，您会发现并行版本更快，正如预期的那样。你不会得到处理器数量的线性缩放。我的猜测是，这是因为您的内存访问模式在代码的并行版本中是次优的。

我猜您只是Random用作生成一些数据的一种手段。但是，如果您确实需要 RNG，则需要安排每个任务使用自己的 RNG 私有实例。

Sqr(X)您还可以使用而不是加快代码速度X*X，也可以切换到Double代替Extended。

于 2014-04-03T13:41:54.860 回答
3

前段时间我遇到了完全相同的问题。事实证明，瓶颈在于Parallel.ForEach具有范围的调用的 OTL 创建了一个隐藏的枚举器，在任务非常小并且经常调用循环的情况下，它是瓶颈。

一个更高效的解决方案看起来像这样：

Parallel.ForEach(0, MAXCORES)
    .NumTasks(MAXCORES)
    .Execute(
      procedure (const p:Integer)
      var
        chunkSize : Integer;
        myStart, myEnd : Integer;
        i: Integer;
      begin
        chunkSize := DIMENSION div MAXCORES;
        myStart := p * chunkSize;
        myEnd := min( myStart+chunkSize-1, DIMENSION -1);
        for I := myStart to MyEnd do
          DoSomething(i);
      end);

DoSomething无论调用中的负载如何，此代码都非常线性地扩展

于 2014-04-03T16:00:08.823 回答
1

我已经尝试在 i7（8 个超线程）上运行它（使用随机修复并使用 Doubles）并获得并行时间 1650 毫秒和串行时间 5240 毫秒。鉴于代码内容，我不认为这是特别出乎意料的扩大规模。就目前的代码而言，管道预测的成功率接近 100%——预测的所有分支、缓存的函数调用返回，甚至缓存预取都运行良好。在典型的现代 PC 上，这意味着代码可能会受到内存带宽的限制，其中扩展将在很大程度上取决于您的内存性能，而不是您拥有的内核数量。

唯一的另一个问题是对 FPU 资源的潜在争用，这将高度依赖于您的内部处理器架构。

我怀疑如果工作负载更复杂，串行和并行之间会出现更大的扩展，因为串行版本将浪费时间来编码触发的管道中断，而并行版本将保持内存有限。我在 Delphi 中完成了相当多的高性能计算工作，并且由于内存带宽限制，在良好的 8 核机器上，进行简单计算的优化算法可以完全受内存限制，在扩展至 2 倍时具有多线程性能. 如果您具有超频能力，则可以特别清楚地说明此类问题，因为超频 CPU 的性能收益可以很好地指示内存等待的水平，因为其他一切都与超频成比例地加速。

如果您想了解处理器架构的详细信息以及它们如何影响您正在做的事情，那么http://www.agner.org/optimize/是了解有多少要学习的好地方。

于 2014-04-04T11:53:27.970 回答