program sort; var f,f1,f2 : text; n1,n2 : integer; fragsize : integer; k : integer; function filesize(var f: text) : integer; var size : integer; begin reset(f); size := 0; while not eof(f) do begin readln(f); inc(size) end; filesize := size end; { filesize } procedure two(n : integer); begin reset(f); rewrite(f1); rewrite(f2); while not eof(f) do begin for k := 1 to n do if (not eof(f)) then begin readln(f,n1); writeln(f1,n1) end; for k := 1 to n do if (not eof(f)) then begin readln(f,n2); writeln(f2,n2) end end; close(f1); close(f2) end; { two } procedure one(n : integer); begin reset(f1); reset(f2); rewrite(f); readln(f1,n1); readln(f2,n2); while (not eof(f1)) and (not eof(f2)) do begin for k := 1 to n do begin if (n1 > n2) then begin writeln(f,n2); writeln('##',n2); readln(f2,n2) end; if (n1 < n2) then begin writeln(f,n1); writeln('##',n1); readln(f1,n1) end; if (n1 = n2) then begin writeln(f,n1); writeln(f,n2); readln(f1,n1); readln(f2,n2) end; end end; if (not eof(f1)) then while not eof(f1) do begin readln(f1,n1); writeln(f,n1); writeln('##',n1) end; if (not eof(f2)) then while not eof(f2) do begin readln(f2,n2); writeln(f,n2); writeln('##',n2) end; close(f) end; { one } begin assign(f,'f.txt'); assign(f1,'f1.txt'); assign(f2,'f2.txt'); fragsize := 1; while (fragsize <= filesize(f)) do begin writeln('Длина фрагмента ',fragsize); writeln('Делим'); two(fragsize); writeln('Сливаем'); one(fragsize); fragsize := fragsize*2 end; writeln('Конец'); end.