Cod sursa(job #600954)

Utilizator vendettaSalajan Razvan vendetta Data 4 iulie 2011 14:34:15
Problema Prod Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 3.57 kb
const f = 'prod.in'; g = 'prod.out';
type vec=array[0..10001] of longint;
var
    v, a, b,c,a1,b1 : vec;
    //v,a,b : array[0..1001] of longint;
    na, nb, n, i, j, s : longint;
    //c : char;

procedure inmul(a,b : vec );
    var
        i, j, t : longint;
        //c : vec;

    begin

        for i := 0 to 1000 do c[i] := 0;

        for i := 1 to a[0] do begin
            t := 0; j := 1;
            while (j <= b[0]) or (t <> 0) do begin
                if (i > a[0]) then a[i] := 0;
                if (j > b[0]) then b[j] := 0;
                t := t + c[i+j-1] + a[i] * b[j];
                c[i+j-1] := t mod 10;
                t := t div 10;
                inc( j );
            end;
            if (i+j-2 > c[0]) then c[0] := i+j-2;
        end;

    end;


begin
    assign( input,f ); reset( input );
    assign( output,g ); rewrite( output );
    while not eoln do begin
        read( i );
        inc( j );
        v[j] := i
    end;
    if v[j]=1 then begin
        inc(a[0]);
        a[a[0]] := j;
        a1[a[0]] := j;
        //a := a*10+j;
        dec(v[j]);
        dec( j );
        while (v[j]=0) do
            dec( j );
        inc(b[0]);
        b[b[0]] := j;
        b1[b[0]] := j;
        //b := b*10+j;
        //inc(nb);
        dec(v[j]);
        dec(j);
    end;

    if v[j]>1 then begin
        //inc( na );
        //a := a*10+j;
        //inc( nb );
        //b := b*10+j;
        inc( a[0] );
        a[a[0]] := j;
        a1[a[0]] := j;
        inc( b[0] );
        b[b[0]] := j;
        b1[b[0]] := j;
        v[j] := v[j]-2;
    end;

    for i := j downto 1 do begin
        if (v[i] <> 0)and(v[i]>1) then begin
            if (a[0]=b[0])or(a[0]>b[0]) then
                repeat
                    //b := b*10+i;
                    inc( b[0] );
                    b[b[0]] := i;
                    b1[b[0]] := i;
                    dec(v[i]);
                    if v[i]<>0 then begin
                        inc( a[0] );
                        a[a[0]] := i;
                        a1[a[0]] := i;
                        //a := a*10+i;
                        //inc(na);
                        dec(v[i]);
                    end;
                until v[i]=0;
            if b[0]>a[0] then
                repeat
                    inc( a[0] );
                    a[a[0]] := i;
                    a1[a[0]] := i;
                    //a := a*10+i;inc( na );
                    dec(v[i]);
                    if v[i]<>0 then begin
                        //b := b*10+i;
                        //inc( nb );
                        inc( b[0] );
                        b[b[0]] := i;
                        b1[b[0]] := i;
                        dec(v[i]);
                    end;
                until v[i]=0;
        end;
        if (v[i]<>0) and (v[i]=1)and(a[0]=b[0])or(a[0]>b[0]) then begin
            //b := b*10+i;
            //inc( nb );
            inc( b[0] );
            b[b[0]] := i;
            b1[b[0]] := i;
            dec( v[i] );
        end;
        if (v[i]<>0) and (v[i]=1)and(a[0]<b[0]) then begin
            //a := a*10+i;
            //inc( na );
            inc( a[0] );
            a[a[0]] := i;
            a1[a[0]] := i;
            dec( v[i] );
        end;
    end;
    j := a[0];
    for i :=1 to a[0] do begin
        a[i] := a1[j];
        dec(j);
    end;
    j := b[0];
    for i := 1 to b[0] do begin
        b[i] := b1[j];
        dec( j);
    end;

    inmul(a,b);
    for i := c[0] downto 1 do write(c[i]);
end.