Cod sursa(job #70626)

Utilizator cezar305Mr. Noname cezar305 Data 6 iulie 2007 16:13:59
Problema Sarpe Scor 30
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.98 kb
var x,y,z:array[0..1000] of longint;
    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;
        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]);
        close(f1);
        close(f2);
end.