MCLONUM - Closest Number

Tác giả: ll931110

Ngôn ngữ: Pascal

Program MCLONUM;
        Const
                input  = '';
                output = '';
        Var
                 a,b: array[1..60] of byte;
               digit: array[0..9] of byte;
                   n: integer;
               sa,sb: string[60];
               fi,fo: text;

Procedure openfile;
          Begin
                Assign(fi, input);
                        Reset(fi);

                Assign(fo, output);
                        Rewrite(fo);
          End;

Procedure closefile;
          Begin
                Close(fi);
                Close(fo);
          End;

Procedure init;
          Var
                i: integer;
          Begin
                Readln(fi, sa);
                Readln(fi, sb);

                n:= length(sa);
                For i:= 1 to n do a[i]:= ord(sa[i]) - 48;
          End;

Procedure solve1;
          Var
                i,j,k,t,ok: integer;
          Begin
                Fillchar(digit, sizeof(digit), 0);
                For i:= 1 to n do inc(digit[ord(sb[i]) - 48]);

                ok:= 0;
                k:= 1;
                While (k <= n) and (ok = 0) do
                        Begin
                                ok:= -1;
                                For j:= a[k] to 9 do if digit[j] > 0 then
                                    Begin
                                         b[k]:= j;
                                         dec(digit[j]);

                                         If b[k] > a[k] then ok:= 1 else ok:= 0;
                                         break;
                                    End;
                                inc(k);
                        End;

                If ok = 1 then
                   For i:= 0 to 9 do
                       For t:= 1 to digit[i] do
                           Begin
                                 b[k]:= i;
                                 inc(k);
                           End;

                If ok = -1 then
                   Begin
                        If k = 2 then
                                Begin
                                        Writeln(fo, 0);
                                        exit;
                                End;

                        k:= k - 2;
                        inc(digit[b[k]]);

                        While k >= 1 do
                              Begin
                                   inc(digit[b[k]]);

                                   For j:= a[k] + 1 to 9 do if digit[j] > 0 then
                                        Begin
                                                b[k]:= j;
                                                dec(digit[j]);
                                                ok:= 1;
                                                break;
                                        End;

                                   If ok = 1 then break else dec(k);
                              End;

                        If k = 0 then
                                Begin
                                        Writeln(fo, 0);
                                        exit;
                                End;

                        For i:= 0 to 9 do
                            For t:= 1 to digit[i] do
                                Begin
                                        inc(k);
                                        b[k]:= i;
                                End;
                   End;

                For i:= 1 to n do write(fo, b[i]);
                Writeln(fo);
          End;

Procedure solve2;
          Var
                i,j,k,t,ok: integer;
          Begin
                Fillchar(digit, sizeof(digit), 0);
                For i:= 1 to n do inc(digit[ord(sb[i]) - 48]);

                ok:= 0;
                k:= 1;
                While (k <= n) and (ok = 0) do
                      Begin
                                ok:= -1;
                                For j:= a[k] downto 0 do if digit[j] > 0 then
                                        Begin
                                                If (k = 1) and (j = 0) then break;

                                                b[k]:= j;
                                                dec(digit[j]);

                                                If b[k] < a[k] then ok:= 1 else ok:= 0;
                                                break;
                                        End;
                                inc(k);
                      End;

                If (k > n) and (b[k - 1] = a[k - 1]) then
                        Begin
                                ok:= -1;
                                inc(digit[b[k - 1]]);
                        End;

                If ok = 1 then
                   For i:= 9 downto 0 do
                       For t:= 1 to digit[i] do
                           Begin
                                b[k]:= i;
                                inc(k);
                           End;

                If ok = -1 then
                   Begin
                        If k = 2 then
                                Begin
                                        Writeln(fo, 0);
                                        exit;
                                End;

                        k:= k - 2;
                        inc(digit[b[k]]);

                        While k >= 1 do
                                Begin
                                        inc(digit[b[k]]);

                                        For j:= a[k] - 1 downto 0 do if digit[j] > 0 then
                                                Begin
                                                        b[k]:= j;
                                                        dec(digit[j]);
                                                        ok:= 1;
                                                        break;
                                                End;

                                        If ok = 1 then break else dec(k);
                                End;

                        If k = 0 then
                                Begin
                                        Writeln(fo, 0);
                                        exit;
                                End;

                        For i:= 9 downto 0 do
                            For t:= 1 to digit[i] do
                                Begin
                                        inc(k);
                                        b[k]:= i;
                                End;
                   End;

                For i:= 1 to n do write(fo, b[i]);
          End;

Begin
        openfile;
        init;
        solve1;
        solve2;
        closefile;
End.

Download