3

我的应用程序创建了 Mandelbrot 分形的图像。它通过计算数据行，将它们转换为一行颜色，然后将此行复制到位图来实现。首先，这是以串行方式完成的，效果很好。现在我正在尝试使用多个线程来做到这一点。每个线程计算自己的一系列行，例如线程 0 计算 0、4、8、12、...；线程 1: 1, 5, 9, ...; 线程 2: 2, 6, 10, ...，线程 3: 3, 7,...，在给出的示例中使用了 4 个线程 (FMax_Threads = 4)。临界区（声明为全局）必须防止多个线程同时写入位图。另一个全局变量（Finished_Tasks）用于跟踪写入的行数。一旦等于行数，计算就完成了。

相同的代码在 Windows 下运行良好，但在 Android 下会导致位图乱码。我之前注意到Windows 比 Android 更能容忍错误。有人知道我到底做错了什么吗？

下面的单位计算螺纹 mandelbrot

  unit Parallel_Mandelbrot;

  interface

  uses System.SysUtils, System.Types, System.UITypes, System.Classes,
       System.Variants, System.SyncObjs, System.Diagnostics, FMX.Types, FMX.Graphics;
  //     Color_Type_Defs;

  const cZoom_Factor = 3.0;
        cMax_Stack   = 100;

  type
     TPrecision = double;

     Trec_xy = record
        xl: TPrecision;
        yl: TPrecision;
        xu: TPrecision;
        yu: TPrecision;
     end; // Record: Trec_xy //

     TStack_xy = array [0..cMax_Stack + 1] of Trec_xy;

     TCompute = class;

     TParallelMandelbrot = class (TObject)
     private
        FBitmap: TBitmap;
        FXSteps: Int32;
        FYSteps: Int32;
        FMax_Iter: Int32;
        FMax_Threads: Int32;
        FColor_Pattern: Int32;
        FStop: boolean;
        FStack: TStack_xy;
        FCurrent_Stack: Int32;

        function  get_threads: Int32;
        procedure set_threads (value: Int32);
        function  get_iterations: Int32;
        procedure set_iterations (value: Int32);

     public
        constructor Create (Bitmap: TBitmap; xsteps, ysteps, max_iter, cp: uInt32);
        destructor  Destroy; override;
        procedure zoom (xc, yc: Int32);
        procedure unzoom;
        procedure reset;
        function compute (iterations: Int32): Int64;

        property Max_Threads: Int32 read get_threads write set_threads;
        property Iterations: Int32 read get_iterations write set_iterations;
        property Color_Pattern: Int32 read FColor_Pattern write FColor_Pattern;
        property Stop: boolean read FStop write FStop;
     end; // Class: ParallelMandelbrot //

     TCompute = class (TThread)
     protected
        FBitmap: TBitmap;
        Fxl: TPrecision;
        Fyl: TPrecision;
        Fxu: TPrecision;
        Fyu: TPrecision;
        FXSteps: Int32;
        FYSteps: Int32;
        FOffset: Int32;
        FIncr: Int32;
        FMax_Iter: uInt32;
        FColor_Pattern: Int32;

     public
        constructor Create (Bitmap: TBitmap; xl, yl, xu, yu: TPrecision; xsteps, ysteps, offset, incr, max_iter, cp: uInt32);
        destructor Destroy; override;
        procedure Execute; override;
        procedure Work;
     end;// TComputer //

  implementation

  var cs: TCriticalSection;
      Tasks_Finished: Int32;

  {*******************************************************************
  *                                                                  *
  * Class: ParallelMandelbrot                                        *
  *                                                                  *
  ********************************************************************}

  constructor TParallelMandelbrot.Create (Bitmap: TBitmap; xsteps, ysteps, max_iter, cp: uInt32);
  begin
     inherited Create;

     FBitmap := Bitmap;
     FCurrent_Stack := 0;
     FStack [FCurrent_Stack].xl := -2.0;
     FStack [FCurrent_Stack].yl := -1.5;
     FStack [FCurrent_Stack].xu := +1.0;
     FStack [FCurrent_Stack].yu := +1.5;

     FXSteps := xsteps;
     FYSteps := ysteps;
     FMax_Iter := max_iter;
     FColor_Pattern := cp;
     FMax_Threads := 1;

  // Create a global critical section
     cs := TCriticalSection.Create;
  end; // Create //

  destructor TParallelMandelbrot.Destroy;
  begin
     cs.Free;

     inherited Destroy;
  end; // Destroy //

  function TParallelMandelbrot.get_threads: Int32;
  begin
     get_threads := FMax_Threads;
  end; // get_threads //

  procedure TParallelMandelbrot.set_threads (value: Int32);
  begin
     FMax_Threads := value;
  end; // set_threads //

  function TParallelMandelbrot.get_iterations: Int32;
  begin
     get_iterations := FMax_Iter;
  end; // set_iterations //

  procedure TParallelMandelbrot.set_iterations (value: Int32);
  begin
     FMax_Iter := value;
  end; // set_iterations //

  procedure TParallelMandelbrot.zoom (xc, yc: Int32);
  // Zooms factor zoom_factor into the fractal
  var rect: TRectF;
      xfraction, yfraction: TPrecision;
      xcenter, ycenter: TPrecision;
      xrange, yrange: TPrecision;
      xzoom, yzoom: TPrecision;
      offset: TPrecision;
  begin
     if FCurrent_Stack < cMax_Stack - 1 then
     begin
        xrange := FStack [FCurrent_Stack].xu - FStack [FCurrent_Stack].xl;
        yrange := FStack [FCurrent_Stack].yu - FStack [FCurrent_Stack].yl;
        xfraction := xc / FXsteps;
        yfraction := yc / FYsteps;
        xcenter := FStack [FCurrent_Stack].xl + xfraction * (xrange);
        ycenter := FStack [FCurrent_Stack].yl + yfraction * (yrange);
        xzoom := xrange / cZoom_Factor;
        yzoom := yrange / cZoom_Factor;

        FCurrent_Stack := FCurrent_Stack + 1;
        FStack [FCurrent_Stack].xl := xcenter - xzoom / 2;
        FStack [FCurrent_Stack].xu := xcenter + xzoom / 2;
        FStack [FCurrent_Stack].yl := ycenter - yzoom / 2;
        FStack [FCurrent_Stack].yu := ycenter + yzoom / 2;

  // Draw a dotted rectangle to indicate the area on the bitmap that is zoomed into
        FBitmap.Canvas.BeginScene;
        try
  // Create a rectangle with (Left, Top, Right, Bottom)
           offset := 2 * cZoom_Factor;
           rect := TRectf.Create(xc - FXSteps / offset, yc - FYSteps / offset,
                                 xc + FXSteps / offset, yc + FYSteps / offset);
           FBitmap.Canvas.Stroke.Color := TAlphaColors.Black;
           FBitmap.Canvas.StrokeDash := TStrokeDash.sdDot;
           FBitmap.Canvas.DrawRect(rect, 0, 0, AllCorners, 50);
        finally
           FBitmap.Canvas.EndScene;
        end; // try..finally
     end; // if
  end; // mandel_zoom //

  procedure TParallelMandelbrot.unzoom;
  begin
     if FCurrent_Stack > 0 then
     begin
        FCurrent_Stack := FCurrent_Stack - 1;
     end; // if
  end; // mandel_unzoom //

  procedure TParallelMandelbrot.reset;
  begin
     FCurrent_Stack := 0;
  end; // reset //

  function TParallelMandelbrot.compute (iterations: Int32): Int64;
  var Timer: TStopWatch;
      threads: array of TCompute;
      thread: Int32;
      xs, ys: Int32;
      xl, yl, xu, yu: TPrecision;
  begin
     xl := FStack [FCurrent_Stack].xl;
     yl := FStack [FCurrent_Stack].yl;
     xu := FStack [FCurrent_Stack].xu;
     yu := FStack [FCurrent_Stack].yu;
     xs := FXSteps;
     ys := FYSteps;
     SetLength (threads, FMax_Threads);
     Tasks_Finished := 0; // No tasks finished yet
     Timer.Create;
     Timer.Reset;
     Timer.Start;
     FBitmap.SetSize (FXSteps, FYSteps);
     FBitmap.Canvas.BeginScene; // Tell the canvas we start drawing
     try
  // The threads are created suspended, so they have to be started explicitly
        for thread := 0 to Max_Threads - 1
           do threads [thread] := TCompute.Create (FBitmap, xl, yl, xu, yu, xs, ys, thread, Max_Threads, Iterations, Color_Pattern);
        for thread := 0 to Max_Threads - 1
           do threads [thread].Start;

  // Wait until all threads are ready. Each thread increments Tasks_Finished
  // when one row is computed
        while Tasks_Finished < FYSteps do
        begin
           Sleep (50);
        end; // while
     finally
        Timer.Stop;
        Result := Timer.ElapsedMilliseconds;
        cs.Acquire; // Be absolutely sure all threads left the cirtical section
        try
           FBitmap.Canvas.EndScene; // and tell the canvas we're ready
        finally
           cs.Leave;
        end; // try..finally
     end; // try..finally
  end; // compute //

  {*******************************************************************
  *                                                                  *
  * Class: TCompute                                                  *
  *                                                                  *
  ********************************************************************}

  constructor TCompute.Create (Bitmap: TBitmap; xl, yl, xu, yu: TPrecision; xsteps, ysteps, offset, incr, max_iter, cp: uInt32);
  begin
     inherited Create (True); // Create suspended

     FBitmap := Bitmap;
     Fxl := xl;
     Fyl := yl;
     Fxu := xu;
     Fyu := yu;
     FXSteps := xsteps;
     FYSteps := ysteps;
     FOffset := offset;
     FIncr   := incr;
     FMax_Iter := max_iter;
     FColor_Pattern := cp;
  end; // Create //

  destructor TCompute.Destroy;
  begin
     inherited Destroy;
  end; // Destroy //

  procedure TCompute.Execute;
  begin
     try
        Work;
     except
        // A thread should never crash in Execute, just ignore the exception
     end;
  end; // Execute //

  procedure TCompute.Work;
  var vBitMapData: TBitmapData;
      row_of_colors: array of TAlphaColor;
      ix, iy: Int32;
      w, h: Int32;
      iter: uInt32;
      xl, yl, xu, yu: TPrecision;
      x, y: TPrecision;
      x0, y0: TPrecision;
      x2, y2: TPrecision;
      x_inc, y_inc: TPrecision;
      inv_max_iter: TPrecision;
      temp: TPrecision;
  begin
  // Initialize the bitmap size
     h := Round (FBitmap.Height);
     w := Round (FBitmap.Width);
     FXsteps := w;
     FYsteps := h;
     inv_max_iter := 1 / FMax_Iter;
     SetLength (row_of_colors, FXSteps);

     xl := Fxl;
     yl := Fyl;
     xu := Fxu;
     yu := Fyu;

  // compute the Mandelbrot image. Iterate row wise, as the bitmap is organized
  // row wise (first y, later x). This makes it easier to multi-thread the
  // computation in a later stage.
     x_inc := (xu - xl) / FXsteps;
     y_inc := (yu - yl) / FYsteps;

  // For each row (y) starting at FOffset, incremented with FIncr
     iy := FOffset;
     while iy < FYsteps do
     begin

  // Compute one column (x)
        ix := 0;
        while ix < FXsteps do
        begin
           x0 := xl + ix * x_inc;
           y0 := yl + iy * y_inc;
           x := 0;
           y := 0;
           x2 := 0;
           y2 := 0;
           iter := 0;
           while ((x2 + y2) < 4) and (iter < FMax_Iter) do
           begin
              temp := x2 - y2 + x0;
              y := 2 * x * y + y0;
              x := temp;
              x2 := Sqr (x);
              y2 := Sqr (y);
              iter := iter + 1;
           end; // while
           case iter mod 4 of // 4 shades of blue
              0: row_of_colors [ix] := $FFFFFFFF;
              1: row_of_colors [ix] := $FF4444FF;
              2: row_of_colors [ix] := $FF8888FF;
              3: row_of_colors [ix] := $FFCCCCFF;
           end; // case
  //         row_of_colors [ix] := create_color (iter * inv_max_iter, FColor_Pattern);
           ix := ix + 1;
        end; // while

  // Copy the computed row to the bitmap. Use the critical section to aquire
  // exclusive write rights to the bitmap
        cs.Acquire;
        try
           if FBitmap.Map (TMapAccess.maWrite, vBitMapData) then
           try
              for ix := 0 to FXSteps - 1
                 do vBitmapData.SetPixel (ix, iy, row_of_colors [ix]); // set the pixel color at x, y
           finally
              FBitmap.Unmap (vBitMapData);   // unlock the bitmap
           end; // if  try..finally
           Tasks_Finished := Tasks_Finished + 1;
        finally
           cs.Release;
        end; // try..finally

  // On to the next row
        iy := iy + FIncr;
     end; // while
  end; // Work //

  end. // Unit: Parallel_Mandelbrot //

它被称为如下：

Mandel := TParallelMandelbrot.Create (Image.Bitmap, Round (Image.Width), Round (Image.Height), 255, 0);
Mandel.compute (32);

正如您可能已经猜到的那样，Image 是表单上的 TImage。

任何帮助是极大的赞赏！

更新 1 LU RD 和 David 的言论让我重新考虑算法。结果，我发现 TParallelMandelbrot.compute 函数中缺少 FBitmap.Canvas.EndScene。当我更正该应用程序在 Windows 和 Android 中都可以运行时。

起初，我通过使用 TAlphoColor 矩阵并在所有计算完成后将其复制到位图来消除一个重要的瓶颈。根据迭代次数（64 和 4096），重绘位图的速度可以节省 5/8 到 3 倍。迭代次数越多，计算越多，出现瓶颈的可能性就越小，这在图中很好地反映了这一点。另一个建议是使用 WaitFor。这提供了移除关键部分和瓶颈的可能性。与 Finished_Tasks 的更新一样，剩下的唯一语句我无法在计时结果中找到它。然而，代码得到了极大的改进。

LU RD 提到了 AlphaColorToScanline。由于我在 VCL 的日子里使用 ScanLine 获得了很好的结果，我希望能看到很好的结果。现在不是这样。除了噪音之外，我无法检测到使用扫描线之间的差异。然而更糟糕的是，在 Android 中，红色和蓝色字节被交换了。在 Windows 中，它们可以正确显示。

我发布了下面的代码，以便您自己检查。下面是一些时序结果（Windows = core i7-920 4 cores each cores with hyper thread, 2.67Ghz; Android = ARMv7, 1Ghz, 2(?) cores）

  # of    timings in seconds
  threads windows android
    1       5.5     30.0
    2       2.9     20.0
    4       1.6     19.7
    8       1.1       -

请参阅下面的 TParallelMandelbrot 中的计算。在添加的末尾标记 EndScene 语句。Windows 并不在意，但 Android 却很在意。我现在创建了未暂停的线程，我不需要再启动它们了。改进几乎不明显。

  function TParallelMandelbrot.compute (iterations: Int32): Int64;
  var Timer: TStopWatch;
      vBitMapData: TBitmapData;
      threads: array of TCompute;
      thread: Int32;

      xi, yi: Int32;
      xs, ys: Int32;
      xl, yl, xu, yu: TPrecision;
  begin
     xl := FStack [FCurrent_Stack].xl;
     yl := FStack [FCurrent_Stack].yl;
     xu := FStack [FCurrent_Stack].xu;
     yu := FStack [FCurrent_Stack].yu;
     xs := FXSteps;
     ys := FYSteps;
     SetLength (threads, FMax_Threads);
     Timer.Create;
     Timer.Reset;
     Timer.Start;
     FBitmap.SetSize (FXSteps, FYSteps);

  // The threads are created suspended, so they have to be started explicitly
     for thread := 0 to Max_Threads - 1
        do threads [thread] := TCompute.Create (FColor_Matrix, xl, yl, xu, yu, xs, ys, thread, Max_Threads, Iterations, Color_Pattern);
     for thread := 0 to Max_Threads - 1
        do threads [thread].WaitFor;

     Timer.Stop;
     Result := Timer.ElapsedMilliseconds;
     FBitmap.Canvas.BeginScene; // Tell the canvas we start drawing
     try
        if FBitmap.Map (TMapAccess.maWrite, vBitMapData) then
        try
           for yi := 0 to ys - 1 do
           for xi := 0 to xs - 1 do
              vBitmapData.SetPixel (xi, yi, FColor_Matrix [yi, xi]); // set the pixel color at x, y
  //            AlphaColorToScanline (FColor_Matrix [yi], vBitmapData.GetScanline (yi), xs, pfA8R8G8B8);
        finally
           FBitmap.Unmap (vBitMapData);   // unlock the bitmap
        end; // if  try..finally
     finally
        FBitmap.Canvas.EndScene;
     end; // try..finally
  end; // compute //

以及TCompute中的计算功能：

  procedure TCompute.Work;
  var ix, iy: Int32;
      iter: uInt32;
      xl, yl, xu, yu: TPrecision;
      x, y: TPrecision;
      x0, y0: TPrecision;
      x2, y2: TPrecision;
      x_inc, y_inc: TPrecision;
      inv_max_iter: TPrecision;
      temp: TPrecision;
  begin
  // Initialize the bitmap size
     inv_max_iter := 1 / FMax_Iter;

     xl := Fxl;
     yl := Fyl;
     xu := Fxu;
     yu := Fyu;

  // compute the Mandelbrot image. Iterate row wise, as the bitmap is organized
  // row wise (first y, later x). This makes it easier to multi-thread the
  // computation in a later stage.
     x_inc := (xu - xl) / FXsteps;
     y_inc := (yu - yl) / FYsteps;

  // For each row (y) starting at FOffset, incremented with FIncr
     iy := FOffset;
     while iy < FYsteps do
     begin

  // Compute one column (x)
        ix := 0;
        while ix < FXsteps do
        begin
           x0 := xl + ix * x_inc;
           y0 := yl + iy * y_inc;
           x := 0;
           y := 0;
           x2 := 0;
           y2 := 0;
           iter := 0;
           while ((x2 + y2) < 4) and (iter < FMax_Iter) do
           begin
              temp := x2 - y2 + x0;
              y := 2 * x * y + y0;
              x := temp;
              x2 := Sqr (x);
              y2 := Sqr (y);
              iter := iter + 1;
           end; // while
           FColor_Matrix [iy, ix] := create_color (iter * inv_max_iter, FColor_Pattern);
           ix := ix + 1;
        end; // while

  // On to the next row
        iy := iy + FIncr;
     end; // while
  end; // Work //

更新 2 最后的结论是 TBitmap不是线程安全的。请参阅此链接（它位于 Embarcadero wiki 上的某个位置，但无法重新找到它，这是我找到的唯一参考）。这就解释了为什么使用中间 colot 矩阵是一个好主意！

谢谢大家的建议！

4

1 回答 1

3

我实际上并不确定为什么代码在 Android 上失败。但最可能的解释是您正在远离主线程执行 GUI 工作。您这样做是因为您在TImage远离主线程的位图上进行操作。

无论如何，使用共享位图和临界区来收集 Mandlebrot 计算的结果是非常低效的。您正在序列化关键部分上的所有线程，以便它们可以写入位图的单独部分。

正如评论中提到的 LURD，您可以简单地消除该瓶颈。让你的线程将它们的结果收集到一个共享的颜色矩阵中。由于每个线程完整地处理一整行，因此没有数据竞争，您可以删除临界区。一旦所有线程都完成，您就可以将矩阵 blit 到位图上，工作就完成了。我认为您可以使用扫描线技术在 FMX 中有效地做到这一点。

一个可能的缩放障碍是，如果一个线程在 row 的末尾i运行而另一个线程在 row 的开头运行，您可能会得到错误的共享i+1。通过让线程 1 处理行0..(N/k)-1、线程 2 处理行(N/k)..(2N/k)-1等来处理这个问题，其中 N 是行数，k 是线程数。换句话说，让每个线程处理连续的行。

还有一些评论：

  1. 你有经典的数据竞赛Tasks_Finished。使用InterlockedIncrement更新将解决该问题。但是，您根本不需要该变量。
  2. 您不需要Tasks_Finished，因为您的等待方法很弱。只需通过调用线程等待每个线程完成WaitFor。对所有线程循环执行此操作。这称为加入。在 Windows 上，有加入多个线程的有效机制，但 RTL 没有公开它们。由于您是跨平台的，因此跨线程调用的简单循环WaitFor就足够了。
  3. 您正在抑制线程过程中的异常。也许您的 Android 代码正在抛出它们，而您压制它们。该类TThread已经捕获任何异常并将它们存储在FatalException. 您应该删除Execute方法中的异常处理程序并检查是否FatalException在完成时分配。
  4. 创建暂停的线程似乎毫无意义，只有在创建完所有线程后才启动它们。为什么让你的线程那样等待？那只能拖延进度。创建非暂停的线程，让它们直接开始工作。
  5. 为什么使用固定大小的堆栈？TStack<T>当然，为这项工作而构建的使用起来会容易得多。
于 2013-10-06T11:13:45.747 回答