使用OmniThreadLibrary并行写入数组比串行写入慢
我正在努力实现差分进化优化算法，并希望通过并行计算人口成员来加快计算时间。我正在使用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核处理器上加快x6的速度，但却面临着轻微的减速。通过并行运行DoWork过程，我应该更改什么来获得加速比？
请注意，我更愿意将实际工作保留在DoWork过程中，因为我必须能够调用具有和不带并行化的相同算法(布尔标志)，同时保持代码主体共享以便于维护
回答 3
Stack Overflow用户
发布于 2014-04-03 13:41:54
这是由于缺乏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。
Stack Overflow用户
发布于 2014-04-03 16:00:08
不久前，我也遇到了同样的问题。事实证明，瓶颈在于，对于带有范围的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调用中的负载如何，这段代码都在线性地扩展。
Stack Overflow用户
发布于 2014-04-04 11:53:27
我尝试在i7 (8个超级线程)上运行这个(使用随机修复并使用双线程)，并获得并行时间为1650 i7，串行时间为5240 i7。考虑到代码内容，我不认为这是特别出乎意料的扩展。目前的代码将有接近100%成功的管道预测-所有分支预测，函数调用返回缓存，甚至缓存预取工作良好。在一台典型的现代PC上，这意味着代码很可能是内存带宽有限的，其中扩展将在很大程度上取决于您的内存性能，而不是您有多少核心。
唯一的其他问题是FPU资源的潜在竞争，它将高度依赖于您的内部处理器体系结构。
我怀疑如果工作负载更复杂，在串行版本和并行版本之间会出现更大的扩展，因为串行版本将失去编码触发的管道中断的时间，而并行版本的内存将仍然有限。由于内存带宽的限制，我在Delphi中做了相当多的高性能计算工作，经过优化的算法进行简单的计算，在一个好的8核心机器上，在一个很好的8核心机器上，在一个很好的8核心机器上，多线程性能可以与多线程性能完全结合在一起。这类问题可以特别清楚地说明，如果你有过快的能力，因为性能产出的过快，CPU提供了一个非常好的指示的内存等待水平，因为其他所有的速度成比例地超过时钟。
如果您想深入了解处理器体系结构的细节以及它们如何影响您正在做的事情，那么http://www.agner.org/optimize/是一个很好的地方，可以了解需要学习的内容。
https://stackoverflow.com/questions/22835153
复制相似问题
腾讯云开发者
