delphi TParallel并行性能测试

program Project4;

{$APPTYPE CONSOLE}

{$R *.res}

uses

System.SysUtils, System.Threading, System.Classes, System.SyncObjs;

const

MaxArr = 100000000;

var

Ticks: Cardinal;

i: Integer;

odds: Integer;

ArrXY: TArray;

type

TParallelEx = class

private

class function GetWorker(body: TFunc, Integer, Integer, TResult>; source: TArray; min, max: Integer): TFunc;

public

class procedure &For(source: TArray;

body: TFunc, Integer, Integer, TResult>;

aggregator: TProc);

end;

procedure FillArray;

var

i: Integer;

j: Integer;

begin

SetLength(ArrXY, MaxArr);

for i := 0 to MaxArr-1 do

ArrXY[i]:=Random(MaxInt);

end;

procedure Parallel;

begin

odds := 0;

Ticks := TThread.GetTickCount;

TParallel.For(0, MaxArr-1, procedure(I:Integer)

begin

if ArrXY[i] mod 2 <> 0 then

TInterlocked.Increment(odds);

end);

Ticks := TThread.GetTickCount - Ticks;

writeln('Parallel: ' + Ticks.ToString + 'ms, odds: ' + odds.ToString);

end;

procedure Serial;

begin

odds := 0;

Ticks := TThread.GetTickCount;

for i := 0 to MaxArr-1 do

if ArrXY[i] mod 2 <> 0 then

Inc(odds);

Ticks := TThread.GetTickCount - Ticks;

writeln('Serial: ' + Ticks.ToString + 'ms, odds: ' + odds.ToString);

end;

const

WorkerCount = 4;

function GetWorker(index: Integer; const oddsArr: TArray): TProc;

var

min, max: Integer;

begin

min := MaxArr div WorkerCount * index;

if index + 1 < WorkerCount then

max := MaxArr div WorkerCount * (index + 1) - 1

else

max := MaxArr - 1;

Result :=

procedure

var

i: Integer;

odds: Integer;

begin

odds := 0;

for i := min to max do

if ArrXY[i] mod 2 <> 0 then

Inc(odds);

oddsArr[index] := odds;

end;

procedure Parallel2;

var

i: Integer;

oddsArr: TArray;

workers: TArray;

begin

odds := 0;

Ticks := TThread.GetTickCount;

SetLength(oddsArr, WorkerCount);

SetLength(workers, WorkerCount);

for i := 0 to WorkerCount-1 do

workers[i] := TTask.Run(GetWorker(i, oddsArr));

TTask.WaitForAll(workers);

for i := 0 to WorkerCount-1 do

Inc(odds, oddsArr[i]);

Ticks := TThread.GetTickCount - Ticks;

writeln('Parallel: Stefan Glienke ' + Ticks.ToString + ' ms, odds: ' + odds.ToString);

end;

procedure parallel3;

var

sum: Integer;

begin

Ticks := TThread.GetTickCount;

TParallelEx.For( ArrXY,

function(Arr: TArray; min, max: Integer): Integer

var

i: Integer;

res: Integer;

begin

res := 0;

for i := min to max do

if Arr[i] mod 2 <> 0 then

Inc(res);

Result := res;

end,

procedure(res: Integer) begin sum := sum + res; end );

Ticks := TThread.GetTickCount - Ticks;

writeln('ParallelEx: Markus Joos ' + Ticks.ToString + ' ms, odds: ' + odds.ToString);

end;

{ TParallelEx }

class function TParallelEx.GetWorker(body: TFunc, Integer, Integer, TResult>; source: TArray; min, max: Integer): TFunc;

begin

Result := function: TResult

begin

Result := body(source, min, max);

end;

class procedure TParallelEx.&For(source: TArray;

body: TFunc, Integer, Integer, TResult>;

aggregator: TProc);

var

I: Integer;

workers: TArray>;

workerCount: Integer;

min, max: integer;

MaxIndex: Integer;

begin

workerCount := TThread.ProcessorCount;

SetLength(workers, workerCount);

MaxIndex := length(source);

for I := 0 to workerCount -1 do

begin

min := (MaxIndex div WorkerCount) * I;

if I + 1 < WorkerCount then

max := MaxIndex div WorkerCount * (I + 1) - 1

else

max := MaxIndex - 1;

workers[i]:= TTask.Future(GetWorker(body, source, min, max));

end;

for i:= 0 to workerCount-1 do

begin

aggregator(workers[i].Value);

end;

begin

try

FillArray;

Serial;

Parallel;

Parallel2;

Parallel3;

except

on E: Exception do

Writeln(E.ClassName, ': ', E.Message);

end;

Readln;

end.

关于使用局部变量收集总和然后在末尾收集它们的任务，可以为此使用一个单独的数组：

var

sums: array of Integer;

begin

SetLength(sums, MaxArr);

for I := 0 to MaxArr-1 do

sums[I] := 0;

Ticks := TThread.GetTickCount;

TParallel.For(0, MaxArr-1,

procedure(I:Integer)

begin

if ArrXY[i] mod 2 = 0 then

Inc(sums[I]);

end

);

Ticks := TThread.GetTickCount - Ticks;

odds := 0;

for I := 0 to MaxArr-1 do

Inc(odds, sums[i]);

writeln('Parallel - false odds: ' + Ticks.ToString + 'ms, odds: ' + odds.ToString);

end;

来源：https://stackoverflow.com/questions/27535045/tparallel-for-performance

推荐分享