Cod sursa(job #45551)

Utilizator Bluedrop_demonPandia Gheorghe Bluedrop_demon Data 1 aprilie 2007 17:40:42
Problema Elimin 2 Scor 10
Compilator fpc Status done
Runda Arhiva de probleme Marime 3.03 kb
{
    Problema nr
}

Program nr;

Type numar = array[1..2002] of Integer;

Var c : array[0..9] of Integer;
    num, nri : numar;
    n, i, j, k, cd : Integer;
    cod : boolean;
    car : char;
    s : string[2];

Procedure Afisare;
Var i : integer;
Begin
    If not cod then
        Begin
            Writeln( 0 );
            exit;
        End;
    For i := 1 to n do
        Write( num[i] );
    Writeln;
End;

Function complet( Var j : integer ) : boolean;
Var cod : boolean;
    i : integer;
Begin
    cod := true;
    For i := 1 to n do
        if c[i] > 0 then
            Begin
                cod := false;
                j := i;
                break;
            End;
    complet := cod;
End;

Begin
    { Init Stuff }
    For i := 0 to 9 do c[i] := 0;
    Assign( input, 'elimin2.in' );
    Reset( input );
        i := 0;
        While not eoln do
            Begin
                Read( car );
                s := '';
                s := s+car;
                val( s, j, cd );
                c[j] := c[j]+1;
                i := i+1;
                nri[i] := j;
            End;
        n := i;
    Close( input );

    cd := 0;
    For i := 0 to 9 do
        if c[i] mod 2 = 1 then
            Begin
                cd := cd+1;
                j := i;
            End;

    cod := true;
    if cd = 1 then
        Begin
            num[n div 2 +1] := j;
            c[j] := c[j]-1;
        End
        else
        If cd > 1 then cod := false;

    If cod then
        Begin
                k := n div 2;
                For i := 1 to k do
                    If c[nri[i]] > 0 then
                        Begin
                            num[i] := nri[i];
                            num[n-i+1] := nri[i];
                            c[nri[i]] := c[nri[i]] -2;
                        End
                        else
                        Begin
                            j := nri[i]+1;
                            While ( j < 10 ) and ( c[j] = 0 ) do
                                j := j+1;
                            if j = 10 then
                                Begin
                                    cod := false;
                                    break;
                                End;
                            num[i] := j;
                            num[n-i+1] := j;
                            c[j] := c[j]-2;
                            j := -1;
                            break;
                        End;
                if j = -1 then
                   While not complet( j ) do
                        While c[j] > 0 do
                             Begin
                                 i := i+1;
                                 num[i] := j;
                                 num[n-i+1] := j;
                                 c[j] := c[j]-2;
                             End;
        End;

    { Ending stuff }
    Assign( output, 'elimin2.out' );
    Rewrite( output );
        Afisare;
    Close( output );
End.