La utilización de la programación paralela puede incrementar drásticamente la velocidad de ejecución de nuestros programas, por ejemplo imaginar el caso en que tengamos dos tareas A y B, una se ejecuta en 5 segundos y otra en 10 segundos entonces:
- Si las ejecutamos secuencialmente, como se hace habitualmente, tardaríamos en terminarlas 15 segundos
- Si utilizamos WaitForAll tardaríamos 15
- Si utilizamos WaitForAny tardaríamos 5.
La Biblioteca de Programación Paralela (PPL) que incorpora Rad Studio Tokyo proporciona una clase TTask para ejecutar una o múltiples tareas en paralelo, y además añade unos métodos que se utilizan para sincronizar o para detener dichas tareas.
A continuación tenéis unos ejemplos de uso:
Utilizando un array de ITask.
procedure TFormThreading.MyButtonClick(Sender: TObject);
var
tasks: array of ITask;
value: Integer;
begin
Setlength (tasks ,2);
value := 0;
tasks[0] := TTask.Create (procedure ()
begin
sleep (3000); // 3 seconds
TInterlocked.Add (value, 3000);
end);
tasks[0].Start;
tasks[1] := TTask.Create (procedure ()
begin
sleep (5000); // 5 seconds
TInterlocked.Add (value, 5000);
end);
tasks[1].Start;
TTask.WaitForAll(tasks);
ShowMessage ('All done: ' + value.ToString);
end;
Iniciar una tarea en background que no bloquea al programa principal:
procedure TFormThreading.Button1Click(Sender: TObject);
var
aTask: ITask;
begin
// not a thread safe snippet
aTask := TTask.Create (procedure ()
begin
sleep (3000); // 3 seconds
ShowMessage ('Hello');
end);
aTask.Start;
end;
Hay que tener cuidado con los interbloqueos asociados con las variables que se utilicen (se debe utilizar los métodos tInterlocked de la unit System.SyncObjs).
TInterlocked implementa operaciones con el propósito de asegurar que el “thread” o el “multi-core” sea seguro y estable cuando se modifican variables que pueden ser accedidas durante la ejecución de múltiples threads.
Ejemplo de utilización de tInterlocked.
var iCount: Integer;
begin
iCount := 0;
TParallel.&For(1, 10,
procedure (Current: Integer)
begin
TInterlocked.Add(iCount, Current);
end
);
end;
Ejemplo de utilización de tInterlocked para hacer una suma utilizando variables globales:
Se utilizan varios procedimientos:
TInterlocked.Exchange(iSum, 0); copia el valor “0” a la variable iSum
TInterlocked.Add(iSum, Index); suma el valor Index a la variable iSum y lo devuelve en iSum
TInterlocked.Read(iSum); Lee el valor de la variable iSum
Como véis no es obligatorio que tInterlocked se sitúe siempre dentro del bloque tTask.Run
VAR
iSum:integer;
procedure TFormMain.button1(Sender: TObject);
begin
//calcula iSum:=0;
TInterlocked.Exchange(iSum, 0);
TTask.Run(
procedure
begin
TParallel.For(0, 10,
procedure (Index: Integer)
begin
//calcula iSum := iSum + Index;
TInterlocked.Add(iSum, Index);
end);
end);
end;
//lee cada segundo la variable global iSum en un tTimer
procedure TFormMain.Timer1Timer(Sender: TObject);
begin
LabelSum.Text:= TInterlocked.Read(iSum);
end;
BUCLES FOR
La PPL proporciona una función tParallel.For que permite realizar bucles For en paralelo. Equivalencia entre un “for” secuencial y un “for” en paralelo.
EJEMPLO: BUCLE FOR SIMPLE (NO BLOQUEANTE) utilizando tThread.queue,
Internamente se espera a que la CPU esté en estado Idle).
procedure TFormMain.ButtonStartParallelForClick(Sender: TObject);
begin
Memo1.Lines.Clear;
TTask.Run(
procedure
begin
TParallel.For(0, 9,
procedure (Index: Integer)
begin
Sleep(200);
TThread.Queue(TThread.CurrentThread,
procedure
begin
Memo1.Lines.Add(Index.ToString);
end);
end);
end);
end;
Ejemplo. Cálculo de los números primos menores o iguales a 5000000
uses
System.Threading;
System.Diagnostics;
System.SyncObjs;
const
Max =5000000;
procedure TForm1.btnForLoopClick(Sender: TObject);
var
I, Tot: Integer;
SW: TStopwatch;
begin
// counts the prime numbers below a given value
Tot:=0;
SW := TStopWatch.Create;
SW.Start;
for I := 1 to Max do
begin
if IsPrime(I) then
Inc(Tot);
end;
SW.Stop;
Memo1.Lines.Add(Format('Sequential For loop. Time (in milliseconds): %d - Primes found: %d', [SW.ElapsedMilliseconds,Tot]));
end;
procedure TForm1.btnParallelForClick(Sender: TObject);
var
Tot: Integer;
SW: TStopwatch;
begin
try
// counts the prime numbers below a given value
Tot :=0;
SW :=TStopWatch.Create;
SW.Start;
//el primer parámetro “2” del bucle FOR es opcional e identifica cómo
//se agrupan los threads al ser ejecutados
TParallel.For(2,1,Max,procedure(I:Int64)
begin
if IsPrime(I) then
TInterlocked.Increment(Tot);
end);
SW.Stop;
Memo1.Lines.Add(Format('Parallel For loop. Time (in milliseconds): %d - Primes found: %d', [SW.ElapsedMilliseconds,Tot]));
except on E:EAggregateException do
ShowMessage(E.ToString);
end;
end;
function IsPrime(N: Integer): Boolean;
var
Test, k: Integer;
begin
if N <= 3 then
IsPrime := N > 1
else if ((N mod 2) = 0) or ((N mod 3) = 0) then
IsPrime := False
else
begin
IsPrime := True;
k := Trunc(Sqrt(N));
Test := 5;
while Test <= k do
begin
if ((N mod Test) = 0) or ((N mod (Test + 2)) = 0) then
begin
IsPrime := False;
break; { jump out of the for loop }
end;
Test := Test + 6;
end;
end;
end;
El resultado muestra que el bucle en paralelo for es mucho más eficiente que el secuencial;
Ejemplo de descarga de una página web utilizando ttask:
procedure TMyForm.StartDownloadTask(lPath: string)
begin
TTask.Create(
procedure
var
lHTTP: TIdHTTP;
IdSSL: TIdSSLIOHandlerSocketOpenSSL;
begin
lHTTP := TIdHTTP.Create(nil);
TThread.Synchronize(nil,
procedure
begin
Form1.Caption := 'Task Running...';
end
);
try
lHTTP.ReadTimeout := 30000;
lHTTP.HandleRedirects := True;
IdSSL := TIdSSLIOHandlerSocketOpenSSL.Create(lHTTP);
IdSSL.SSLOptions.Method := sslvTLSv1;
IdSSL.SSLOptions.Mode := sslmClient;
lHTTP.IOHandler := IdSSL;
Finally
try
lHTTP.Get('http://website.com/'+lPath, TStream(nil));
Finally
lHTTP.Free;
end;
end;
TThread.Synchronize(nil,
procedure
begin
Memo1.Lines.Add(lPath);
end
);
end
).Start;
end;
Ejemplo que utiliza TParallel.for para detener la ejecución de todos los threads cuando se encuentra una respuesta.
Utiliza TParallel.LoopState para avisar a otros procesos que utilizan el loop paralelo. Utilizando la señal “Stop” todas las iteraciones se detienen. Las iteraciones en curso deberían chequear loopState.Stopped.
procedure Parallel3(CS: TCriticalSection);
var
Ticks: Cardinal;
i,ix: Integer; // variables that are only touched once in the Parallel.For loop
begin
i := 0;
Ticks := TThread.GetTickCount;
TParallel.For(1,WorkerCount,
procedure(index:Integer; loopState: TParallel.TLoopState)
var
k,l,m: Integer;
begin
// Do something complex
k := (1000 - index)*1000;
for l := 0 to Pred(k) do
m := k div 1000;
// If criteria to stop fulfilled:
CS.Enter;
Try
if loopState.Stopped then // A solution was already found
Exit;
loopState.Stop; // Signal
Inc(i);
ix := index;
Finally
CS.Leave;
End;
end
);
Ticks := TThread.GetTickCount - Ticks;
WriteLn('Parallel time ' + Ticks.ToString + ' ticks', ' i :',i,' index:',ix);
end;
EJEMPLO: Utilización de Ttask para dibujar rectángulos, utilizando o no tSyncronize
// Author: Danny Wind
// http://dannywind.nl/wp-content/uploads/2015/10/CodeRageX_DelphiParallelProgrammingDeepDive_DannyWind.zip
procedure TFormMain.ButtonStartParallelForClick(Sender: TObject);
var
lStride, lFrom, lTo: Integer;
begin
ClearRectangles;
lFrom := Low(FRectangles);
lTo := High(FRectangles);
lStride := Trunc(NumberBoxStride.Value);
{TTask.Run executes the entire parallel for loop itself in parallel,
which enables you to actually see the progress of the for-loop}
TTask.Run(procedure
begin
TParallel.For(lStride, lFrom, lTo, PaintRectangle)
end);
end;
procedure TFormMain.PaintRectangle(Index: Integer);
var
lR,lG,lB: Byte;
lColor:TAlphaColor;
begin
lR := TThread.CurrentThread.ThreadID MOD High(Byte);
lG := (2 * lR) MOD High(Byte);
lB := (4 * lR) MOD High(Byte);
lColor := MakeColor(lR, lG, lB, High(Byte));
if CheckBoxSync.IsChecked then
TThread.Synchronize(TThread.CurrentThread,
procedure
begin
FRectangles[Index].Fill.Color := lColor;
TLabel(FRectangles[Index].TagObject).Text := Index.ToString;
FRectangles[Index].TagString := TimeToStr(Now);
FRectangles[Index].Repaint;
end)
else
begin
FRectangles[Index].Fill.Color := lColor;
TLabel(FRectangles[Index].TagObject).Text := Index.ToString;
FRectangles[Index].TagString := TimeToStr(Now);
FRectangles[Index].Repaint;
end;
Sleep(100);
end;
Para el cálculo de tiempo que tarda la ejecución de procedimientos os recomiendo utilizar la clase tStopWatch de la unit system.Diagnostics, de esta forma:
Var
Sw:tStopWatch;
begin
SW := TStopWatch.Create;
SW.Start;
for I := 1 to Max do
begin
…
end;
SW.Stop;
showmessage(Format('Tiempo empleado (en milisegundos): %d', [SW.ElapsedMilliseconds]));
end;
Excelente
ResponderEliminar