TOTALODD - Số lẻ hoàn toàn

Tác giả: flashmt

Ngôn ngữ: Pascal

const p:array[1..7] of longint=(1,10,100,1000,10000,100000,1000000);
var n,i,j,l,m,x:longint;
    a,s,u:string;
    code:integer;
    b:array[1..200000] of longint;

procedure gen(z,i:longint);
var j:longint;
begin
     if i>z then
     begin
          m:=m+1; b[m]:=x;
          if z=7 then
          begin
               m:=m+1; b[m]:=x+10000000;
          end;
          exit;
     end;
     for j:=1 to 5 do
     begin
          x:=x+p[i]*(j*2-1);
          gen(z,i+1);
          x:=x-p[i]*(j*2-1);
     end;
end;

function chk(a:string):boolean;
var i:longint;
begin
     for i:=1 to length(a) do
         if a[i]<'2' then exit(false);
     exit(true);
end;

function kt(x:longint):boolean;
begin
     while x>0 do
     begin
          if not odd(x mod 10) then exit(false);
          x:=x div 10;
     end;
     exit(true);
end;

function chk2(x:longint):boolean;
var i:longint;
begin
     for i:=1 to m do
         if (b[i]<x) and kt(x-b[i]) then exit(true);
     exit(false);
end;

begin
     for i:=1 to 7 do
     begin
          x:=0; gen(i,1);
     end;
     while true do
     begin
          readln(s);
          if s='[END]' then break;
          if s='[CASE]' then
          begin
               readln(n);
               if odd(n) then inc(n);
               str(n,a);
               l:=length(a);
               if chk(a) or chk2(n) then
               begin
                    writeln(n); continue;
               end;
               for i:=l downto 2 do
                   if a[i]<'2' then
                   begin
                        u:=copy(a,1,i-1);
                        val(u,x,code);
                        if chk(u) or chk2(x) then
                        begin
                             write(u);
                             for j:=i to l do write(2);
                             writeln;
                             break;
                        end;
                   end;
          end;
     end;
end.

Download