Sortowanie bąbelkowe w dwóch wątkach. SIGSEGV w wątkach.

0

Jak chcesz poczekac na zakonczenie watku to uzywaj waitfor

0

@mca64 a nawet nie tyle wiesza się ile wyskakuje coś takiego
screen.png

0

To wprowadz sobie do watku jakas zmienna i ja porownuj zamiast terminated

0

Chyba za bardzo skupiasz się na wątkach a za mało na algorytmie.
Przy drugim kroku pętli zewnętrznej zmienia się zakres elementów w pętli wewnętrznej.

http://pl.wikipedia.org/wiki/Sortowanie_b%C4%85belkowe

0

takie cos powinno wyjsc?
user image

z WaitFor dla watkow jest dwa razy szybciej - 77 ms

0

Mniej więcej. Możesz wytłumaczyć jak to zrobiłeś, że u Ciebie działa? Co ja mam źle?

0

Wg mnie ten kod obecnie nie ma sensu. Caly czas wykonania pojdzie na sprawy z tworzeniem watkow itp. Chyba w sumie 18 ich bedzie. Jak zwiekszysz probke to te sorotwanie watkowe bedzie szybsze niz babelkowe.

program sortuj;
 
{==============================================================================}


 
{==============================================================================}
{$APPTYPE CONSOLE}
uses
  Classes,
  SysUtils,
  MultiThreadSort,
  BSort, Windows;

{==============================================================================}
 
const
  Zakres = 20;
 
{==============================================================================}
 
var
  czestoliwosc, start, stop : int64;
  Time   : array[0..1] of Double;
  Matrix : array[0..9] of TIntegerArray;
  i,j    : Word;
 
{==============================================================================}
 
procedure Sort(var AMatrix : TIntegerArray);
var
  Sort    : array[0..1] of TSort;
  Matrix  : array[0..1] of TIntegerArray;
  Highest : Integer;
  i, j, k : Word;
begin
  Highest := Low(Integer);
  for i := Low(AMatrix) to High(AMatrix) do
    if AMatrix[i] > Highest then
      Highest := AMatrix[i];
 
  for i := 0 to 1 do
    SetLength(Matrix[i], 0);
 
  j := 0;
  k := 0;
  for i := Low(AMatrix) to High(AMatrix) do
    if AMatrix[i] < Highest div 2 then
    begin
      SetLength(Matrix[0], Length(Matrix[0]) + 1);
      Matrix[0,j] := AMatrix[i];
      Inc(j);
    end
    else
    begin
      SetLength(Matrix[1], Length(Matrix[1]) + 1);
      Matrix[1,k] := AMatrix[i];
      Inc(k);
    end;
 
  for i := 0 to 1 do
    Sort[i] := TSort.Create(Matrix[i]);

   Sort[0].WaitFor;
   Sort[1].WaitFor;
  {for i := 0 to 1 do
    while not Sort[i].yo do//Sort[i].Terminated do
      sleep(1);}
 
  for i := 0 to 1 do
    FreeAndNil(Sort[i]);
 
  k := 0;
  for i := 0 to 1 do
    for j := Low(Matrix[i]) to High(Matrix[i]) do
    begin
      AMatrix[k] := Matrix[i,j];
      Inc(k);
    end;
end;
 
{==============================================================================}
 
begin
  Randomize;
 
  for i := 0 to 9 do
  begin
    SetLength(Matrix[i],Zakres);
    Write('Losowanie ', i, ' tablicy...');
    for j := 0 to Zakres - 1 do
      Matrix[i,j] := Random(100) - 50;
    Writeln('Wylosowana');
  end;
 
  Writeln;
  QueryPerformanceFrequency(czestoliwosc);
  QueryPerformanceCounter(start);
  for i := 0 to 9 do
  begin
    Write('Sortowanie ', i, ' tablicy...');
    BubbleSort(Matrix[i],@V1LargerV2);
    Writeln('Posortowana');
  end;
   QueryPerformanceCounter(stop);
   Time[0] := (stop - start) * 1000 / czestoliwosc;
 
  Writeln;
  for i := 0 to 9 do
  begin
    Write('Losowanie ',i,' tablicy...');
    for j := 0 to Zakres do
      Matrix[i,j] := Random(100) - 50;
    Writeln('Wylosowana');
  end;
 
  Writeln;
  QueryPerformanceFrequency(czestoliwosc);
  QueryPerformanceCounter(start);
  for i := 0 to 9 do
  begin
    Write('Sortowanie dwuwatkowe ', i, ' tablicy...');
    Sort(Matrix[i]);
    Writeln('Posortowana');
  end;
   QueryPerformanceCounter(stop);
   Time[1] := (stop - start) * 1000 / czestoliwosc;
 
  Writeln;
  Writeln('Sortowanie bąbelkowe : ',FloatToStr(Time[0]) + ' [ms]');
  Writeln('Sortowanie dwuwatkowe: ',FloatToStr(Time[1]) + '[ms]');
  Readln;
end.
0

jesli to jest na zaliczenie to mozesz troche oszukac :P zmierz tylko czas co sie dzieje w Execute. Sumujesz tych 9 wartosci a na koncu porownasz ktory z dwoch watkow ma wieksza wartosc. Wyswietlisz czas dluzszego watku i masz czas twojego sortowania a ze czas twojego programu bedzie troszke dluzszy to juz inna sprawa, moze nie zauwazy :P

0

@mca64

Zaraz mnie szlag jasny trafi i krew ciemna zaleje

Mój kod:

program sortuj;

{==============================================================================}

{$mode objfpc}{$H+}

{==============================================================================}

uses
  {$IFDEF UNIX}{$IFDEF UseCThreads}
  cthreads,
  {$ENDIF}{$ENDIF}
  Classes, SysUtils, MultiThreadSort, BSort, Crt;

{==============================================================================}

const
  Zakres = 20;

{==============================================================================}

var
  Start  : Double;
  Stop   : Double;
  Time   : array[0..1] of Double;
  Matrix : array[0..9] of TIntegerArray;
  i,j    : Word;

{==============================================================================}

procedure Sort(var AMatrix : TIntegerArray);
var
  SortThread : array[0..1] of TSortThread;
  Matrix     : array[0..1] of TIntegerArray;
  Highest    : Integer;
  i, j, k    : Word;
begin
  // Znalezienie największej liczby w tablicy.
  Highest := Low(Integer);
  for i := Low(AMatrix) to High(AMatrix) do
    if AMatrix[i] > Highest then
      Highest := AMatrix[i];

  // Zerowanie tablic pomocniczych.
  for i := 0 to 1 do
    SetLength(Matrix[i], 0);

  // Podział tablicy do sortowania na dwie tablice:
  // - pierwsza od najniższej do połowy najwyższej liczby.
  // - druga od połowy najwyższej do najwyższej liczby.
  j := 0;
  k := 0;
  for i := Low(AMatrix) to High(AMatrix) do
    if AMatrix[i] < Highest div 2 then
    begin
      SetLength(Matrix[0], Length(Matrix[0]) + 1);
      Matrix[0,j] := AMatrix[i];
      Inc(j);
    end
    else
    begin
      SetLength(Matrix[1], Length(Matrix[1]) + 1);
      Matrix[1,k] := AMatrix[i];
      Inc(k);
    end;

  //Tworzenie i start wątków sortujacych.
  for i := 0 to 1 do
    SortThread[i] := TSortThread.Create(Matrix[i]);

  // Oczekiwanie na zakończenie watków sortujących.
  //for i := 0 to 1 do
  //  SortThread[i].WaitFor;
  //  while not SortThread[i].Terminated do
  //    sleep(2);

  SortThread[0].WaitFor;
  SortThread[1].WaitFor;

  // Zwalnianie watków sortujacych.
  for i := 0 to 1 do
    FreeAndNil(SortThread[i]);

  // Łączenie tablic pomocniczych w jedną.
  k := 0;
  for i := 0 to 1 do
    for j := Low(Matrix[i]) to High(Matrix[i]) do
    begin
      AMatrix[k] := Matrix[i,j];
      Inc(k);
    end;
end;

{==============================================================================}

begin
  Randomize;
  ClrScr;

  for i := 0 to 9 do
  begin
    SetLength(Matrix[i],Zakres);
    Write('Losowanie ', i, ' tablicy...');
    for j := 0 to Zakres - 1 do
      Matrix[i,j] := Random(100) - 50;
    Writeln('Wylosowana');
  end;

  Writeln;
  Start := TimeStampToMsecs(DateTimeToTimeStamp(Now));
  for i := 0 to 9 do
  begin
    Write('Sortowanie ', i, ' tablicy...');
    BubbleSort(Matrix[i],@V1LargerV2);
    Writeln('Posortowana');
  end;
  Stop := TimeStampToMsecs(DateTimeToTimeStamp(Now));
  Time[0] := Stop - Start;

  Writeln;
  for i := 0 to 9 do
  begin
    Write('Losowanie ',i,' tablicy...');
    for j := 0 to Zakres do
      Matrix[i,j] := Random(100) - 50;
    Writeln('Wylosowana');
  end;

  Writeln;
  Start := TimeStampToMsecs(DateTimeToTimeStamp(Now));
  for i := 0 to 9 do
  begin
    Write('Sortowanie dwuwatkowe ', i, ' tablicy...');
    Sort(Matrix[i]);
    Writeln('Posortowana');
  end;
  Stop := TimeStampToMsecs(DateTimeToTimeStamp(Now));
  Time[1] := Stop - Start;

  Writeln;
  Writeln('Sortowanie bąbelkowe : ',Time[0]);
  Writeln('Sortowanie dwuwatkowe: ',Time[1]);
  Readln;
end.

Identyczny z twoim i u mnie nie działa :/

screen.png

Mam obok drugi komputer, zaraz zainstaluje tam lazarusa i sprawdzę czy to czasem nie wina mojego kompa czy innej nie związanej z kodem rzeczy.

0

to jesli chcesz sie nauczyc czegos wiecej to powinies to zrobic uzywajac tylko dwoch dodatkowych watkow. Ten przyklad w lazarusie moze byc pomocny https://github.com/alrieckert/lazarus/blob/master/examples/multithreading/waitforunit1.pas

0

Ok to mamy błąd FPC. Żywcem przekopiowałem projekt z Lazarusa do Delphi 7 i normalnie się skompilował i działa. Gdzie można takie cudo zgłosić?

-- edit --

A przy okazji przy tablicy mającej 5000 elementów czas sortowania spadł prawie o połowę. Myślę, że jak rozdzielę to na 4 wątki (albo nawet 8 myśląc o procesorach 8 rdzeniowych) czas spadnie znacznie :)

-- edit 2 --

Zapytałem się na stackoverflow i tam znaleźli błąd. Kompilator jako taki działa dobrze. Błąd jest w unicie CRT. Wyrzucenie go z sekcji uses rozwiązało problem.

2

Po niecałym roku załączam rozwiązanie problemu :)

Unit BSort

unit BSort;

{==============================================================================}

{$mode objfpc}{$H+}

{==============================================================================}

interface

{==============================================================================}

uses
  Classes, SysUtils;

{==============================================================================}

type
  TcompFunc = function(AValue1, AValue2 : Integer) : boolean;
  TIntegerArray = array of integer;
  PIntegerArray = ^TIntegerArray;

{==============================================================================}

procedure BubbleSort(var AMatrix : TIntegerArray; ACompFunc : TCompFunc);
function V1LargerV2(AValue1, AValue2 : Integer) : Boolean;

{==============================================================================}

implementation

{==============================================================================}

procedure Swap(var AValue1, AValue2 : Integer);
var
  Tmp : Integer;
begin
  Tmp := AValue1;
  AValue1 := AValue2;
  AValue2 := Tmp;
end;

{==============================================================================}

function V1LargerV2(AValue1, AValue2 : Integer) : Boolean;
begin
  result := AValue1 > AValue2;
end;

{------------------------------------------------------------------------------}

procedure BubbleSort(var AMatrix : TIntegerArray; ACompFunc : TCompFunc);
var
  i,j : Cardinal;
begin
  for i := Low(AMatrix) to High(AMatrix) - 1 do
    for j := Low(AMatrix) to High(AMatrix) - 1 do
    begin
      if ACompFunc(AMatrix[j], AMatrix[j+1]) then
        Swap(AMatrix[j], AMatrix[j+1]);
    end;
end;

{==============================================================================}

end.

Unit MultiThreadSort

unit MultiThreadSort;

{==============================================================================}

{$mode objfpc}{$H+}

{==============================================================================}

interface

{==============================================================================}

uses
  Classes, SysUtils, BSort;

{==============================================================================}

type
  TSortThread = class(TThread)
      FMatrix   : PIntegerArray;
      FCompFunc : TCompFunc;
    protected
      procedure Execute; override;
    public
      constructor Create(var AMatrix : TIntegerArray; ACompFunc : TCompFunc);
    public
      property Terminated;
  end;

{==============================================================================}

procedure Sort(var AMatrix : TIntegerArray; ACompFunc : TCompFunc);

{==============================================================================}

implementation

{==============================================================================}

constructor TSortThread.Create(var AMatrix : TIntegerArray; ACompFunc : TCompFunc);
begin
  inherited Create(False);
  FreeOnTerminate := False;
  FMatrix := @AMatrix;
  FCompFunc := ACompFunc;
end;

{------------------------------------------------------------------------------}

procedure TSortThread.Execute;
begin
  BubbleSort(FMatrix^, FCompFunc);
end;

{==============================================================================}

procedure Sort(var AMatrix : TIntegerArray; ACompFunc : TCompFunc);
var
  SortThread  : array[0..3] of TSortThread;
  Matrix      : array[0..3] of TIntegerArray;
  Lowest,
  Highest     : Integer;
  Limit       : array[0..2] of Integer;
  i, k, l     : Cardinal;
  j           : array[0..3] of Cardinal;
  EmptyMatrix : Boolean;
begin
  // Znalezienie największej i najmniejszej liczby w tablicy.
  Lowest := High(Integer);
  Highest := Low(Integer);
  for i := Low(AMatrix) to High(AMatrix) do
  begin
    if AMatrix[i] > Highest then
      Highest := AMatrix[i];
    if AMatrix[i] < Lowest then
      Lowest := AMatrix[i];
  end;

  // Zerowanie tablic pomocniczych.
  for i := 0 to 3 do
    SetLength(Matrix[i], 0);

  // Wyznaczanie granic
  Limit[1] := (Lowest + Highest) div 2;
  Limit[0] := (Lowest + Limit[1]) div 2;
  Limit[2] := (Limit[1] + Highest) div 2;

  // Podział tablicy do sortowania na cztery tablice:
  // - pierwsza od najmniejszej liczby do pierwszej granicy.
  // - druga od pierwszej granicy do drugiej granicy.
  // - trzecia od drugiej granicy do trzeciej granicy.
  // - czwarta od trzeciej granicy do największej liczby.
  for i := 0 to 3 do
    j[i] := 0;
  for i := Low(AMatrix) to High(AMatrix) do
    if AMatrix[i] < Limit[0] then
    begin
      SetLength(Matrix[0], Length(Matrix[0]) + 1);
      Matrix[0,j[0]] := AMatrix[i];
      Inc(j[0]);
    end
    else if (AMatrix[i] >= Limit[0]) and (AMatrix[i] < Limit[1]) then
    begin
      SetLength(Matrix[1], Length(Matrix[1]) + 1);
      Matrix[1,j[1]] := AMatrix[i];
      Inc(j[1]);
    end
    else if (AMatrix[i] >= Limit[1]) and (AMatrix[i] < Limit[2]) then
    begin
      SetLength(Matrix[2], Length(Matrix[2]) + 1);
      Matrix[2,j[2]] := AMatrix[i];
      Inc(j[2]);
    end
    else if (AMatrix[i] >= Limit[2]) then
    begin
      SetLength(Matrix[3], Length(Matrix[3]) + 1);
      Matrix[3,j[3]] := AMatrix[i];
      Inc(j[3]);
    end;

  // Sprawdzenie czy tablice pomocnicze mają co najmnej dwa elementy.
  EmptyMatrix := false;
  for i := 0 to 3 do
  begin
    if Length(Matrix[i]) < 2 then
      EmptyMatrix := true;
  end;

  if EmptyMatrix then
  begin
    BubbleSort(AMatrix, ACompFunc);
  end
  else
  begin
    //Tworzenie i start wątków sortujacych.
    for i := 0 to 3 do
      SortThread[i] := TSortThread.Create(Matrix[i], ACompFunc);

    // Oczekiwanie na zakończenie wątków sortujących.
    for i := 0 to 3 do
      SortThread[i].WaitFor;

    // Zwalnianie wątków sortujacych.
    for i := 0 to 3 do
      FreeAndNil(SortThread[i]);

    // Łączenie tablic pomocniczych w jedną.
    k := 0;
    for i := 0 to 3 do
      for l := Low(Matrix[i]) to High(Matrix[i]) do
      begin
        AMatrix[k] := Matrix[i,l];
        Inc(k);
      end;
  end;
end;

{==============================================================================}

end.

Program testowy

program sortuj;

{==============================================================================}

{$mode objfpc}{$H+}

//{$DEFINE LOWESTPC}
//{$DEFINE LOWPC}
//{$DEFINE MIDPC}
{$DEFINE HIGHPC}
//{$DEFINE HIGHESTPC}
//{$DEFINE SAVE_TO_FILE}

{==============================================================================}

uses
  {$IFDEF UNIX}{$IFDEF UseCThreads}
  cthreads,
  {$ENDIF}{$ENDIF}
  Classes, SysUtils, MultiThreadSort, BSort;

{==============================================================================}

const
  {$IFDEF LOWESTPC}
  Zakres : array[0..4] of Cardinal = (2, 4, 8, 16, 32);
  {$ENDIF}
  {$IFDEF LOWPC}
  Zakres : array[0..4] of Cardinal = (80, 160, 320, 640, 1280);
  {$ENDIF}
  {$IFDEF MIDPC}
  Zakres : array[0..4] of Cardinal = (800, 1600, 3200, 6400, 12800);
  {$ENDIF}
  {$IFDEF HIGHPC}
  Zakres : array[0..4] of Cardinal = (8000, 16000, 32000, 64000, 128000);
  {$ENDIF}
  {$IFDEF HIGHESTPC}
  Zakres : array[0..4] of Cardinal = (20000, 40000, 80000, 160000, 320000);
  {$ENDIF}

{==============================================================================}

var
  Start  : Double;
  Stop   : Double;
  Time   : array[0..4] of Double;
  Matrix : array[0..4] of TIntegerArray;
  i, j   : Cardinal;
  {$IFDEF SAVE_TO_FILE}
  DumpFile : Text;
  {$ENDIF}

{==============================================================================}

begin
  Randomize;

  for i := 0 to 4 do
    SetLength(Matrix[i], Zakres[i]);
  {$IFDEF SAVE_TO_FILE}
  AssignFile(DumpFile, 'Info.txt');
  Rewrite(DumpFile);
  {$ENDIF}

  Write('Losowanie tablic...');
  Start := TimeStampToMsecs(DateTimeToTimeStamp(Now));
  for i := 0 to 4 do
  begin
    for j := 0 to Length(Matrix[i]) - 1 do
      Matrix[i,j] := Random(500) - 250;
  end;
  Stop := TimeStampToMsecs(DateTimeToTimeStamp(Now));
  Writeln('Wylosowane. Czas losowania: ', ((Stop - Start) / 1000):4:3, ' sec');
  Writeln;

  {$IFDEF SAVE_TO_FILE}
  Writeln(DumpFile, 'TABLICE NIESORTOWANE:');
  for i := 0 to 4 do
  begin
    Writeln(DumpFile, '  Tablica ' + IntToStr(i) + ': Długość: ' + IntToStr(Length(Matrix[i])));
    for j := 0 to Length(Matrix[i]) - 1 do
      Write(DumpFile, '  ' + IntToStr(Matrix[i,j]) + ' ');
    Writeln(DumpFile);
  end;
  Writeln(DumpFile);
  {$ENDIF}


  Writeln('Sortowanie tablic w jednym watku');
  for i := 0 to 4 do
  begin
    Start := TimeStampToMsecs(DateTimeToTimeStamp(Now));
    BubbleSort(Matrix[i], @V1LargerV2);
    Stop := TimeStampToMsecs(DateTimeToTimeStamp(Now));
    Time[i] := ((Stop - Start) / 1000);
    Writeln('Tablica ', Zakres[i], ' elementow: ', Time[i]:4:3, ' sec');
  end;
  Writeln;

  {$IFDEF SAVE_TO_FILE}
  Writeln(DumpFile, 'TABLICE POSORTOWANE W JEDNYM WĄTKU:');
  for i := 0 to 4 do
  begin
    Writeln(DumpFile, '  Tablica ' + IntToStr(i) + ': Długość: ' + IntToStr(Length(Matrix[i])) + ' Czas sortowania: ' + FloatToStr(Time[i]));
    for j := 0 to Length(Matrix[i]) - 1 do
      Write(DumpFile, '  ' + IntToStr(Matrix[i,j]) + ' ');
    Writeln(DumpFile);
  end;
  Writeln(DumpFile);
  {$ENDIF}

  Write('Losowanie tablic...');
  Start := TimeStampToMsecs(DateTimeToTimeStamp(Now));
  for i := 0 to 4 do
  begin
    for j := 0 to Length(Matrix[i]) - 1 do
    Matrix[i,j] := Random(500) - 250;
  end;
  Stop := TimeStampToMsecs(DateTimeToTimeStamp(Now));
  Writeln('Wylosowane. Czas losowania: ', ((Stop - Start) / 1000):4:3, ' sec');
  Writeln;

  {$IFDEF SAVE_TO_FILE}
  Writeln(DumpFile, 'TABLICE NIESORTOWANE:');
  for i := 0 to 4 do
  begin
    Writeln(DumpFile, '  Tablica ' + IntToStr(i) + ': Długość: ' + IntToStr(Length(Matrix[i])));
    for j := 0 to Length(Matrix[i]) - 1 do
      Write(DumpFile, '  ' + IntToStr(Matrix[i,j]) + ' ');
    Writeln(DumpFile);
  end;
  Writeln(DumpFile);
  {$ENDIF}

  Writeln('Sortowanie tablic w czterech watkach');
  for i := 0 to 4 do
  begin
    Start := TimeStampToMsecs(DateTimeToTimeStamp(Now));
    Sort(Matrix[i], @V1LargerV2);
    Stop := TimeStampToMsecs(DateTimeToTimeStamp(Now));
    Time[i] := ((Stop - Start) / 1000);
    Writeln('Tablica ', Zakres[i], ' elementow: ', Time[i]:4:3, ' sec');
  end;

  {$IFDEF SAVE_TO_FILE}
  Writeln(DumpFile, 'TABLICE POSORTOWANE W CZTERECH WĄTKACH:');
  for i := 0 to 4 do
  begin
    Writeln(DumpFile, '  Tablica ' + IntToStr(i) + ': Długość: ' + IntToStr(Length(Matrix[i])) + ' Czas sortowania: ' + FloatToStr(Time[i]));
    for j := 0 to Length(Matrix[i]) - 1 do
      Write(DumpFile, '  ' + IntToStr(Matrix[i,j]) + ' ');
    Writeln(DumpFile);
  end;
  CloseFile(DumpFile);
  {$ENDIF}
  Writeln;
  Writeln('Zakonczono test');
  Readln;
end.

W załącznikach kod unitów do ściągnięcia, by się nie bawić w copypaste.

Problem rozwiązałem znacznie wcześniej ale teraz mi się przypomniało o tym temacie. Może komuś się przyda ;]

EDIT:

Oczywiście jest to przykład i do tego bardzo prosty. Działa tylko sortowanie rosnące. Niewiele zmieniając kod można dodać opcję zmiany algorytmu sortującego (na zasadzie jak jest używana funkcja porównująca).

1 użytkowników online, w tym zalogowanych: 0, gości: 1