Cod sursa(job #109553)

Utilizator runnaway90Oprescu Radu Constantin runnaway90 Data 25 noiembrie 2007 11:46:55
Problema Aliens Scor 10
Compilator fpc Status done
Runda preONI 2008, Runda 1, Clasa a 10-a Marime 5.68 kb
type vector2=array[0..52]of shortint;
type vector=array[0..51,0..2,0..10]of integer;
var  p:char;
        f:text;
        a:vector;
        b:array[0..52,0..3]of integer;
        i,j,r,q,k,n,nr,y,aux:integer;
        max:int64;

procedure back(var max:int64);
var st:vector2;
        k,w,p,e,y,u,o:integer;
        f:text;
        max1:int64;
begin
     k:=1;
     st[1]:=0;
     while k>0 do
     begin
        if st[k]<2 then
        begin
                inc(st[k]);
                if st[k]<=2 then
                        if k=n then
                        begin
                                y:=0;
                                u:=0;
                                o:=0;
                                for i:=1 to n do
                                if st[i]=2 then
                                begin
                                      y:=y+b[i,1];
                                      u:=u+b[i,2];
                                      o:=o+b[i,3];
                                end;
                                max1:=1;
                                if (y>=0)and(u>=0)and(o>=0) then
                                begin
                                        for w:=1 to y do
                                        max1:=max1*2;
                                        for w:=1 to u do
                                        max1:=max1*3;
                                        for w:=1 to o do
                                        max1:=max1*5;
                                end;
                                if max1>max then
                                        max:=max1;
                        end
                        else
                        begin
                                inc(k);
                                st[k]:=0;
                        end;
        end
        else
                dec(k);
     end;
end;

function rest(m,w,b:integer):shortint;
var i,t:integer;
begin
        t:=0;
        for i:=a[m,w,0] downto 1 do
        begin
                t:=(t*10+a[m,w,i]) mod b;
        end;
        if t=0 then
                rest:=0
        else
                rest:=1;
end;

procedure impartire(var a:vector;m,w,b:integer);
var i,t:integer;
begin
        t:=0;
     for i:=a[m,w,0] downto 1 do
     begin
        t:=t*10+a[m,w,i];
        a[m,w,i]:=t div b;
        t:=t mod b;
     end;
     if (a[m,w,0]>1)and(a[m,w,a[m,w,0]]=0) then
        dec(a[m,w,0]);
end;


begin
        assign(f,'aliens.in');
        reset(f);
                readln(f,n);
                for i:=1 to n do
                begin
                        r:=1;q:=0;
                        while not(eoln(f)) do
                        begin
                                read(f,p);
                                if p<>' ' then
                                begin
                                        inc(q);
                                     val(p,a[i,r,q],nr);
                                end
                                else
                                begin
                                        for y:=1 to q div 2 do
                                        begin
                                                aux:=a[i,r,y];
                                                a[i,r,y]:=a[i,r,q-y+1];
                                                a[i,r,q-y+1]:=aux;
                                        end;
                                        a[i,r,0]:=q;
                                        r:=r+1;q:=0;
                                end;
                        end;
                        for y:=1 to q div 2 do
                                        begin
                                                aux:=a[i,r,y];
                                                a[i,r,y]:=a[i,r,q-y+1];
                                                a[i,r,q-y+1]:=aux;
                                        end;
                        a[i,r,0]:=q;
                        readln(f);
                end;
        close(f);
        for k:=1 to 3 do
        begin
                for i:=1 to n do
                for j:=1 to 2 do
                begin
                        if k=1 then
                        begin
                           while a[i,j,1]mod 2=0 do
                           begin
                                impartire(a,i,j,2);
                                if j=1 then
                                        inc(b[i,1])
                                else
                                        dec(b[i,1]);
                           end;
                        end
                        else
                        if k=2 then
                        begin
                           while rest(i,j,3)=0 do
                           begin
                                impartire(a,i,j,3);
                                if j=1 then
                                        inc(b[i,2])
                                else
                                        dec(b[i,2]);
                           end;
                        end
                        else
                        if k=3 then
                           while a[i,j,1]=5 do
                           begin
                                impartire(a,i,j,5);
                                if j=1 then
                                        inc(b[i,3])
                                else
                                        dec(b[i,3]);
                           end;
                end;
        end;
        back(max);
        assign(f,'aliens.out');
        rewrite(f);
                write(f,max);
        close(f);

end.