Základy práce se soubory
Řazení souboru
 Tisk

Řazení souboru


Používají se metody vnitřního a vnějšího řazení. Vnitřní řazení využívá přímý přístup k jednotlivým komponentám řazeného souboru. Metody vnějšího řazení převážně užívají mnohonásobné sekvenční procházení a kopírování souborů.


Jednotlivé záznamy/řádky se seřadí podle zadaných klíčů. Klíče představují jednu (jednoduchý klíč řazení) nebo několik částí (složený klíč řazení) komponenty souboru. Klíčem může být například číslo zaměstnance, číslo materiálu. Složeným klíčem může být např. řazení výdejek ze skladu podle závodu, v rámci závodu podle provozu a v rámci provozu podle nákladového střediska.


Řazení je jednou ze základních metod klasického zpracování souborů.


Problematika řazení přesahuje rozsah tohoto kursu. Obvykle se používají standardní řadící programy s různou rychlostí zpracování a nároky na paměť.


Výhradně pro informaci je uveden příklad na vnější řazení metodou tří pásek. Znalost tohoto příkladu nebude v rámci tohoto kursu vyžadována .



program tapesort;

{**

* Projekt: PPVS        Autor: Doc. Kopecek      Datum:19.4.2002

*

* Funkce: razeni metodou tri pasek / varianta pro casti klice

**}

type

    row=string;

    relace = (rovno, vetsi, mensi);

    usek = record

                 odkud:integer;

                 kolik:integer;

           end;

var

    sled :boolean;

    fin,fout,fs,fs1,fs2:text;

    ntice:longint;

    ss,prazdna:string;

    useky: array[1..5] of usek;


procedure init;

var

    i:integer;

begin

    sled := false;

    prazdna := chr(13)+chr(10);

    for i:= 1 to 255 do prazdna := chr(0)+prazdna;

end;


procedure parametry;

var

   i,j,k,p:integer;

begin

for i := 1 to 5 do begin

     useky[i].odkud := 0;

     useky[i].kolik := 0;

end;

useky[1].odkud := 1;

useky[1].kolik := 255;

j := 1;

for i := 3 to paramcount do begin

    ss := paramstr(i);

    if ss[1] = '.' then sled := true else

    if (ss[1] = '/') and (ss[2] >= '0') and (ss[2] < '9') then begin

       p := 0;

       while (length(ss) > 1) and

             (ss[2] >= '0') and (ss[2] < '9') do begin

                    p := p*10 + ord(ss[2]) - ord('0');

                    delete(ss,1,1);

       end;

       useky[j].odkud := p;

       useky[j].kolik := 255;

       if ss[2] = ':' then begin

          delete(ss,1,1);

          k:=0;

          while (length(ss) > 1) and

             (ss[2] >= '0') and (ss[2] < '9') do begin

                    k := k*10 + ord(ss[2]) - ord('0');

                    delete(ss,1,1);

          end;

          useky[j].kolik := k;

       end;

       if j < 5 then inc(j);

    end;

end;

writeln;

if sled then

for i := 1 to 5 do begin

     writeln('useky[',i,'].odkud = ',useky[i].odkud);

     writeln('useky[',i,'].kolik = ',useky[i].kolik);

end;

end;


function porov(s,r:string):relace;

var

   i,j,k:integer;

begin

i := 0;

for j := 1 to 5 do if (useky[j].odkud <> 0) and (i < 300) then begin

     i:= useky[j].odkud;

     k:= useky[j].odkud + useky[j].kolik - 1;

     if k > 255 then k := 255;

     while (i <= k) and (s[i]<>chr(13)) and (r[i]<>chr(13)) do begin

           if s[i] < r[i] then begin porov := mensi; i := 300;end else

           if s[i] > r[i] then begin porov := vetsi; i := 301;end;

           inc(i);

     end;

end;

if i < 255 then porov := rovno;

end;


function sluc(var a,b,c:text; var ntice:longint): boolean;

var

    rb,rc,oldb, oldc: row;

    pb,pc, pocet: longint;

    brb, brc    : boolean;

begin

rewrite(a);

reset (b);

reset(c);

pocet := 1;

brb := true;

brc := true;

if eof(b) then brb := false else readln(b,rb);

if eof(c) then brc := false else readln(c,rc);

repeat

      pb := 1; pc := 1;

      oldb := prazdna; oldc := prazdna;

      while brb and (pb <= ntice) and not (porov( rb,oldb) = mensi) and

            brc and (pc <= ntice) and not (porov( rc,oldc) = mensi) do

               if (porov(rb,rc) = mensi) then begin

                    writeln(a,rb); inc(pocet);

                    oldb := rb;

                    inc(pb);

                    if eof(b) then brb := false else readln(b,rb);

               end

               else begin

                    writeln(a,rc); inc(pocet);

                    oldc := rc;

                    inc(pc);

                    if eof(c) then brc := false else readln(c,rc);

               end;

      while brb and (pb <= ntice) and not (porov( rb,oldb) = mensi) do begin

                    writeln(a,rb); inc(pocet);

                    oldb := rb;

                    inc(pb);

                    if eof(b) then brb := false else readln(b,rb);

      end;

      while brc and (pc <= ntice) and not (porov( rc,oldc) = mensi) do begin

                    writeln(a,rc); inc(pocet);

                    oldc := rc;

                    inc(pc);

                    if eof(c) then brc := false else readln(c,rc);

      end;

until not brb and not brc;

ntice := ntice * 2;

sluc := ntice > pocet;

if sled then write(' ntice = ',ntice);

close(a);

close(b);

close(c);

end;


procedure rozdel(var co,k1,k2:text; ntice:longint);

var

     j:        longint;

     olda,rco: row;

     w,br:     boolean;

begin

     reset(co);

     rewrite(k1);

     rewrite(k2);

     br := true;

     if eof(co) then br := false else readln(co,rco);

     w:= false;

     repeat

          olda := prazdna;

          j    := 1; w:= not w;

          while br and (j<=ntice) and not (porov( rco,olda) = mensi) do begin

               if w then writeln(k1,rco) else writeln(k2,rco);

               olda := rco;

               if eof(co) then br := false else readln(co,rco);

               inc(j);

          end;

      until not br;

      close(co);

      close(k1);

      close(k2);

end;


begin

if (paramcount = 0) then begin

     writeln('Program na razeni souboru');

     writeln('=========================');

     writeln('Obsluha: tapesort co kam [{/pozice:kolik}] [.]');

     writeln('         co     ... vstup: trideny sousor');

     writeln('         kam    ... vystup: setrideny vysledek');

     writeln('max.5*   pozice ... nepovinny parametr, zacatek casti klice');

     writeln('         kolik ... nepovinny parametr, delky casti klice');

     writeln('         .      ... sledovani cinosti');

     halt;

end;

init;

parametry;

Assign(fin, ParamStr(1));

Assign(fout,ParamStr(2));

{$i-}

Erase(fout);

{$i+}

if ioresult = 0 then;

Assign(fs,'tapesort.$$s');

Assign(fs1,'tapesort.$s1');

Assign(fs2,'tapesort.$s2');

{$i-}

reset (fin);

{$i+}

if (ioresult <> 0) then begin

     writeln('Vstupni soubor ',paramstr(1),' neexistuje');

     halt;

end;

ntice := 1;

repeat

       if ntice = 1 then

          rozdel(fin,fs1,fs2,ntice)

       else

          rozdel(fs,fs1,fs2,ntice);

until sluc(fs,fs1,fs2,ntice);

erase(fs1);

erase(fs2);

{$i-}

Rename(fs,ParamStr(2));

{$i+}

if (ioresult <> 0) then begin

     writeln('Vystupni soubor ',paramstr(1),' nelze vytvorit');

     halt;

end;

end.