绘制具有多个线程的位图,在Windows和Android中结果不同
作者：互联网
我的应用程序创建了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 is somewhat more forgiving to errors than 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 =核心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不是线程安全的.看到此link(它在Embarcadero Wiki上的某个位置,但无法重新引用,这是我找到的唯一参考).这就解释了为什么使用中间colot矩阵是一个好主意！
谢谢大家的建议！
解决方法:
我实际上不确定为什么在Android上代码会失败.但是最有可能的解释只是,您是在主线程之外执行GUI工作.之所以这样做,是因为您要在远离主线程的TImage位图上进行操作.
无论如何,使用共享位图和关键部分来收集Mandlebrot计算的结果都是非常低效的.您正在序列化关键部分上的所有线程,以便它们可以写入位图的各个部分.
正如LURD在评论中提到的那样,您可以简单地消除该瓶颈.让您的线程将结果收集到共享的颜色矩阵中.因为每个线程都处理整个行,所以没有数据争用,您可以删除关键部分.一旦所有线程完成,就可以将矩阵映射到位图上,然后完成工作.我认为您可以使用扫描线技术在FMX中高效地执行此操作.
一个可能的扩展障碍是,如果一个线程在第i行的末尾操作而另一个线程在第i行的第1行操作,则可能会导致错误共享.请通过使线程1处理第0行来解决该问题.(N / k )-1,线程2处理行(N / k)..(2N / k)-1等,其中N是行数,k是线程数.换句话说,让每个线程处理连续的行.
更多评论：
>您在Tasks_Finished上具有经典的数据竞争.使用InterlockedIncrement进行更新可以解决该问题.但是,您根本不需要该变量.
>您不需要Tasks_Finished,因为您的等待方法很弱.只需在线程上调用WaitFor等待每个线程完成.循环执行所有线程.这称为加入.在Windows上,有一种用于连接多个线程的有效机制,但是RTL不会公开它们.由于您是跨平台的,因此在调用WaitFor的线程之间进行简单循环就足够了.
>您要在线程过程中禁止异常.也许您的Android代码正在抛出它们,而您却抑制了它们. TThread类已经捕获了所有异常并将其存储在FatalException中.您应该在Execute方法中删除异常处理程序,并检查是否在完成时分配了FatalException.
>创建挂起的线程似乎没有意义,只有在创建完所有线程后才启动它们.为什么要让线程这样等待？那只会延迟进度.创建非暂停的线程,让它们直接投入业务.
>为什么要使用固定大小的堆栈？当然,使用TStack< T>会容易得多.专为这项工作而设计.
标签：multithreading,bitmap,delphi-xe5,android,delphi 来源： https://codeday.me/bug/20191122/2061633.html