algorytm.org

Implementacja w Delphi/Pascal



Baza Wiedzy
wersja offline serwisu przeznaczona na urządzenia z systemem Android
Darowizny
darowiznaWspomóż rozwój serwisu
Nagłówki RSS
Artykuły
Implementacje
Komentarze
Forum
Bookmarki






Sonda
Implementacji w jakim języku programowania poszukujesz?

Sortowanie przez łączenie naturalne - Implementacja w Delphi/Pascal
Ocena użytkownikóww: *****  / 1
SłabyŚwietny
Nadesłany przez Karol Kokoszka, 28 sierpnia 2005 01:00
Kod przedstawiony poniżej przedstawia główną część rozwiązania problemu.
Pobierz pełne rozwiązanie.

Jeżeli nie odpowiada Ci sposób formatowania kodu przez autora skorzystaj z pretty printer'a i dostosuj go automatycznie do siebie.

naturalSort.pas:
//sortowanie przez laczenie naturalne
//www.algorytm.org
//(c)2005 Karol Kokoszka

program naturalSort_;
type  tape = file of char;
var   T: array[0..2] of tape;

procedure divFile(var f1, f2, f3: tape);
  var  tmp1, tmp2: char;
       pointer: ^tape;
       blank: char;
  begin
     reset(f1);
     rewrite(f2); rewrite(f3);
     blank:=#0;
     tmp2:=#0;
     pointer:=@f2;
     while (not eof(f1)) do begin
        read(f1, tmp1);
        if tmp2>tmp1 then begin
           write(pointer^, blank);
           if pointer=@f2 then pointer:=@f3
           else pointer:=@f2;
        end;
        write(pointer^, tmp1);
        tmp2:=tmp1;
     end;
     write(pointer^, blank);
     close(f1);
     close(f2); close(f3);
  end;

procedure integrateBlocks(var f1, f2, f3: tape);
  var  tmp2, tmp3: char;
  begin
     if not eof(f2) then read(f2, tmp2) else tmp2:=#0;
     if not eof(f3) then read(f3, tmp3) else tmp3:=#0;
     while ((tmp2<>#0) and (tmp3<>#0)) do begin
        if tmp2<tmp3 then begin
           write(f1, tmp2);
           if not eof(f2) then read(f2, tmp2) else tmp2:=#0
        end else begin
           write(f1, tmp3);
           if not eof(f3) then read(f3, tmp3) else tmp3:=#0
        end;
     end;
     while (tmp3<>#0) do begin
        write(f1, tmp3);
        if not eof(f3) then read(f3, tmp3) else tmp3:=#0
     end;
     while (tmp2<>#0) do begin
        write(f1, tmp2);
        if not eof(f2) then read(f2, tmp2) else tmp2:=#0
     end;
  end;

function copy(var f1, f2, f3: tape): boolean;
  var j: byte;
  begin
     rewrite(f1);
     reset(f2); reset(f3);
     j:=0;
     while (not eof(f2)) or (not eof(f3)) do begin
        if j<2 then inc(j);
        integrateBlocks(f1, f2, f3);
     end;
     close(f1);
     close(f2); close(f3);
     if j<=1 then copy:=true else copy:=false;
  end;


begin
   assign(T[0], 'd:\file.txt');
   assign(T[1], 'd:\file.000');
   assign(T[2], 'd:\file.001');
   repeat
      divFile(T[0], T[1], T[2]);
   until copy(T[0], T[1], T[2]);
end.
Dodaj komentarz