program fox_sort; { (c)2003 Fox++ & Rulezz technologiez http://kiiut.fatal.ru mailto:kurepin@sura.ru } uses crt,dos; const wait='��� �������...'; afile='f0.bin'; type table=record name : string[20]; kol : integer; time : real; end; type item=record key:integer; end; tfile=file of item; var b : array [1..100] of table; z : item; {�����} i,j,xx: longint; {������ ���ᨢ�} num : integer; sel : char; {�롮� �㭪� ����} hour1,hour2,min1,min2,sec1,sec2,ms1,ms2 : word; time1,time2 : real; {��砫쭮� � ����筮� �६� �����} procedure menu; forward; procedure filegen; {������� ������� 䠩���} var f0:tfile; z:item; i:integer; begin writeln ('������� 䠩��'); assign (f0,afile); write ('# of tfile: '); readln (num); rewrite (f0); randomize; i:=0; while i<=num do begin z.key:=random(32000); write (f0,z); inc(i); end; close (f0); writeln ('�������� ��砩�� 䠩� �� ',num,' ������⮢.'); readkey; end; procedure print; var f0:tfile; begin assign (f0,afile); reset (f0); while not eof(f0) do begin read(f0,z); write (z.key:5,' '); end; readkey; clrscr; end; procedure result; begin clrscr; writeln (#07,'�������� �����'); writeln; writeln ('����� ����� : ',xx); writeln ('������ : ',b[xx].name); writeln ('�� ������⮢ : ',b[xx].kol); writeln ('�६� : ',b[xx].time:2:3,' �'); readkey; end; procedure prost; var X,Y:array[1..100] of integer; Z:array[1..200] of integer; dx,dy,ix,iy,iz,i,j,G,N:integer; begin clrscr; write('������ ����� ���ᨢ� Y '); readln(dy); writeln('������ 㯮�冷祭� �� �����⠭�� ���ᨢ Y'); for i:=1 to dy do read(Y[i]); write('������ ����� ���ᨢ� X '); readln(dx); writeln('������ 㯮�冷祭� �� �����⠭�� ���ᨢ X'); randomize; for i:=1 to dx do read(X[i]); iy:=1; ix:=1; iz:=0; writeln ('����� ���⮣� ﭨ�'); inc(xx); b[xx].name:='���⮥ ﭨ�'; b[xx].kol:=dx+dy; gettime (hour1,min1,sec1,ms1); while(ix<=dx) and (iy<=dy) do if X[ix]<Y[iy] then begin inc(iz); Z[iz]:=X[ix]; inc(ix); end else begin inc(iz); Z[iz]:=Y[iy]; inc(iy); end; if ix>dx then for i:=iy to dy do begin inc(iz); Z[iz]:=Y[i]; end else for i:=ix to dx do begin inc(iz); Z[iz]:=X[i]; end; gettime (hour2,min2,sec2,ms2); writeln ('�����襭�� ���⮣� ﭨ�'); time1:=min1*60+sec1+ms1/100; time2:=min2*60+sec2+ms2/100; b[xx].time:=time2-time1; result; writeln('����祭� ���ᨢ Z '); for i:=1 to iz do write(Z[i],' '); readkey; end; procedure extl; var f0:TFile; procedure merge(k:integer;var f1,f2,g1,g2:TFile); var outSwitch:boolean; Winner:integer; Used:array[1..2] of integer; Fin:array[1..2]of boolean; current:array[1..2]of Item; procedure GetItem(i:integer); begin if(Used[i]=k)or((i=1)and eof(f1))or((i=2)and eof(f2)) then Fin[i]:=True else if i=1 then read(f1,Current[1]) else read(f2,Current[2]); Used[i]:=Used[i]+1; end; begin OutSwitch:=true; rewrite(g1);rewrite(g2); reset(f1);reset(f2); while (not eof(f1)) or (not eof(f2)) do begin Used[1]:=0;Used[2]:=0; Fin[1]:=false;Fin[2]:=false; GetItem(1);GetItem(2); while (not Fin[1])or(not Fin[2]) do begin if Fin[1] then Winner :=2 else if Fin[2] then Winner:=1 else if Current[1].key<Current[2].key then Winner:=1 else Winner:=2; if OutSwitch then write(g1,Current[Winner]) else write(g2,Current[Winner]); GetItem(Winner); end; OutSwitch:=not OutSwitch; end; close(g1);close(g2); close(f1);close(f2); end; procedure MergeSort(var f0:TFile); var f1,f2,g1,g2:TFile; i,n,k:integer;buf:Item; flag:boolean; begin Assign(f1,'c:\F1Merge.itm'); Assign(f2,'c:\F2Merge.itm'); Assign(g1,'c:\G1Merge.itm'); Assign(g2,'c:\G2Merge.itm'); rewrite(f1);rewrite(f2); rewrite(g1);rewrite(g2); reset(f0); n:=0; while not eof(f0) do begin read(f0,buf); write(f1,buf); inc(n); if not eof(f0) then begin read(f0,buf); write(f2,buf); inc(n); end; end; flag:=true;k:=1; Close(f1);Close(f2);Close(f0); n:=trunc(ln(n)/ln(2))+1; for i:=1 to n do begin if flag then merge(k,f1,f2,g1,g2) else merge(k,g1,g2,f1,f2); flag:= not flag; k:=k*2; end; rewrite(f0);reset(g1);reset(f1); if not flag then while not eof(g1) do begin read(g1,buf); write(f0,buf); end else while not eof(f1) do begin read(f1,buf); write(f0,buf); end; Close(f0);Close(g1);Close(f1); {erase(f1);erase(g1);erase(f2);erase(g2);} end; begin clrscr; assign(f0,afile); filegen; clrscr; writeln ('����� ����⢥����� ﭨ�'); inc(xx); b[xx].name:='����⢥���� ﭨ�'; b[xx].kol:=num; gettime (hour1,min1,sec1,ms1); MergeSort(f0); gettime (hour2,min2,sec2,ms2); writeln ('�����襭�� ����⢥����� ﭨ�'); time1:=min1*60+sec1+ms1/100; time2:=min2*60+sec2+ms2/100; b[xx].time:=time2-time1; b[xx].kol:=num; result; end; procedure nextl; const max=10000; maxint=32767; type Item=record key:integer; end; TFile=file of Item; var f0:TFile; procedure NMerge(k:integer;var f1,f2,f3,f4,g1,g2,g3,g4:TFile); var outSwitch:1..4; Winner:integer; Used:array[1..4] of integer; Fin:array[1..4]of boolean; Current:array[1..4]of Item; Tree:array[1..7]of Item; History:array[1..7]of integer; procedure CompareTree; begin if Tree[7].key<Tree[6].key then begin Tree[3]:=Tree[7]; History[3]:=History[7]; end else begin Tree[3]:=Tree[6]; History[3]:=History[6]; end; if Tree[5].key<Tree[4].key then begin Tree[2]:=Tree[5]; History[2]:=History[5]; end else begin Tree[2]:=Tree[4]; History[2]:=History[4]; end; if Tree[3].key<Tree[2].key then begin Tree[1]:=Tree[3]; History[1]:=History[3]; end else begin Tree[1]:=Tree[2]; History[1]:=History[2]; end; end; procedure NGetItem(i:integer); begin if(Used[i]=k)or((i=1)and eof(f1))or((i=2)and eof(f2))or((i=3)and eof(f3))or((i=4)and eof(f4)) then begin Fin[i]:=True; Tree[8-i].key:=MaxInt; end else begin case i of 1:read(f1,Current[1]); 2:read(f2,Current[2]); 3:read(f3,Current[3]); 4:read(f4,Current[4]); end; Tree[8-i]:=Current[i]; Used[i]:=Used[i]+1; end; CompareTree; end; procedure MakeTree; var q:integer; begin if not eof(f1) then begin read(f1,Tree[7]); History[7]:=1; Current[1]:=Tree[7]; end; if not eof(f2) then begin read(f2,Tree[6]); History[6]:=2; Current[2]:=Tree[6]; end; if not eof(f3) then begin read(f3,Tree[5]); History[5]:=3; Current[3]:=Tree[5]; end; if not eof(f4) then begin read(f4,Tree[4]); History[4]:=4; Current[4]:=Tree[4]; end; CompareTree; end; begin OutSwitch:=1; rewrite(g1);rewrite(g2); rewrite(g3);rewrite(g4); reset(f1);reset(f2); reset(f3);reset(f4); while (not eof(f1)) or (not eof(f2))or (not eof(f3))or (not eof(f4)) do begin Used[1]:=1;Used[2]:=1;Used[3]:=1;Used[4]:=1; Fin[1]:=false;Fin[2]:=false;Fin[3]:=false;Fin[4]:=false; MakeTree; while Tree[1].key<MaxInt do begin Winner:=History[1]; case OutSwitch of 1:write(g1,Current[Winner]); 2:write(g2,Current[Winner]); 3:write(g3,Current[Winner]); 4:write(g4,Current[Winner]); end; NGetItem(Winner); end; if OutSwitch=4 then OutSwitch:=1 else inc(OutSwitch); end; Close(g1);Close(g2); Close(f1);Close(f2); Close(g3);Close(g4); Close(f3);Close(f4); end; procedure NMergeSort(var f0:TFile); var f1,f2,f3,f4,g1,g2,g3,g4:TFile; i,n,k:integer;buf:Item; flag:boolean; begin assign(f1,'c:\F1Merge.itm'); assign(f2,'c:\F2Merge.itm'); assign(f3,'c:\F3Merge.itm'); assign(f4,'c:\F4Merge.itm'); assign(g1,'c:\G1Merge.itm'); assign(g2,'c:\G2Merge.itm'); assign(g3,'c:\G3Merge.itm'); assign(g4,'c:\G4Merge.itm'); rewrite(f1);rewrite(f2); rewrite(f3);rewrite(f4); rewrite(g1);rewrite(g2); rewrite(g3);rewrite(g4); reset(f0); n:=0; while not eof(f0) do begin read(f0,buf); write(f1,buf); inc(n); if not eof(f0) then begin read(f0,buf); write(f2,buf); inc(n); end; if not eof(f0) then begin read(f0,buf); write(f3,buf); inc(n); end; if not eof(f0) then begin read(f0,buf); write(f4,buf); inc(n); end; end; flag:=true;k:=1; Close(f1);Close(f2);Close(f0); Close(f3);Close(f4); n:=trunc(ln(n)/ln(4))+1; for i:=1 to n do begin if flag then NMerge(k,f1,f2,f3,f4,g1,g2,g3,g4) else NMerge(k,g1,g2,g3,g4,f1,f2,f3,f4); flag:= not flag; k:=k*4; end; rewrite(f0);reset(g1);reset(f1); if not flag then while not eof(g1) do begin read(g1,buf); write(f0,buf); end else while not eof(f1) do begin read(f1,buf); write(f0,buf); end; Close(f0);Close(g1);Close(f1); erase(f1);erase(g1);erase(f2);erase(g2); erase(f3);erase(g3);erase(f4);erase(g4); end; begin clrscr; filegen; clrscr; inc(xx); b[xx].name:='�������⥢�� ﭨ�'; b[xx].kol:=num; gettime (hour1,min1,sec1,ms1); assign(f0,afile); writeln ('����� �������⥢��� ﭨ�'); gettime (hour1,min1,sec1,ms1); NMergeSort(f0); gettime (hour2,min2,sec2,ms2); writeln ('�����襭�� �������⥢��� ﭨ�'); time1:=min1*60+sec1+ms1/100; time2:=min2*60+sec2+ms2/100; b[xx].time:=time2-time1; result; end; procedure rating; begin clrscr; writeln ('���⨭� १���⮢'); writeln; writeln ('���������������������������������������������������ͻ'); writeln ('� �������� � ����� � ����� �'); writeln ('���������������������������������������������������'); for i:=1 to xx do begin writeln ('� ',b[i].name:30,' � ',b[i].kol:6,' � ',b[i].time:2:3,' �'); end; writeln ('���������������������������������������������������ͼ'); readkey; end; procedure menu; begin textcolor(2); clrscr; writeln; writeln; writeln; writeln (' *** ������� ���������� ***'); writeln (' *** Fox++ Rulezz technologiez ***'); writeln; textcolor(11); writeln (' 1: ���⮥ ﭨ�'); writeln (' 2: ����⢥���� ﭨ�'); writeln (' 3: �������⥢�� ﭨ�'); writeln (' 4: ������ १���⮢'); writeln (' 5: �뢮� ���ᨢ� �� ��࠭'); writeln (' 6: ��室'); sel:=readkey; case sel of '1':prost; '2':extl; '3':nextl; '4':rating; '5':print; '6':exit; end; menu; end; BEGIN menu; END.