DelphiXE矩阵乘法的并行设计

参考了网上搜索的Delphi并行代码，修改后实现矩阵乘法的并行计算。

• 源码

unit UnitTest;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Grids, StdCtrls, Buttons, SyncObjs, CodeSiteLogging, Math;
type
  Matrx1 = array of Double;
  Matrx2 = array of array of Double;
type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Label1: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
    procedure ArrMul(K,X: Matrx2; var Y: Matrx2);
    procedure InitializationPara();
  public
    { Public declarations }
    procedure PMatrixTwo(i, ThreadID: Integer);        // 匿名函数具体实现，执行一次
    procedure PMatrixOne(i, ThreadID: Integer);        // 匿名函数具体实现，执行一次
  end;
  TParallelCompulation = reference to procedure(i, ThreadID: Integer);   // 匿名方法
  TParallel = class(TThread)
    private
      FProc     : TParallelCompulation;   // 匿名方法实现
      FThreadID : Integer;                // 当前线程 ID
    protected
      procedure Execute; override;
      function GetNextValue: Integer;
    public
      constructor Create;
      destructor Destroy; override;
      property Proc: TParallelCompulation read FProc write FProc;
    class var
      CurrPos : Integer;            // 当前循环次数
      MaxPos  : Integer;            // 最大循环次数
      cs      : TCriticalSection;   // 临界区对象
      ThCount : Integer;            // 已完成运行的线程数
  end;
var
  Form1            : TForm1;
  Sj1,Sj2          : TDateTime;
  iRow,iCol1,iCol2 : Integer;
  mA,mB,mC         : Matrx2;
  mB2,mC2          : Matrx1;
  mA2              : Matrx2;
procedure ParanelFor(nMin, nMax, nThreads: Integer; aProc: TParallelCompulation); overload;
{*
  ParanelFor - 所有迭代将以最大核数执行
  nMin       - 最小循环次数
  nMax       - 最大循环次数
  nThreads   - 使用的线程数
  aProc      - 循环线程中执行的匿名方法
*}
procedure ParanelFor(nMin, nMax: Integer; aProc: TParallelCompulation); overload;
implementation
{$R *.dfm}
procedure ParanelFor(nMin, nMax, nThreads: Integer; aProc: TParallelCompulation);
var
  threads: array of TParallel;
  i: Integer;
begin
  if nMin > nMax then
  begin
    Exit;
  end;
  // 初始化线程参数
  TParallel.CurrPos := nMin;
  TParallel.MaxPos := nMax;
  TParallel.cs := TCriticalSection.Create;
  TParallel.ThCount := 0;
  // 创建线程
  SetLength(threads, nThreads);
  for i := 0 to nThreads - 1 do
  begin
    threads[i] := TParallel.Create;
    threads[i].FThreadID := i;
    threads[i].Proc := aProc;
    threads[i].Start;
  end;
  for i := 0 to nThreads - 1 do
  begin
    Application.ProcessMessages;
    threads[i].WaitFor;
  end;
  for i := 0 to nThreads - 1 do
  begin
    threads[i].Free;
  end;
  TParallel.cs.Free;
end;
procedure ParanelFor(nMin, nMax: Integer; aProc: TParallelCompulation);
begin
  // CPU数量来自系统
  ParanelFor(nMin, nMax, CPUCount, aProc);
end;
{ TParanel }
constructor TParallel.Create;
begin
  inherited Create(True);      // 延迟
  InterlockedIncrement(ThCount);
  FreeOnTerminate := False;
  FThreadID       := 0;
end;
destructor TParallel.Destroy;
begin
  InterlockedDecrement(ThCount);
  inherited;
end;
procedure TParallel.Execute;
var
  nCurrent : Integer;
begin
  nCurrent := GetNextValue;
  while nCurrent <= MaxPos do
  begin
    Proc(nCurrent, ThreadID);
    nCurrent := GetNextValue;
  end;
end;
function TParallel.GetNextValue: Integer;
begin
  cs.Acquire;
  try
    Result := CurrPos;
    Inc(CurrPos);
  finally
    cs.Release;
  end;
end;
procedure TForm1.ArrMul(K, X: Matrx2; var Y: Matrx2);
var
  i,j,m: Integer;
begin
  for i := 0 to Length(K) - 1 do
  begin
    for j := 0 to Length(X[0]) - 1 do
    begin
      Y[i,j]:= 0;
      for m := 0 to Length(X) - 1 do
      begin
        Y[i,j]:= Y[i,j] + K[i,m] * X[m,j];
      end;
    end;
  end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
  // 普通循环
  InitializationPara;
  sj1 := Now;
  ArrMul(mA, mB, mC);
  Sj2 := Now;
  CodeSite.Enabled := True;
  CodeSite.Send('总时间(s) ' + FormatFloat('#0.###', (Sj2 - Sj1) * 24 * 3600));
  CodeSite.Send(Format('%.4f, %.4f, %.4f %.4f', [mC[0, 0], mC[0, 1], mC[1, 0], mC[1, 1]]));
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
  // 并行计算
  InitializationPara;
  CodeSite.Enabled:= True;
  Sj1 := Now;
  ParanelFor(1, iRow, PMatrixTwo);
  Sj2 := Now;
  CodeSite.Send('总时间(s) ' + FormatFloat('#0.###', (Sj2 - Sj1) * 24 * 3600));
  CodeSite.Send(Format('%.4f, %.4f, %.4f %.4f', [mC[0, 0], mC[0, 1], mC[1, 0], mC[1, 1]]));
end;
procedure TForm1.InitializationPara;
var
  i,j: Integer;
begin
  iRow  := 1000;
  iCol1 := 200;
  iCol2 := 100;
  SetLength(mA, 0, 0);
  SetLength(mB, 0, 0);
  SetLength(mC, 0, 0);
  SetLength(mA, iRow, iCol1);
  SetLength(mB, iCol1, iCol2);
  SetLength(mC, iRow, iCol2);
  for i := 0 to iRow - 1 do
  begin
    for j := 0 to iCol1 - 1 do
    begin
      mA[i, j] := (i + j)/100;
    end;
  end;
  for i := 0 to iCol1 - 1 do
  begin
    for j := 0 to iCol2 - 1 do
    begin
      mB[i, j] := (i + j)/100;
    end;
  end;
end;
procedure TForm1.PMatrixOne(i, ThreadID: Integer);
var
  j : Integer;
begin
  // i 表示第 i 行，iCol1和 iCol2分别表示矩阵 mA 的列和矩阵 mB 的列
  for j := 0 to iCol1 - 1 do
  begin
    mC2[i - 1] := 0;
    mC2[i - 1] := mC2[i - 1] + mA2[i - 1, j] * mB2[j];
  end;
end;
procedure TForm1.PMatrixTwo(i, ThreadID: Integer);
var
  j,k : Integer;
begin
  // i 表示第 i 行，iCol1和 iCol2分别表示矩阵 mA 的列和矩阵 mB 的列
  for j := 0 to iCol2 - 1 do
  begin
    mC[i - 1, j] := 0;
    for k := 0 to iCol1 - 1 do
    begin
      mC[i - 1, j] := mC[i - 1, j] + mA[i - 1, k] * mB[k, j];
    end;
  end;
end;
end.

•  结果分析

总时间(s) 1.571

4154.1750, 4166.6500, 4166.6500 4179.1750

总时间(s) 0.33

4154.1750, 4166.6500, 4166.6500 4179.1750

总时间(s) 1.481

4154.1750, 4166.6500, 4166.6500 4179.1750

总时间(s) 0.326

4154.1750, 4166.6500, 4166.6500 4179.1750

    我的台式机是8核的，总的计算时间并没有想象中的缩短到八分之一，但也是大幅度降低了计算时间，对于大型矩阵运算很有参考价值。