Написать программу сортировки естественным слиянием — Pascal(Паскаль)

Program L10_9;
{sortirovka}
uses 
 crt;
var 
 g:text;
 s:string;
Procedure Sort(name: string; var f: text);
Var 
 s1,s2,a1,a2,where,tmp: integer;
 f1,f2: text;
Begin
 s1:=5;
 s2:=5;
 Assign(f,name);
 Assign(f1,'{as} ');
 Assign(f2,'{sasd} ');
 While (s1>1) and (s2>=1) do
 begin
  where:=1;
  s1:=0;
  s2:=0;
  Reset(f);
  Rewrite(f1);
  Rewrite(f2);
  Read(f,a1);
  Write(f1,a1,' ');
  While not EOF(f) do
   begin
    read(f,a2);
    If (a2<a1) then
    begin
     Case where of
      1: begin
          where:=2;
          inc(s1);
         End;
      2: begin
          where:=1;
          inc(s2);
         End;
    End;
   End;
    Case where of
     1: write(f1,a2,' ');
     2: write(f2,a2,' ');
 End;
 a1:=a2;
End;
 If where=2 then 
  inc(s2)
 else
  inc(s1);
 Close(f);
 Close(f1);
 Close(f2);
 Rewrite(f);
 Reset(f1);
 Reset(f2);
 Read(f1,a1);
 Read(f2,a2);
 While (not EOF(f1)) and (not EOF(f2)) do
 begin
  If (a1<=a2) then
  begin
   Write(f,a1,' ');
   Read(f1,a1);
  End
   else
  begin
   Write(f,a2,' ');
   Read(f2,a2);
  End;
 End;
  While not EOF(f1) do
 begin
  tmp:=a1;
  Read(f1,a1);
  If not EOF(f1) then 
   Write(f,tmp,' ')
  else
   Write(f,tmp);
 End;
  While not EOF(f2) do
  begin
   tmp:=a2;
   Read(f2,a2);
   If not EOF(f2) then
    Write(f,tmp,' ')
   else 
    Write(f,tmp);
  End;
   Close(f);
   Close(f1);
   Close(f2);
 End;
 Erase(f1);
 Erase(f2);
End;
 
 
begin
 clrscr;
 write('name file: ');
 readln(s);
 s:=s+'.txt';
 Sort(s,g);
 write('fail otsortirovan');
 readkey
end.

Leave a Comment

7 + 3 =