Cod sursa(job #70690)

Utilizator ProtomanAndrei Purice Protoman Data 6 iulie 2007 20:43:19
Problema Sarpe Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.23 kb
var x,y,z:array[0..1000005] of integer;
    f1,f2:text;
    i,nr,j,aux,d:longint;
    c:char;

procedure minus;
begin
        i:=1;
        nr:=1;
        while nr>0 do
        begin
                x[i]:=(x[i]+10-nr) mod 10;
                if x[i]<>10-nr then nr:=0
                               else inc(i);
        end;
        if x[x[0]]=0 then dec(x[0]);
end;

procedure ori;
begin
        for i:=1 to x[0] do
                for j:=1 to y[0] do
                begin
                        inc(z[0]);
                        z[i+j-1]:=z[i+j-1]+x[i]*y[j];
                        z[i+j]:=z[i+j]+z[i+j-1] div 10;
                        z[i+j-1]:=z[i+j-1] mod 10;
                end;
        inc(z[0]);
        while z[z[0]]=0 do dec(z[0]);
end;

procedure plus;
begin
        i:=1;
        nr:=4;
        while nr>0 do
        begin
                x[i]:=x[i]+4;
                if x[i]>10 then
                begin
                        x[i]:=x[i] mod 10;
                        inc(x[i+1]);
                end
                else nr:=0;
        end;
        if x[x[0]+1]>0 then inc(x[0]);
end;

begin
        assign(f1,'sarpe.in');
        reset(f1);
        assign(f2,'sarpe.out');
        rewrite(f2);
        while not(eof(f1)) do
        begin
                read(f1,c);
                if (ord(c)>47)and(ord(c)<58) then
                begin
                        inc(x[0]);
                        x[x[0]]:=ord(c)-48;
                end;
        end;
        if (x[0]=1)and(x[1]=1) then writeln(f2,2)
        else
        begin
                for i:=1 to x[0] div 2 do
                begin
                        aux:=x[i];
                        x[i]:=x[x[0]-i+1];
                        x[x[0]-i+1]:=aux;
                end;
                y:=x;
                minus;
                ori;
                x:=z;
                for i:=1 to y[0] do y[i]:=0;
                for i:=1 to z[0] do z[i]:=0;
                z[0]:=0;
                y[0]:=1;
                y[1]:=2;
                ori;
                x:=z;
                plus;
                for i:=x[0] downto 1 do write(f2,x[i]);
        end;
        close(f1);
        close(f2);
end.