Cod sursa(job #163611)

Utilizator h_istvanHevele Istvan h_istvan Data 22 martie 2008 14:49:12
Problema Sortare Scor 10
Compilator fpc Status done
Runda preONI 2008, Runda Finala, Clasa a 10-a Marime 2.65 kb
program sortare;
type tomb = array[1..5000] of word;
var f:text;
    n,a,b,c,e,l:word;
    i:word;
    v1,v2,cs:^tomb;

procedure feltolte(a,b:word);
var j:word;
begin
     v2^[a]:=i+1;
     for j:=1 to i do
         if(j < a) then v2^[j]:=v1^[j]
         else           v2^[j+1]:=v1^[j];
end;

procedure feltolt(a,b,c:word);
var j,o:word;
begin
     v2^[a]:=i+1;
     v2^[b]:=i+2;
     j:=1;o:=0;
     while(j<=i) do
     begin
          while (j+o=a) or (j+o=b) do inc(o);
          v2^[j+o]:=v1^[j];
          j:=j+1;
     end;
end;

procedure feltolt3(a,b,c:word);
var j,o:longint;
begin
     v2^[a]:=i+1;
     v2^[b]:=i+2;
     v2^[c]:=i;
     j:=1;o:=0;
     while(j<=i) do
     begin
          while(j+o=a) or (j+o=b) or (j+o=c) do inc(o);
          if(v1^[j] <> i) then
          begin
               v2^[j+o]:=v1^[j];
          end else o:=o-1;
          j:=j+1;
     end;
     while(j+o=a) or (j+o=b) or (j+o=c) do inc(o);
     v2^[j+o]:=i+3;
end;

begin
     new(v1);
     new(v2);
     assign(f,'sortare.in');
     reset(f);
     readln(f,n);
     i:=1;e:=1;
     v1^[1]:=1;
     while(i<n) do
     begin
          readln(f,a,b,c);
          if(a=b) then
          begin
               feltolte(a,c);
               i:=i+1;
               l:=1;
          end else
          if(b=c) then
          begin
               feltolte(c,a);
               i:=i+1;
               l:=1;
          end else
          if(a=c) then
          begin
               feltolte(c,b);
               i:=i+1;
               l:=1;
          end else
          begin
               if(eof(f)) then
               begin
                    cs:=v1;
                    v1:=v2;
                    v2:=cs;
                    e:=e-1;
                    if(l=2) then
                    begin
                         i:=i-2;
                         feltolt3(a,b,c);
                         i:=i+3;
                    end else
                    if(l=1) then
                    begin
                         i:=i-1;
                         feltolt(a,b,c);
                         i:=i+2;
                    end;
               end else
               begin
                    readln(f,a,b,c);
                    feltolt(a,b,c);
                    i:=i+2;
                    l:=2;
               end;
          end;
          cs:=v1;
          v1:=v2;
          v2:=cs;
          e:=e+1;
     end;
     close(f);

     assign(f,'sortare.out');
     rewrite(f);
     writeln(f,e);
     write(f,v1^[1]);
     for i:=2 to n do
         write(f,' ',v1^[i]);
     writeln(f);
     close(f);
end.