p1005.pas

vijos p1005 超长数字串 枚举算法

Program P1005;
Const
     maxs=200;
     maxl=maxs div 2;
     mode:array [0..3] of longint=(1,10,100,1000);
Type
     number=array [0..maxl] of longint;
Var
     i,ad:longint;
     s,modle,now:string[maxs];
     k:number;
     found:boolean;
Procedure Account(var k:number;i:longint);
Var
     j,l,m:longint;
Begin
     l:=(i+3) div 4;
     m:=i*9*mode[i+3-4*l];
     k[l]:=k[l]+m;
     For j:=l to k[0] do
         Begin
              k[j+1]:=k[j+1]+k[j] div 10000;
              k[j]:=k[j] mod 10000;
         end;
     While k[k[0]+1]>10000 do
           Begin
                inc(k[0]);
                k[k[0]+1]:=k[k[0]+1]+k[k[0]] div 10000;
                k[k[0]]:=k[k[0]] mod 10000;
           end;
     If k[k[0]+1]<>0 then inc(k[0]);
end;
Function Max(a,b:longint):longint;
Begin
     If a>b then exit(a)
            else exit(b);
end;
Procedure Add(s:string[maxs];ad:longint;var k:number);
Var
     i,j,m,n:longint;
     a:number;
Begin
     Fillchar(a,sizeof(a),0);
     j:=length(s);
     m:=j;
     If s[1]='1'
        Then
            Begin
                 Delete(s,1,1);
                 dec(j);
            end
        Else s[1]:=pred(s[1]);
     a[0]:=(j+3) div 4;
     For i:=1 to j do
         a[(j-i) div 4+1]:=a[(j-i) div 4+1]*10+ord(s[i])-48;
     While (a[a[0]]=0) and (a[0]>1) do dec(a[0]);
     n:=ad;
     For i:=1 to a[0] do
         Begin
              a[i]:=a[i]*m+n;
              n:=a[i] div 10000;
              a[i]:=a[i] mod 10000;
         end;
     If n<>0
        Then
            Begin
                 inc(a[0]);
                 a[a[0]]:=n;
            end;
     k[0]:=max(k[0],a[0]);
     For i:=1 to k[0] do
         Begin
              k[i]:=k[i]+a[i];
              k[i+1]:=k[i+1]+k[i] div 10000;
              k[i]:=k[i] mod 10000;
         end;
     If k[k[0]+1]<>0 then inc(k[0]);
end;
Function All(m:string[maxs];i:longint;ch:char):boolean;
Var
     j:longint;
Begin
     If i=0 then exit(false);
     For j:=1 to i do if m[j]<>ch then exit(false);
     exit(true);
end;
Function Qian(m:string[maxs]):string[maxs];
Var
     i,j:longint;
Begin
     i:=length(m);
     For j:=i downto 1 do
         If m[j]='0' then m[j]:='9'
                     else
                         Begin
                              m[j]:=pred(m[j]);
                              Break;
                         end;
     If m[1]='0' then delete(m,1,1);
     Qian:=m;
end;
Function Hou(m:string[maxs]):string[maxs];
Var
     i,j:longint;
Begin
     i:=length(m);
     If all(m,i,'9')
        Then
            Begin
                 For j:=1 to i do m[j]:='0';
                 m:='1'+m;
                 exit(m);
            end;
     For j:=i downto 1 do
         If m[j]='9' then m[j]:='0'
                     else
                         Begin
                              m[j]:=succ(m[j]);
                              Break;
                         end;
     Hou:=m;
end;
Function Pei(m:string[maxs];j:longint):boolean;
Var
     i,l,c,k:longint;
Begin
     l:=length(m);
     For i:=1 to l-j+1 do if s[i]<>m[i+j-1] then exit(false);
     c:=length(s)-l-1+j;
     i:=l-j+2;
     m:=hou(m);
     l:=length(m);
     While c>=l do
           Begin
                For k:=1 to l do if m[k]<>s[k+i-1] then exit(false);
                inc(i,l);
                dec(c,l);
                m:=hou(m);
                l:=length(m);
           end;
     For k:=1 to c do if m[k]<>s[k+i-1] then exit(false);
     exit(true);
end;
Procedure Find(i:longint);
Var
     j,l,w:longint;
     m,n,c:string[maxs];
Begin
     modle:=modle+'9';
     now:=modle;
     m:=copy(s,1,i);
     For j:=1 to i do
         Begin
              If m[j]='0' then continue;
              If all(m,j-1,'9') then n:=qian(copy(m,j,i-j+1))+copy(m,1,j-1)
                                else n:=copy(m,j,i-j+1)+copy(m,1,j-1);
              w:=length(n);
              If j=1 then l:=1
                     else l:=w-j+2;
              If pei(n,l)
                 Then
                     Begin
                          found:=true;
                          If (w<length(now)) or ((w=length(now)) and (n<now))
                             Then
                                 Begin
                                      now:=n;
                                      ad:=l;
                                 end
                             Else if n=now then if l<ad then ad:=l;
                     end;
         end;
end;
Procedure Print;
Var
     i:longint;
Begin
     Write(k[k[0]]);
     For i:=k[0]-1 downto 1 do
         Write(k[i] div 1000,k[i] div 100 mod 10,k[i] div 10 mod 10,k[i] mod 10);
     Writeln;
end;

Begin
     Fillchar(k,sizeof(k),0);
     k[0]:=1;
     Readln(s);
     If all(s,length(s),'0')
        Then
            Begin
                 For i:=1 to length(s) do account(k,i);
                 ad:=2;
                 Add('10',ad,k);
                 Print;
                 Halt;
            end;
     found:=false;
     ad:=maxs*100;
     i:=1;
     Find(i);
     While not found do
           Begin
                Account(k,i);
                Find(i+1);
                inc(i);
           end;
     If length(now)=i then Add(now,ad,k)
                      else dec(k[1],length(now)-ad);
     Print;
end.
//Completed By Chyy.