program laby231;

type arr = record
i :integer;
a,b,c: string;
end;

var
  a1, a2, a3, a4: array[1..1000] of arr;
  f1, f2, f3, f4: text;
  f5, f6, f7, f8: text;
  n1, n2, n3, n4: integer;

procedure create_a(var f: text; temp:integer);
var s: string;
  n, i, k: integer;
begin
     reset(f);
     k := 1;
     if(temp = 1) then begin
       while(eof(f)= false)do begin
         Readln(f, s);
         n := length(s);
         a1[k].i := 0;
         i := 1;
         while(s[i] <> ' ') do begin
           a1[k].a += s[i];
           i+=1;
         end;
         i += 1;
         while(s[i] <> ' ') do begin
           a1[k].b += s[i];
           i+=1;
         end;
         i += 1;
         while(i <= n) do begin
           a1[k].c += s[i];
           i+=1;
         end;
         k +=1;
       end;
       n1 := k - 1;
     end
     else if(temp = 2) then begin
       while(eof(f)= false)do begin
         Readln(f, s);
         n := length(s);
         a2[k].i := 0;
         i := 1;
         while(s[i] <> ' ') do begin
           a2[k].a += s[i];
           i+=1;
         end;
         i += 1;
         while(s[i] <> ' ') do begin
           a2[k].b += s[i];
           i+=1;
         end;
         i += 1;
         while(i <= n) do begin
           a2[k].c += s[i];
           i+=1;
         end;
         k +=1;
       end;
       n2 := k - 1;
     end
     else if(temp = 3) then begin
       while(eof(f)= false)do begin
         Readln(f, s);
         n := length(s);
         a3[k].i :=0;
         i := 1;
         while(s[i] <> ' ') do begin
           a3[k].a += s[i];
           i+=1;
         end;
         i += 1;
         while(s[i] <> ' ') do begin
           a3[k].b += s[i];
           i+=1;
         end;
         i += 1;
         while(i <= n) do begin
           a3[k].c += s[i];
           i+=1;
         end;
         k +=1;
       end;
       n3 := k - 1;
     end
     else begin
       while(eof(f)= false)do begin
         Readln(f, s);
         n := length(s);
         a4[k].i := 0;
         i := 1;
         while(s[i] <> ' ') do begin
           a4[k].a += s[i];
           i+=1;
         end;
         i += 1;
         while(s[i] <> ' ') do begin
           a4[k].b += s[i];
           i+=1;
         end;
         i += 1;
         while(i <= n) do begin
           a4[k].c += s[i];
           i+=1;
         end;
         k +=1;
       end;
       n4 := k - 1;
     end;
     close(f);
end;

procedure sort(temp :integer);
var i, j, t, z:integer;
  s: string;
begin
    t := 1;
    if(temp = 1)then begin
      for i := 1 to n1 do begin
        j :=  1;
        while (a1[j].i <> 0) do begin
          j += 1;
        end;
        s := a1[j].a;
        z := j;
        for j := 1 to n1 do begin
          if( s > a1[j].a) and (a1[j].i = 0) then begin
            s := a1[j].a;
            z := j;
          end;
        end;
        a1[z].i := t;
        t+=1;
      end;
    end
    else if(temp = 2)then begin
      for i := 1 to n2 do begin
        j :=  1;
        while (a2[j].i <> 0) do begin
          j += 1;
        end;
        s := a2[j].a;
        z := j;
        for j := 1 to n2 do begin
          if( s > a2[j].a) and (a2[j].i = 0) then begin
            s := a2[j].a;
            z := j;
          end;
        end;
        a2[z].i := t;
        t+=1;
      end;
    end
    else if(temp = 3)then begin
      for i := 1 to n3 do begin
        j :=  1;
        while (a3[j].i <> 0) do begin
          j += 1;
        end;
        s := a3[j].a;
        z := j;
        for j := 1 to n3 do begin
          if( s > a3[j].a) and (a3[j].i = 0) then begin
            s := a3[j].a;
            z := j;
          end;
        end;
        a3[z].i := t;
        t+=1;
      end;
    end
    else begin
      for i := 1 to n4 do begin
        j :=  1;
        while (a4[j].i <> 0) do begin
          j += 1;
        end;
        s := a4[j].a;
        z := j;
        for j := 1 to n4 do begin
          if( s > a4[j].a) and (a4[j].i = 0) then begin
            s := a4[j].a;
            z := j;
          end;
        end;
        a4[z].i := t;
        t+=1;
      end;
    end
end;

procedure print(temp : integer);
var i : integer;
begin
    if(temp = 1) then begin
    assign(f5, 'file1.txt');
    rewrite(f5);
      for i := 1 to n1 do begin
        writeln(f5, a1[i].i, ' ', a1[i].a, ' ', a1[i].b, ' ', a1[i].c);
      end;
      close(f5);
    end
    else
    if(temp = 2) then begin
    assign(f6, 'file2.txt');
    rewrite(f6);
      for i := 1 to n2 do begin
        writeln(f6, a2[i].i, ' ', a2[i].a, ' ', a2[i].b, ' ', a2[i].c);
      end;
      close(f6);
    end
    else if(temp = 3) then begin
    assign(f7, 'file3.txt');
    rewrite(f7);
      for i := 1 to n3 do begin
        writeln(f7, a3[i].i, ' ', a3[i].a, ' ', a3[i].b, ' ', a3[i].c);
      end;
      close(f7);
    end
    else begin
    assign(f8, 'file4.txt');
    rewrite(f8);
      for i := 1 to n4 do begin
        writeln(f8, a4[i].i, ' ', a4[i].a, ' ', a4[i].b, ' ', a4[i].c);
      end;
      close(f8);
    end;
end;

begin
  assign(f1,'A1.txt');
  assign(f2,'A2.txt');
  assign(f3,'A3.txt');
  assign(f4,'A4.txt');
  create_a(f1, 1);
  create_a(f2, 2);
  create_a(f3, 3);
  create_a(f4, 4);
  sort(1); sort(2); sort(3); sort(4);
  print(1);print(2);print(3);print(4);
  readln();
end.