MCLONUM - Closest Number

Tác giả: flashmt

Ngôn ngữ: Pascal

var a,b,c:array[1..60] of byte;
    d,d1:array[0..9] of byte;
    n:byte;

procedure rf;
var ch:char; code,t:integer; i:byte;
begin
     n:=0;
     fillchar(d,sizeof(d),0);
     while not eoln do
     begin
          inc(n);
          read(ch);
          val(ch,t,code);
          a[n]:=t;
     end;
     readln;
     for i:=1 to n do
     begin
          read(ch);
          val(ch,t,code);
          inc(d[t]);
     end;
     d1:=d;
end;

procedure max;
var i,j,t:byte; kt:boolean;
begin
     kt:=false;
     for i:=1 to n do
     begin
          t:=a[i];
          if d[t]>0 then
          begin
               b[i]:=t;
               dec(d[t]);
          end
          else
          begin
               kt:=true;
               break;
          end;
     end;
     if kt then
     begin
          for j:=t+1 to 9 do
              if d[j]>0 then
              begin
                   b[i]:=j;
                   dec(d[j]);
                   kt:=false;
                   break;
              end;
          if kt then
          begin
               dec(i);
               inc(d[b[i]]);
               b[i]:=0;
               repeat
                     t:=a[i];
                     for j:=t+1 to 9 do
                         if d[j]>0 then
                         begin
                              dec(d[j]);
                              b[i]:=j;
                              kt:=false;
                              break;
                         end;
                     if not kt then break;
                     dec(i);
                     inc(d[b[i]]);
                     b[i]:=0;
               until not kt or (i=0);
          end;
          if i=0 then exit;
          while i<n do
          begin
               inc(i);
               for j:=0 to 9 do
                   if d[j]>0 then
                   begin
                        b[i]:=j;
                        dec(d[j]);
                        break;
                   end;
          end;
     end;
end;

procedure min;
var i,j,t:byte; kt:boolean;
begin
     kt:=false;
     d:=d1;
     for i:=1 to n do
     begin
          t:=a[i];
          if d[t]>0 then
          begin
               c[i]:=t;
               dec(d[t]);
          end
          else
          begin
               kt:=true;
               break;
          end;
     end;
     if kt or ((a[n]=c[n]) and (a[n-1]=c[n-1])) then
     begin
          if not kt then
          begin
               inc(d[c[n]]);
               inc(d[c[n-1]]);
               c[n]:=0;
               c[n-1]:=0;
          end;
          kt:=true;
          repeat
                t:=a[i];
		if t>0 then
		begin
                for j:=t-1 downto 0 do
                    if d[j]>0 then
                    begin
                         inc(d[c[i]]);
                         c[i]:=j;
                         dec(d[j]);
                         kt:=false;
                         break;
                    end;
		end;
                if not kt then break;
                dec(i);
                inc(d[c[i]]);
                c[i]:=0;
          until not kt or (i=0) or (c[1]=0);
          if kt then exit;
          while i<n do
          begin
               inc(i);
               for j:=9 downto 0 do
                   if d[j]>0 then
                   begin
                        dec(d[j]);
                        c[i]:=j;
                        break;
                   end;
          end;
     end;
end;

procedure pr;
var i:byte;  kt:boolean;
begin
     fillchar(b,sizeof(b),0);
     fillchar(c,sizeof(c),0);
     max;
     min;
end;

procedure wf;
var i:byte;
begin
     if b[1]=0 then write(0)
     else
         for i:=1 to n do write(b[i]);
     writeln;
     if c[1]=0 then write(0)
     else
         for i:=1 to n do write(c[i]);
end;

begin
     rf;
     pr;
     wf;
end.

Download