¿Cómo realizar un bucle paralelo en Delphi?

Question

Cómo realizar bucles paralelos en Delphi (Delphi 200X, Delphi XE)? ¿Cómo hacer esto de la mejor manera? ¿Y hay alguna solución universal?

Con ejemplos, por favor.

Answer 1

Probablemente la mejor solución en este momento es la construcción Parallel For Loop en OmniThreadLibrary. Le pasa una colección o un par de enteros que representan los límites inferior y superior, y un método anónimo que representa el cuerpo del bucle, y utiliza un grupo de subprocesos para ejecutar el bucle for en paralelo.

Tenga en cuenta que esto solo funcionará si el método del cuerpo del bucle es capaz de funcionar por sí mismo. Si modifica cualquier variable externa o se basa en el valor de un cálculo realizado anteriormente en el ciclo, entonces no puede ser paralelizado.

Puede encontrar una introducción al paralelo de OmniThreadLibrary here. Por ejemplo, un simple para la iteración del bucle sobre los números se parece a esto:

Parallel.ForEach(1, testSize).Execute(
    procedure (const elem: integer) 
    begin 
    // do something with 'elem' 
    end); 

Answer 2

Depende de lo que quiere decir con bucle paralelo y la aplicación/implementación.

Eche un vistazo a TThread y TMultiReadExclusiveWriteSynchronizer.

Answer 3

Si sólo necesita ParallelFor puede utilizar este código:

interface 

uses 
    Classes, SysUtils; 

type 
    TParallelProc = reference to procedure(i: Integer; ThreadID: Integer); 

    TParallel = class(TThread) 
    private 
    FProc: TParallelProc; 
    FThreadID: Integer; //current thread ID 
    protected 
    procedure Execute; override; 
    function GetNextValue: Integer; 
    public 
    constructor Create; 
    destructor Destroy; override; 

    property Proc: TParallelProc 
     read FProc write FProc; 
    class var 
     CurrPos: Integer; //current loop index 
     MaxPos: Integer; //max loops index 
     cs: TCriticalSection; 
     ThCount: Integer; //thread counter - how much threads have finished execution 
    end; 


{** ParallelFor Loop - all iterations will be performed in chosen threads 
@param nMin - Loop min value (first iteration) 
@param nMax - Loop max value (last iteration) 
@param nThreads - how much threads to use 
@param aProc - anonymous procedure which will be performed in loop thread 
} 
procedure ParallelFor(nMin, nMax, nThreads: Integer; aProc: TParallelProc); overload; 
{** ParallelFor Loop - all iterations will be performed in max cpu cores 
@param nMin - Loop min value (first iteration) 
@param nMax - Loop max value (last iteration) 
@param aProc - anonymous procedure which will be performed in loop thread 
} 
procedure ParallelFor(nMin, nMax: Integer; aProc: TParallelProc); overload; 

implementation 

uses 
    {$IFDEF MSWINDOWS} 
    Windows, 
    {$ENDIF} 
    SyncObjs; 

procedure ParallelFor(nMin, nMax, nThreads: Integer; aProc: TParallelProc); 
var 
    threads: array of TParallel; 
    I: Integer; 
begin 
    if nMin > nMax then 
    Exit; 
    // initialize TParallel class data 
    TParallel.CurrPos := nMin; 
    TParallel.MaxPos := nMax; 
    TParallel.cs := TCriticalSection.Create; 
    TParallel.ThCount := 0; 

    // create the threads 
    SetLength (threads, nThreads); 
    for I := 0 to nThreads - 1 do 
    begin 
    threads[I] := TParallel.Create; // suspended 
    threads[I].FThreadID := I; 
    threads[I].Proc := aProc; 
    threads[I].Start; 
    end; 

    for I := 0 to nThreads - 1 do 
    begin 
    threads[I].WaitFor; 
    end; 

    for I := 0 to nThreads - 1 do 
    begin 
    threads[I].Free; 
    end; 

    TParallel.cs.Free; 
end; 

procedure ParallelFor(nMin, nMax: Integer; aProc: TParallelProc); 
begin 
    ParallelFor(nMin, nMax, CPUCount, aProc); 
end; 

{ TParallel } 

constructor TParallel.Create; 
begin 
    inherited Create(True); // suspended 
    InterlockedIncrement(ThCount); 
    FreeOnTerminate := False; 
    FThreadID := 0; 
end; 

destructor TParallel.Destroy; 
begin 
    InterlockedDecrement(ThCount); 
    inherited; 
end; 

procedure TParallel.Execute; 
var 
    nCurrent: Integer; 
begin 
    nCurrent := GetNextValue; 
    while nCurrent <= MaxPos do 
    begin 
    Proc(nCurrent, FThreadID); 
    nCurrent := GetNextValue; 
    end; 
end; 

function TParallel.GetNextValue: Integer; 
begin 
    cs.Acquire; 
    try 
    Result := CurrPos; 
    Inc(CurrPos); 
    finally 
    cs.Release; 
    end; 
end; 

Sin embargo, si necesita más enhebrado "cosas" que debería considerar usar bibliotecas de terceros.