私のアプリは、マンデルブロ フラクタルの画像を作成します。これは、データの行を計算し、これらを色の行に変換し、次にこの行をビットマップにコピーすることによって行われます。最初に、これは連続した方法で行われ、うまく機能しました。現在、複数のスレッドでこれを実行しようとしています。各スレッドは独自の一連の行を計算します。たとえば、スレッド 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 よりもエラーに対して寛容であることに気付きました。誰かが私が間違っていることを正確に知っていますか?
以下のユニットは、スレッド化されたマンデルブロを計算します
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 です。
どんな助けでも大歓迎です！
Update 1 LU RD と David の発言により、アルゴリズムを再考するようになりました。その結果、FBitmap.Canvas.EndScene が TParallelMandelbrot.compute 関数にないことがわかりました。アプリがWindowsとAndroidの両方で動作することを修正したとき。
最初に、TAlphoColor のマトリックスを使用し、すべての計算が完了したときにこれをビットマップにコピーすることで、重要なボトルネックを取り除きました。これにより、反復回数 (64 回と 4096 回) に応じて、ビットマップの再描画速度が 5/8 から 3 倍短縮されました。反復回数が多く、計算量が多いほど、ボトルネックが発生する可能性が低くなり、数値にうまく反映されています。もう 1 つの提案は、WaitFor を使用することでした。これにより、クリティカル セクションとボトルネックを取り除く可能性がもたらされました。Finished_Tasks の更新と同様に、唯一のステートメントが残っていたので、タイミング結果でこれを見つけることができませんでした。ただし、コードは大幅に改善されました。
LU RD は AlphaColorToScanline について言及しました。VCL 時代に ScanLine で素晴らしい結果を得たので、素晴らしい結果が得られると期待していました。今はそうではありません。ノイズ以外のスキャンラインを使用した場合の違いを検出できませんでした。さらに悪いことに、Android では赤と青のバイトが入れ替わっています。Windows では正しく表示されます。
以下にコードを公開しましたので、ご自分で確認してください。いくつかのタイミング結果の下 (Windows = ハイパースレッド、2.67Ghz を備えたコア i7-920 4 コア; 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 での計算を参照してください。追加された末尾の 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 //
Update 2 最終的な判断は、TBitmap はスレッド セーフではないということです。このリンクを参照してください(これは Embarcadero wiki のどこかにありますが、再検索できませんでした。これは私が見つけた唯一の参照です)。これは、中間コロット行列を使用することがなぜ良い考えなのかを説明しています!
ご提案いただきありがとうございます。