This repository has been archived on 2024-12-25. You can view files and clone it, but cannot push or open issues or pull requests.
2024-03-10 20:32:51 +03:00

96 lines
2.2 KiB
ObjectPascal
Raw Permalink Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

//Демонстрация использования параллельных секций на примере быстрой сортировки
var
a: array of integer;
var
b: array of integer;
// Partition - разделение A[l]..A[r] на части A[l]..A[q] <= A[q+1]..A[r]
function Partition(a: array of integer; l, r: integer): integer;
begin
var i := l - 1;
var j := r + 1;
var x := A[l];
while True do
begin
repeat
i += 1;
until A[i] >= x;
repeat
j -= 1;
until A[j] <= x;
if i < j then
Swap(A[i], A[j])
else
begin
Result := j;
exit;
end;
end;
end;
// Параллельная cортировка частей
procedure Sort(A: array of integer; l, r: integer);
begin
if l >= r then
exit;
var j := Partition(A, l, r);
{$omp parallel sections}
begin
Sort(A, l, j);
Sort(A, j + 1, r);
end;
end;
// Параллельная сортировка
procedure QuickSortParrallel(A: array of integer);
begin
Sort(A, 0, a.Length - 1)
end;
//Последовательная Сортировка частей
procedure SortSeq(a: array of integer; l, r: integer);
begin
if l >= r then
exit;
var j := Partition(A, l, r);
SortSeq(A, l, j);
SortSeq(A, j + 1, r);
end;
//Последовательная сортировка
procedure QuickSortSeq(A: array of integer);
begin
SortSeq(A, 0, a.Length - 1)
end;
//заполнение массивов равными значениями для обоих сортировок
procedure FillRandArr(A, B: array of integer);
begin
Randomize;
for var i := 0 to A.Length - 1 do
begin
a[i] := Random(1000);
b[i] := a[i];
end;
end;
//Вывод массива
procedure printArr(A: array of integer);
begin
Randomize;
for var i := 0 to A.Length - 1 do
writeln(a[i]);
end;
begin
SetLength(a, 10000000);
SetLength(b, 10000000);
FillRandArr(a, b);
var m1 := Milliseconds;
QuickSortSeq(B);
writeln('Последовательное выполнение: ', Milliseconds - m1, 'ms');
var m0 := Milliseconds;
QuickSortParrallel(a);
writeln('Параллельное выполнение: ', Milliseconds - m0, 'ms');
end.