Cod sursa(job #164349)

Utilizator h_istvanHevele Istvan h_istvan Data 23 martie 2008 23:32:32
Problema Sortare Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 3.46 kb
program sortare;
type tomb = array[1..5000] of word;
var f:text;
    n,a,b,c,e,l,j: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:word;
    ctrl:boolean;
begin
     ctrl:=false;
     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];
          if(j+o <> c) and not(ctrl) then
          begin
               v2^[j+o]:=i+3;
               ctrl:=true;
               inc(o);
          end else j:=j+1;
     end;
end;

procedure javit;
var cs:word;
begin
     if(a=b) and (b=c) then
     begin
          b:=1;
          while(b=a) do inc(b);
          c:=1;
          while(c=a) or (c=b) do inc(c);
     end else
     if(a=b) then
     begin
          b:=1;
          while(b=a) or (b=c) do inc(b);
     end else
     if(a=c) then
     begin
          c:=1;
          while(c=a) or (c=b) do inc(c);
     end else
     if(b=c) then
     begin
          cs:=a;
          a:=b;
          b:=cs;
          c:=1;
          while(c=a) or (c=b) do inc(c);
     end;
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(i>=3) then javit;
               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);
                    if(i>=3) then javit;
                    feltolt(a,b,c);
                    i:=i+2;
                    l:=2;
               end;
          end;
          cs:=v1;
          v1:=v2;
          v2:=cs;
          e:=e+1;
          {for j:=1 to i do
              if(v1^[j] = 0) then
              begin
                   writeln(i,' ',j);
                   readln;
              end;}
     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.