{-----------------------------------------------------------------------------}
Program Use_of_QSort;
{ Se citeste o lista de Nume, Prenume si Medii (real) dintr-un fisier
  Apoi, folosind algoritmul de sortare rapida QSort (varianta optimizata
  din punctul de vedere al memoriei), se sorteaza aceasta lista in ordinea 
  crescatoare a mediilor si se salveaza rezultatul in alt fisier
}
uses crt;
const
     lenNume = 20;
     lenRand = 80;
     maxElev = 500;
     surs    = 'BAC.IN';
     dest    = 'BAC.OUT';

type  TElev = record
            Nume,
            Prenume: String[lenNume];
            Media:   Real;
      end;
      PElev = ^TElev;
      NElev = 0..maxElev-1;
      NRand = 0..lenRand;

var fisier: Text;
    lin:  String[lenRand];
    i, j: NElev;
    Elev: array[NElev] of PElev;

{-----------------------------------------------------------------------------}
Procedure Swap(var p1,p2: PElev);  {Interschimba continutul a doi pointeri}
var P: Pointer;
begin
   P:=p1;
   p1:=p2;
   p2:=P;
end;
{-----------------------------------------------------------------------------}
Function  Partition(B, E: NElev): NElev;
{Se ia ca reper ultimul element din lista si se compara cu el toata lista.
{Elementele care au .Media mai mare decs ultimul (decat V), sunt stocate la inceputul listei,
{iar indicatorul inceputului listei (B) se incrementeaza pentru a indica varful elementelor comparate}
var V: Real;
    i: NElev;
begin
     if E>B then begin
        V:=Elev[E]^.Media;   {V - valoarea reperului}
        for i:=B to E-1 do if Elev[i]^.Media>V then
          begin              {toate elementele mai mari ca reperul sunt plasate la inceputul listei}
             Swap(Elev[i], Elev[B]);
             inc(B);         {B indica ultimul element din lista care este mai mare ca reperul}
          end;
          Swap(Elev[E], Elev[B]); {amplasam elementul de reper in pozitia sa finala}
        Partition:=B;
     end;
end;
{-----------------------------------------------------------------------------}
Procedure QuickSort(beginL, endL: NElev);
var Left, Mid: NElev;
   {--------------------------------------------}
   Procedure QSort(Right: NElev);
   {Functia recursiva: are doar un singur argument pentru a folosi cat mai putina memorie}
   begin
     if Right>Left then begin           {Daca nu se compara cu sine acelasi element}
       Mid:=Partition(Left, Right);     {Elementul nr Mid este deja la locul sau}
       if Mid>Left then QSort(Mid-1);   {Aranjeaza toate elementele de la Left pana la Mid si amplaseaza Left pe Mid+1}
       inc(Left,1);
       QSort(Right);
     end;
     Left:=Right+1;
   end;
   {--------------------------------------------}
begin
   Left:=beginL;
   QSort(endL);
end;
{-----------------------------------------------------------------------------}
Function nrElevi: NElev;
var n: NElev;
begin
     n:=0;
     while (Elev[n] <> nil) do inc(n);
     nrElevi:=n;
end;
{-----------------------------------------------------------------------------}
Function nospace(nr:NRand):NRand;
{Nr. urmatorului caracter diferit de ' ' in lin, incepand cu caracterul nr, sau 0, daca nu exista}
begin
     repeat
         inc(nr);
     until (nr>length(lin))or(lin[nr]<>' ');
     if nr<=length(lin) then nospace:=nr
                        else nospace:=0;
end;
{-----------------------------------------------------------------------------}
Function getWord(var nr: NRand): String; {Intoarce cuvantul incepand cu caracterul nr+1 din lin}
var a: NRand;
    w: String;
begin
     w:='';                            {aici se va obtine cuvantul}
     a:=nospace(nr);                   {primul caracter diferit de ' ' de dupa lin[nr]}
     nr:=a-1;
     while (a<>0)and(a=nr+1) do begin  {Cat timp exista caractere diferite de spatiu si acestea sunt consecutive}
            w:=w+lin[a];
            nr:=a;                     {pentru a verifica consecutivitatea}
            a:=nospace(a);             {urmatorul caracter diferit de ' '}
     end;
     if a<>0 then nr:=a-1 else nr:=0;
     getWord:=w;
end;
{-----------------------------------------------------------------------------}
Function  linToElev(nr: NElev):Byte;
var a:    NRand;
    N, P: String[lenNume];
    M:    Real;
    Cod:  Integer;
    Med:  String;
begin
     linToElev:= 0; {Daca formatul linieie nu este corect, functia intoarce 0}
     M:=0;          {Daca campul pentru medie lipseste, media se considera 0}
     a:=0;
     N:=getWord(a);
     if a=0 then exit; {Daca nu exista cuvantul pentru Prenume sau nici pentru Nume, se iese din subprogram}
     P:=getWord(a);
     if a<>0 then begin
        Delete(lin,1,a);
        Val(lin,M,Cod);
        if Cod<>0 then exit;
     end;
     if Elev[nr] = nil then new(Elev[nr]);
     with Elev[nr]^ do begin
          Nume    := N;
          Prenume := P;
          Media   := M;
     end;
     linToElev:= 1;
end;
{-----------------------------------------------------------------------------}
Function  ReadFile:NElev;
begin
     Assign(fisier,surs);
     Reset(fisier);
     i := 0;
     while (not eof(fisier) and (i<maxElev)) do begin
            readln(fisier, lin);
            inc(i, linToElev(i));  {Daca a fost adaugat un Elev, se incrementeaza i}
     end;
     Close(fisier);
     ReadFile := i;
end;
{-----------------------------------------------------------------------------}
Function ElevToLin(nr: NElev):String;
begin
   lin:='';
   if (Elev[nr]<>nil) then
   with Elev[nr]^ do begin
      str(Media:4:2, lin);
      lin:=Nume+' '+Prenume+' '+lin;
   end;
   ElevToLin:=lin;
end;
{-----------------------------------------------------------------------------}
Function WriteFile:NElev;
begin
     Assign(fisier,dest);
     ReWrite(fisier);
     i:=0;
     while (Elev[i]<>nil) do begin
            writeln(fisier, ElevToLin(i));
            inc(i);
     end;
     Close(fisier);
     WriteFile:=i;
end;
{-----------------------------------------------------------------------------}
Procedure Show;
begin
     i:=0;
     while(Elev[i]<>nil) do begin
         writeln(ElevToLin(i));
         inc(i);
     end;
end;
{-----------------------------------------------------------------------------}
Begin
clrscr;

ReadFile;
QuickSort(0,nrElevi-1);
Show;
WriteFile;

readkey;
End.
{-----------------------------------------------------------------------------}