切换到宽版
  • 10380阅读
  • 6回复

ural 上的,谁会?发个标程给我! [复制链接]

上一主题 下一主题
离线sm-star
 
只看楼主 倒序阅读 0 发表于: 2007-08-24
P1165 超长数字串
背景 Background 
  George很喜欢数学,尤其是算数数系列。
描述 Description 
  他最喜欢的是数字的无穷序列,结果是把所有的自然数按升序排列。这个序列开始是: 1234567891011121314... 我们叫序列 S。然后 S[1] = 1, S[2] = 2, ... , S[10] = 1, S[11] = 0, ... , 以此类推。
George 现有一个数字系列 A ,他想知道在S中最早出现的位置。帮助他解决这个难题。
输入格式 Input Format 
  输入文件包含 A - 给出的数字系列。位数不超过 200。没有空格。
输出格式 Output Format 
  输出一个整数。- 最小的 k ,使 A[1] = S[k], A[2] = S[k+1], ... A[len(A)] = S[k + len(A) -1], len(A) 表示 A 的长度。
样例输入 Sample Input 
  101
样例输出 Sample Output 
  10
离线clwxzh57
只看该作者 1 发表于: 2007-08-26
实际上可以分析一下输入,从中找出问题所在.
离线sm-star
只看该作者 2 发表于: 2007-08-26
如何分析?
离线yk2000
只看该作者 3 发表于: 2007-08-27
{
    Enumerate
}
program Ural_1165(Input,Output);
const
    MaxLen=250;
type
    TIndex=Longint;
    THP=record
        Len:TIndex;
        D:array[1..MaxLen]of TIndex;
    end;
var
    Num:String;
    N:TIndex;
    Min:String; //First Number appears in String
    MinD:TIndex; //Which is String[1]
    Ans:THP;

function GetStr(i,j:TIndex):String;
begin
    Result:=Copy(Num,i,j-i+1);
end;
function Compare(const A:String;B:TIndex):TIndex;
begin
    Result:=Length(A)-Length(Min);
    if Result<>0 then Exit;
    if A>Min then Result:=1
    else if A<Min then Result:=-1
    else Result:=0;
    if Result=0 then Result:=B-MinD;
end;
procedure IncHP(var A:String);
var
    i:TIndex;
begin
    i:=Length(A);
    Inc(A);
    while (A>'9') and (i>1) do
    begin
        Inc(A[i-1]);
        Dec(A,10);
        Dec(i);
    end;
    if (A>'9') and (i=1) then
    begin
        Dec(A,10);
        Insert('1',A,1);
    end;
end;
procedure DecHP(var A:String);
var
    i:TIndex;
begin
    i:=Length(A);
    Dec(A);
    while (A<'0') and (i>1) do
    begin
        Dec(A[i-1]);
        Inc(A,10);
        Dec(i);
    end;
    if A[1]='0' then Delete(A,1,1);
end;
procedure AddMul(A:String;B:TIndex);
var
    i:TIndex;
    R:TIndex;
    Len:TIndex;
begin
    if A[1]='0' then Delete(A,1,1);
    Len:=Length(A);
    i:=1;
    R:=0;
    while (i<=Len) or (R>0) do
    begin
        if i<=Len then Inc(Ans.D,(Ord(A[Len-i+1])-Ord('0'))*B);
        Inc(Ans.D,R);
        R:=Ans.D div 10;
        Ans.D:=Ans.D mod 10;
        Inc(i);
    end;
    if i-1>Ans.Len then Ans.Len:=i-1;
end;
procedure Main;
label
    Error,Error2;
var
    i,j,k,p:TIndex;
    Len:TIndex;
    Cur:String;
    First:String;
    FirstD:TIndex;
begin
    Readln(Num);

    if Num[1]='0' then //Lead Zero
    begin
        Min:='1'+Num;
        MinD:=2;
    end
    else
    begin
        Min:=Num;
        MinD:=1;
    end;
    N:=Length(Num);

    for i:=1 to N div 2+1 do //Enumerate a full number in string
        if Num<>'0' then
            for j:=i*2-1 to N do
            begin
                Cur:=GetStr(i,j);
                if i>1 then
                begin
                    DecHP(Cur);
                    if Cur='0' then goto Error;
                    Len:=Length(Cur);
                    for p:=1 to Len do
                    begin
                        if i-p<=0 then Break;
                        if Num[i-p]<>Cur[Len-p+1] then goto Error;
                    end;
                    if Compare(Cur,Len-i+2)>=0 then goto Error;
                    First:=Cur;
                    FirstD:=Len-i+2;
                    IncHP(Cur);
                end
                else
                begin
                    if Compare(Cur,1)>=0 then goto Error;
                    First:=Cur;
                    FirstD:=1;
                end;

                k:=j;
                repeat
                    IncHP(Cur);
                    for p:=1 to Length(Cur) do
                    begin
                        if k+p>N then Break;
                        if Num[k+p]<>Cur[p] then goto Error;
                    end;
                    Inc(k,Length(Cur));
                until k>=N;
                Min:=First;
                MinD:=FirstD;
                Error: Continue;
            end;

    for i:=1 to N-1 do //Split String into two part.Part 1 is exactly not full. Part 2 may be full.
        if Num[i+1]<>'0' then
        begin
            Cur:=GetStr(1,i);
            IncHP(Cur);
            j:=i+1;
            if Length(Cur)>i then Delete(Cur,1,1);
            if N-Length(Cur)>j then j:=N-Length(Cur);
            repeat
                First:=GetStr(i+1,j)+Cur;
                DecHP(First);
                FirstD:=Length(First)-i+1;
                if Compare(First,FirstD)>=0 then Break;
                for p:=1 to Length(Cur) do
                begin
                    if j+p>N then Break;
                    if Num[j+p]<>Cur[p] then goto Error2;
                end;
                Min:=First;
                MinD:=FirstD;
                Error2:Inc(j);
            until j=N+1;
        end;
    Writeln(Min);
    Writeln(MinD);
   
    FillChar(Ans,SizeOf(Ans),0);
    Ans.Len:=1;
    Cur:='9';
    for i:=1 to Length(Min)-1 do
    begin
        AddMul(Cur,i);
        Cur:=Cur+'0';
    end;
    Dec(Min[1]);
    AddMul(Min,Length(Min));
    AddMul('1',MinD);
    for i:=Ans.Len downto 1 do
        Write(Ans.D);
    Writeln;
end;
begin
    Main;
end.
离线sm-star
只看该作者 4 发表于: 2007-08-27
看不太懂,能说说具体思路么?
而且里面有一些语法错误。
离线yiyi
只看该作者 5 发表于: 2007-09-17
program ural1165;
{$Q-,R-}
const
  maxl=200;
type
  bignum=array[-1..210]of integer;
var
  sum:array[0..maxl]of bignum;
  match:array[2..maxl+1]of byte;
  s:string;
  n,i,j:longint;
  ans:bignum;
//Basical procs & funcs for bignums & strings
procedure out(a:bignum);
  var
    i:longint;
  begin
    for i:=a[-1] downto 0 do write(a[i]);writeln;
  end;
procedure big_minus_small(var a:bignum;b:longint);
  var
    i,t:longint;
  begin
    dec(a[0],b);i:=0;
    while a[i]<0 do begin
      t:=(9-a[i]) div 10;
      dec(a[i+1],t);inc(a[i],t*10);
      inc(i);
    end;
    while (a[-1]>0) and (a[a[-1]]=0) do dec(a[-1]);
  end;
function smaller(a,b:bignum):boolean;
  var
    i:longint;
  begin
    if a[-1]<>b[-1] then
      smaller:=a[-1]<b[-1]
    else begin
      for i:=a[-1] downto 0 do
        if a[i]<>b[i] then begin
          smaller:=a[i]<b[i];exit;
        end;
      smaller:=false;
    end;
  end;
procedure prevnum(var s:string);
  var
    i:longint;
  begin
    i:=length(s);
    while s[i]='0' do begin s[i]:='9';dec(i);end;
    dec(s[i]);if s[1]='0' then delete(s,1,1);
  end;
procedure nextnum(var s:string);
  var
    i:longint;
  begin
    i:=length(s);
    while (i>0) and (s[i]='9') do begin s[i]:='0';dec(i);end;
    if i>0 then inc(s[i]) else s:='1'+s;
  end;
//Procs & funcs for this prob
function posi(s:string):bignum;
  var
    a:bignum;
    l,i:longint;
  begin
    l:=length(s);dec(s[1]);
    a:=sum[l-1];
    for i:=1 to l do
      inc(a[l-i],(ord(s[i])-48)*l);
    inc(a[0]);
    i:=0;
    while (i<a[-1]) or (a[i]>9) do begin
      inc(a[i+1],a[i] div 10);a[i]:=a[i] mod 10;inc(i);
    end;
    a[-1]:=i;
    posi:=a;
  end;
procedure complete(st,ed:longint);
  var
    a:bignum;
    p,q:string;
    i:longint;
  begin
    p:=copy(s,st,ed-st+1);a:=posi(p);
    if (a[-1]<3) and (a[2]*100+a[1]*10+a[0]<st) then exit;
    big_minus_small(a,st-1);
    if not smaller(a,ans) then exit;

    q:=p;
    while st>1 do begin
      prevnum(p);
      for i:=length(p) downto 1 do begin
        dec(st);if s[st]<>p[i] then exit;
        if st=1 then break;
      end;
    end;
    while ed<n do begin
      nextnum(q);
      for i:=1 to length(q) do begin
        inc(ed);if s[ed]<>q[i] then exit;
        if ed=n then break;
      end;
    end;
    ans:=a;
  end;
procedure incomplete(mid:longint);
  var
    p:string;
    h,i,j,l:longint;
    a:bignum;
  begin
    p:=copy(s,1,mid);
    h:=length(p);
    while (h>0) and (p[h]='9') do begin p[h]:='0';dec(h);end;
    if h>0 then begin inc(p[h]);dec(h);end;

    j:=n-mid+2;if j<mid+2 then j:=mid+2;
    for i:=j to n+1 do begin
      if match[i]>h then continue;
      l:=match[i];
      if l=h then while (i-1+l<n) and (s[i+l]=p[l+1]) do inc(l);
      if i+l<=n then continue;
      a:=posi(copy(s,mid+1,n-mid-l)+p);
      big_minus_small(a,mid);
      if smaller(a,ans) then ans:=a;
    end;
  end;
begin
  for i:=1 to maxl do begin
    sum[i]:=sum[i-1];
    inc(sum[i][i-1],9*i);
    j:=i-1;
    while sum[i][j]>9 do begin
      inc(sum[i][j+1],sum[i][j] div 10);sum[i][j]:=sum[i][j] mod 10;inc(j);
    end;
    sum[i][-1]:=j;
  end;

  readln(s);n:=length(s);
  j:=0;for i:=1 to n do if s[i]>'0' then begin j:=1;break;end;
  if j=0 then begin
    ans:=posi('1'+s);
    i:=0;while ans[i]=9 do begin ans[i]:=0;inc(i);end;
    inc(ans[i]);if i>ans[-1] then ans[-1]:=i;
    out(ans);halt;
  end;

  ans[-1]:=maxint;
  for i:=1 to n do if s[i]>'0' then
    for j:=i to n do if (j=n) or (s[j+1]>'0') then
      complete(i,j);
  for i:=2 to n do
    while (i+match[i]<=n) and (s[i+match[i]]=s[match[i]+1]) do inc(match[i]);
  for i:=1 to n-1 do
    if s[i+1]>'0' then incomplete(i);

  out(ans);
end.
离线yonghu86cs
只看该作者 6 发表于: 2008-02-23
...
快速回复
限100 字节
 
上一个 下一个