QBPAL - Đếm chuỗi đối xứng

Tác giả: flashmt

Ngôn ngữ: Pascal

const fi='';
      fo='';
      maxn=121;
      base=100000000;
      digit=8;
type bignum=array[0..10] of longint;
var n:longint;
    s:string;
    f:array[1..maxn,1..maxn] of bignum;

procedure rf;
var i:longint;
begin
     assign(input,fi);
     reset(input);
     read(s);
     n:=length(s);
     fillchar(f,sizeof(f),0);
     close(input);
end;

procedure plus(var a:bignum;b,c:bignum);
var i,mem,max:longint;
begin
     if b[0]>c[0] then max:=b[0] else max:=c[0];
     mem:=0;
     for i:=1 to max do
     begin
          a[i]:=(b[i]+c[i]+mem) mod base;
          mem:=(c[i]+b[i]+mem) div base;
     end;
     if mem>0 then
     begin
          inc(max);
          a[max]:=mem;
     end;
     a[0]:=max;
end;

procedure minus(var a:bignum;b:bignum);
var i,mem,max:longint;
begin
     max:=a[0];
     mem:=0;
     for i:=1 to max do
         if a[i]-b[i]-mem<0 then
         begin
              a[i]:=a[i]+base-b[i]-mem;
              mem:=1;
         end
         else
         begin
              a[i]:=a[i]-b[i]-mem;
              mem:=0;
         end;
     i:=max;
     while (i>1) and (a[i]=0) do dec(i);
     a[0]:=i;
end;

procedure calc(l,r:longint);
var t:bignum;
begin
     if l=r then
     begin
          f[l,l,0]:=1; f[l,l,1]:=1;
          exit;
     end;
     if f[l,r-1,0]=0 then calc(l,r-1);
     if f[l+1,r,0]=0 then calc(l+1,r);
     plus(f[l,r],f[l,r-1],f[l+1,r]);
     if s[l]=s[r] then
     begin
          fillchar(t,sizeof(t),0);
          t[0]:=1; t[1]:=1;
          plus(f[l,r],f[l,r],t);
     end
     else
     begin
          if (l+1<=r-1) and (f[l+1,r-1,0]=0) then calc(l+1,r-1);
          minus(f[l,r],f[l+1,r-1]);
     end;
end;

procedure pr;
var i,j:longint;
begin
     calc(1,n);
end;

procedure wf;
var i,j,t:longint; s:string; re:bignum;
begin
     assign(output,fo);
     rewrite(output);
     re:=f[1,n];
     for i:=re[0] downto 1 do
     begin
          if i<re[0] then
          begin
               str(re[i],s);
               t:=length(s);
               for j:=t+1 to digit do write(0);
          end;
          write(re[i]);
     end;
     close(output);
end;

begin
     rf;
     pr;
     wf;
end.

Download