DUzun's Web
Programare, proiecte personale, divertisment

Sort Experience (Încearcă şi tu!) 

Bubble Sort

Quick Sort 

SortTest.pas

uses crt, QSort;
var a, b, c, d: TList;
    i: integer;

begin
  clrscr;
  randomize;

{Initializarea valorilor}
  for i := 0 to nr do a[i] := random(10000);
  for i := 0 to nr do b[i] := a[i];
  for i := 0 to nr do c[i] := a[i];
  for i := 0 to nr do d[i] := a[i];

{Testarea functiilor de sortare si afisarea rezultatelor}
  writeln(Sort1(a, 0, nr));
  writeln(Sort2(b, 0, nr));
  writeln(Sort3(c, 0, nr));
  writeln(Sort4(d, 0, nr));
  readkey;

  for i := 0 to nr do write(c[i]:5);
  readkey;

end.

QSort.pas

unit QSort;

interface

const nr  = 1000;
      rep = 1000;

type TElem  = longint;
     TList  = array[0..nr] of TElem;
     TTimer = longint;

(*------------------------------------------------------------*)
function sort1(var a: TList; left, right: integer): TTimer; {Sort}
function sort2(var a: TList; left, right: integer): TTimer; {QuickSort1}
function sort3(var a: TList; left, right: integer): TTimer; {QuickSort2}
function sort4(var a: TList; left, right: integer): TTimer; {QuickSort}

function start_timer: TTimer;
function stop_timer(tm: TTimer): TTimer;

procedure QuickSort(var m: TList; left, right: integer);
procedure QuickSort1(var m: TList; left, right: integer);
procedure QuickSort2(var m: TList; left, right: integer);
procedure Sort(var m: TList; left, right: integer);

(*------------------------------------------------------------*)
implementation
uses dos;

function sort1(var a: TList; left, right: integer): TTimer;
var t: TTimer;
    i: integer;
begin
  write('Sort: ');
  t := start_timer;
  for i := 1 to rep do begin
  sort(a, left, right);
  end;
  sort1 := stop_timer(t);
end;

function sort2(var a: TList; left, right: integer): TTimer;
var t: TTimer;
    i: integer;
begin
  write('QuickSort1: ');
  t := start_timer;
  for i := 1 to rep do begin
  QuickSort1(a, left, right);
  end;
  sort2 := stop_timer(t);
end;

function sort3(var a: TList; left, right: integer): TTimer;
var t: TTimer;
    i: integer;
begin
  write('QuickSort2: ');
  t := start_timer;
  for i := 1 to rep do begin
  QuickSort2(a, left, right);
  end;
  sort3 := stop_timer(t);
end;

function sort4(var a: TList; left, right: integer): TTimer;
var t: TTimer;
    i: integer;
begin
  write('QuickSort: ');
  t := start_timer;
  for i := 1 to rep do begin
  QuickSort(a, left, right);
  end;
  sort4 := stop_timer(t);
end;

(*------------------------------------------------------------*)
function start_timer: TTimer;
var h,m,s,ms: word;
begin
  gettime(h,m,s,ms);
  start_timer := ((h*60 + m)*60 + s)*100 + ms;
end;

function stop_timer(tm: TTimer): TTimer;
begin
  stop_timer := start_timer - tm;
end;

(*------------------------------------------------------------*)
procedure QuickSort(var m: TList; left, right: integer); { Cel mai eficient algoritm QuickSort dintre cele comparate }
var p, s: TElem;

  procedure sort(b, e: integer);
  var i, j: integer;
  begin
    i:=b;
    j:=e;
    p:=m[(b + e) div 2];
    repeat
      while m[i]<p do inc(i); {m[i] >= p}
      while p<m[j] do dec(j); {m[j] <= p}
      if i<=j then
      begin
        s:=m[i]; m[i]:=m[j]; m[j]:=s;
        inc(i); dec(j);
      end;
    until i>j;
    if b<j then sort(b,j);
    if i<e then sort(i,e);
  end;

begin
  sort(left, right);
end;

(*------------------------------------------------------------*)
procedure QuickSort1(var m: TList; left, right: integer);
var b: integer;

  function part(b,e: integer): integer;
  var i: integer;
  t: TElem;
  begin
    t := m[b];
    for i := b + 1 to e do if m[i] < t then
    begin
      m[b] := m[i];
      inc(b);
      m[i] := m[b];
    end;
    m[b] := t;
    part := b;
  end;

  procedure sort(e: integer);
  var p: integer;
  begin
    if b >= e then exit;
    p := part(b,e);
    sort(p-1); {sort(b, p - 1);}
    b := p + 1;
    sort(e);   {sort(p + 1, e);}
  end;

begin
  b := left;
  sort(right);
end;
(*------------------------------------------------------------*)
procedure QuickSort2(var m: TList; left, right: integer);
var t: TElem;
    i: integer;
  procedure sort(left, right: integer);
  var b: integer;
  begin
  if left >= right then exit;
  t := m[left];                 {Elementul de comparatie}
  b := left;                    {Pozitia elementului de comparatie}
  for i := left + 1 to right do {Pentru toate celelalte elemente}
  if m[i] < t then begin        { Daca m[i] este mai mic decat t, }
  m[b] := m[i];                 { atunci il plasam inaintea lui t, }
  inc(b);                       { iar pe t il deplasam cu o pozitie mai sus, }
  m[i] := m[b];                 { eliberand celula pentru t }
  end;
  m[b] := t;                    { Amplasam t in celula sa! }
  { Acum toate elementele inainte de m[b]=t sunt mai mici decat t
  si toate elementele de dupa m[b] sunt mai mari sau egale cu t,
  deci t se afla in pozitia sa.
  Ramane de sortate celelalte elemente. }
  sort(left, b - 1);
  sort(b + 1, right);
  end;

begin
  sort(left, right);
end;
(*------------------------------------------------------------*)
procedure Sort(var m: TList; left, right: integer);
var j, k: integer;
  p: TElem;
begin
  for j := left to right - 1 do
    for k := j + 1 to right do
      if m[j] > m[k] then begin
        p := m[j];
        m[j] := m[k];
        m[k] := p;
      end;
end;
(*------------------------------------------------------------*)

end.