ac1250.pas

这是在网络上搜集到的在东京大学的ACM上面解决的一些题目的源码

{$Q-,R-}
program tju1250;
const
  maxn=1000;
  bignumsize=99;
  compress=15;
  base=32768;
  primes=42;
type
  bignum=array[-1..bignumsize]of longint;
var
  p:array[1..primes]of byte;
  fib:array[1..maxn]of bignum;
  ans:array[1..maxn]of byte;//1:ans;2:not ans;0:not judged
  i,j,k,l,ps:longint;
function prime(x:longint):boolean;
  var
    i:longint;
  begin
    for i:=1 to ps do
      if sqr(p[i])>x then
        break
      else if x mod p[i]=0 then begin
        prime:=false;exit;
      end;
    prime:=true;
  end;
operator >= (var a,b:bignum) res:boolean;
  var
    i:longint;
  begin
    if a[-1]>b[-1] then begin res:=true;exit;end;
    if a[-1]<b[-1] then begin res:=false;exit;end;
    for i:=a[-1] downto 0 do begin
      if a[i]>b[i] then begin res:=true;exit;end;
      if a[i]<b[i] then begin res:=false;exit;end;
    end;
    res:=true;
  end;
procedure big_dec(var a,b:bignum);
  var
    i:longint;
  begin
    for i:=0 to a[-1] do begin
      dec(a[i],b[i]);
      if a[i]<0 then begin inc(a[i],base);dec(a[i+1]);end;
    end;
    while (a[-1]>0) and (a[a[-1]]=0) do dec(a[-1]);
  end;
operator * (var a,b:bignum) c:bignum;
  var
    i,j,k:longint;
  begin
    fillchar(c,sizeof(c),0);
    for i:=0 to a[-1] do
      for j:=0 to b[-1] do begin
        k:=i+j;inc(c[k],a[i]*b[j]);
        inc(c[k+1],c[k] div base);c[k]:=c[k] mod base;
      end;
    while c[k+1]>0 do inc(k);c[-1]:=k;
  end;
procedure half(var a:bignum);
  var
    i:longint;
  begin
    for i:=a[-1] downto 1 do begin
      if odd(a[i]) then inc(a[i-1],base);
      a[i]:=a[i] shr 1;
    end;
    a[0]:=a[0] shr 1;
    if a[a[-1]]=0 then dec(a[-1]);
  end;
procedure big_mod(var a,n:bignum);
  var
    shift,i:longint;
  begin
    if a[-1]<n[-1] then exit;
    shift:=a[-1]-n[-1]+ord(a[a[-1]]>=n[n[-1]]);
    for i:=n[-1] downto 0 do n[i+shift]:=n[i];
    for i:=0 to shift-1 do n[i]:=0;
    inc(n[-1],shift);
    shift:=shift*compress;
    repeat
      if a>=n then big_dec(a,n);
      if shift=0 then break;
      half(n);dec(shift);
    until false;
  end;
function miller(var n:bignum):byte;
  //It's said that the error probability for super-large numbers is
  //  unimaginably low, so I just choose one base
  //  -- otherwise it would be so terribly slow
  var
    b,e,u,v:bignum;
    i:longint;
  procedure exp_rem(var u,v:bignum);
    begin
      if (e[-1]=0) and (e[0]=1) then
        u:=b
      else if odd(e[0]) then begin
        half(e);exp_rem(u,v);v:=u*u;u:=v*b;big_mod(u,n);
      end
      else begin
        half(e);exp_rem(v,u);u:=v*v;big_mod(u,n);
      end;
    end;
  begin
    b[-1]:=0;b[0]:=random(base-2)+2;
    e:=n;dec(e[0],1);
    exp_rem(u,v);
    if (u[-1]>0) or (u[0]>1) then miller:=2 else miller:=1;
  end;
begin
  fib[1,0]:=1;fib[2,0]:=1;
  for i:=3 to maxn do begin
    l:=fib[i-1,-1];
    for j:=0 to l do begin
      inc(fib[i,j],fib[i-1,j]+fib[i-2,j]);
      fib[i,j+1]:=fib[i,j] div base;
      fib[i,j]:=fib[i,j] mod base;
    end;
    fib[i,-1]:=l+ord(fib[i,l+1]>0);
  end;

  ps:=0;
  for i:=2 to trunc(sqrt(base-1)) do
    if prime(i) then begin inc(ps);p[ps]:=i;end;

  ans[1]:=2;ans[2]:=2;
  repeat
    readln(i);if i=0 then halt;
    if ans[i]=0 then
      if fib[i,-1]=0 then
        if prime(fib[i,0]) then ans[i]:=1 else ans[i]:=2
      else
        if not prime(i) then ans[i]:=2 else ans[i]:=miller(fib[i]);
    if ans[i]=1 then writeln('Success') else writeln('Unsuccess');
  until false;
end.