Мое приложение создает изображение фрактала Мандельброта. Он делает это путем вычисления строк данных, преобразования их в строку цветов и последующего копирования этой строки в растровое изображение. Сначала это делалось серийно и отлично работало. Теперь я пытаюсь сделать это с несколькими потоками. Каждый поток вычисляет свою собственную серию строк, например. поток 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 в форме.
Любая помощь приветствуется!
Обновление 1. Замечания LU RD и Дэвида заставили меня пересмотреть алгоритм. В результате я обнаружил, что FBitmap.Canvas.EndScene отсутствует в функции TParallelMandelbrot.compute. Когда я исправил, приложение работало как в Windows, так и в Android.
Сначала я устранил важное узкое место, используя матрицу TAlphoColor и скопировав ее в растровое изображение, когда все вычисления были выполнены. Это сэкономило от 5/8 до 3 раз скорости перерисовки растрового изображения, в зависимости от количества итераций (64 и 4096). Чем больше итераций, чем больше вычислений, тем меньше вероятность возникновения узкого места, что хорошо отражено на рисунках. Другое предложение состояло в том, чтобы использовать WaitFor. Это дало возможность удалить критическую секцию, а вместе с ней и узкое место. Поскольку обновление Finished_Tasks было единственным оставшимся оператором, я не смог найти его в результатах синхронизации. Однако код был значительно улучшен.
LU RD упомянул AlphaColorToScanline. Поскольку я добился отличных результатов со ScanLine во времена VCL, я ожидал увидеть отличные результаты. Не так сейчас. Я не смог обнаружить разницы между использованием Scanline, кроме шума. Однако хуже то, что в Android красный и синий байты меняются местами. В Windows они отображаются корректно.
Я опубликовал код ниже, чтобы вы могли проверить сами. Ниже приведены некоторые результаты синхронизации (Windows = Core i7-920, 4 ядра, каждое с гиперпотоком, 2,67 ГГц; Android = ARMv7, 1 ГГц, 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 -
См. вычисление в TPallelMandelbrot ниже. Отметьте оператор EndScene в конце, который добавляется. Виндовс это не очень волнует, а вот Андроиду все равно. Теперь я создаю потоки без приостановки, мне больше не нужно их запускать. Улучшения едва заметны.
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, но не удалось найти это единственная ссылка, которую я нашел). Это объясняет, почему работа с промежуточной матрицей колонок — такая хорошая идея!
Спасибо всем за ваши предложения!
