usaco 2.1 sort3 2008.5.20

usaco 2.1 sort3 2008.5.20

{

ID:

PROG: sort3

LANG: PASCAL

}

program p_sort3;

constmaxn=1000;fin='sort3.in';fout='sort3.out';

type

 arr1=array[1..maxn]of integer;

var

  a,g:arr1;n,i,j,sum:longint;

 p:array[1..3]of longint;

 e:array[1..3,1..2]of longint;

 f:array[1..maxn]of boolean;

 f1,f2:text;

procedure init;

  vari:longint;

 begin

   assign(f1,fin);reset(f1);

   assign(f2,fout);rewrite(f2);

   fillchar(p,sizeof(p),0);

   fillchar(f,sizeof(f),true);

   read(f1,n);

   for i:=1 to n do begin read(f1,a[i]);inc(p[a[i]]);end;

   e[1,1]:=1;e[1,2]:=p[1];

   e[2,1]:=p[1]+1;e[2,2]:=p[1]+p[2];

   e[3,1]:=p[1]+p[2]+1;e[3,2]:=n;

   for i:=1 to p[1] do g[i]:=1;

   for i:=e[2,1] to e[2,2] do g[i]:=2;

   for i:=e[3,1] to e[3,2] do g[i]:=3;

   sum:=0;

 end;

 procedure swap(var p1,p2:integer);

 varx:integer;

 begin x:=p1;p1:=p2;p2:=x;end;

 procedure doit;

 vari,ee:longint;

 begin

  for i:=1 to n do

    if a[i]=g[i] then f[i]:=false

      else

        begin

          inc(sum);j:=e[a[i],1]-1;

          repeat inc(j);

          until (((a[j]=g[i])and(f[j]))or(e[a[i],2]=j));

          if g[i]=a[j] then

            begin swap(a[i],a[j]);f[j]:=false;f[i]:=false;end

               else

                 begin

                   ee:=yy-a[i]-g[i];j:=e[ee,1]-1;

                    repeat inc(j);

                    until (a[j]=g[i])and(f[j]);

                    swap(a[i],a[j]);

                    f[i]:=false;

                 end;

     end;

 end;

 {-----------------------------}

 begin

  yy:=6;

  init;

  doit;

  writeln(f2,sum);

  close(f1);close(f2)

  end.