相同的代码在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矩阵并在所有计算完成后将其复制到位图中来删除了一个重要的瓶颈。这节省了5/8到3倍的重绘位图速度,具体取决于迭代次数(64和4096)。迭代次数越多,计算量越大,出现瓶颈的可能性就越小,在数据中得到很好的反映。另一个建议是使用WaitFor。这提供了去除临界区并消除瓶颈的可能性。由于更新Finished_Tasks语句是唯一剩下的语句,我没有在时间结果中找到它。然而,代码得到了很大的改进。
LU RD提到了AlphaColorToScanline。在VCL时代,我使用ScanLine获得了很好的结果,所以我期望能看到很好的结果。但现在并非如此。我无法检测出使用Scanline与噪声之间的区别。更糟糕的是,在Android中,红色和蓝色字节被交换了。在Windows中,它们被正确地显示。
我发布了下面的代码,这样你就可以自己检查了。以下是一些时间结果(Windows = Core i7-920 4核心,每个核心都有超线程,2.67GHz; Android = ARMv7,1GHz,2(?)核心)
# 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中查看compute。注意末尾添加的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维基上的某个地方,但我找不到了,这是我找到的唯一参考资料)。这解释了为什么使用中间颜色矩阵是一个如此好的主意!
感谢大家的建议!