LQDFIBO - Xâu Fibonacci

Tác giả: RR

Ngôn ngữ: Pascal

//Written by RR

{$MODE OBJFPC}
{$R+,Q+}

uses math;
const
  FINP          =       '';
  FOUT          =       '';
  MAXN          =       1011;
  scs           =       30;
  base          =       100000000;
  lbase         =       8;

type
  big           =       array[0..MAXN] of longint;


var
  f1,f2         :       text;
  f             :       array[1..3] of big;
  g             :       array[1..2] of big;
  s,s1,s2,tmp   :       ansistring;
  n,now         :       longint;

procedure add(a,b:big; var c:big); inline;
    var
      i,nho:longint;
    begin
      nho:=0;
      fillchar(c,sizeof(c),0);
      c[0]:=max(a[0],b[0]);
      for i:=1 to c[0] do
        begin
          c[i]:=a[i]+b[i]+nho;
          if c[i]<base then nho:=0
          else begin nho:=1; dec(c[i],base); end;
        end;
      if nho>0 then
        begin
          inc(c[0]);
          c[c[0]]:=nho;
        end;
    end;

procedure print(var a:big); inline;
    var
      i,u,cs,k:longint;
    begin
      if a[0]=0 then
        begin
          writeln(f2,0);
          exit;
        end;
      write(f2,a[a[0]]);

      for i:=a[0]-1 downto 1 do
        begin
          u:=a[i]; cs:=0;
          while (u>0) do
            begin
              u:=u div 10;
              inc(cs);
            end;
          for k:=1 to lbase-cs do
            write(f2,0);
          write(f2,a[i]);
        end;
      writeln(f2);
    end;

procedure openF;
    begin
      assign(f1,FINP); reset(f1);
      assign(f2,FOUT); rewrite(f2);
    end;
procedure closeF;
    begin
      close(f1);
      close(f2);
      halt;
    end;

procedure inp;
    begin
      readln(f1,n);
      readln(f1,s1);
      readln(f1,s2);
      readln(f1,s);
    end;

function get(x:ansistring):longint;
    var
      i,c:longint;

        function check(start:longint):boolean;
        var
          i:longint;
        begin
          for i:=1 to length(s) do
            begin
              if s[i]<>x[start] then exit(false);
              inc(start);
            end;
          exit(true);
        end;

    begin
      if length(x)<length(s) then exit(0);
      c:=0;
      for i:=1 to length(x)-length(s)+1 do
        if check(i) then inc(c);
      exit(c);
    end;

procedure modify;
    begin
      now:=2;
      tmp:=s2;
      s2:=s2+s1;
      s1:=tmp;
      while min(length(s2),length(s1))<length(s) do
        begin
          if now=n then
            begin
              writeln(f2,get(s1));
              closeF;
            end;
          tmp:=s2;
          s2:=s2+s1;
          s1:=tmp;
          inc(now);
        end;
      if now>n then
        begin
          writeln(f2,0);
          closeF;
        end;
      if now=n then
        begin
          writeln(f2,get(s1));
          closeF;
        end;
      if now=n-1 then
        begin
          writeln(f2,get(s2));
          closeF;
        end;

      g[1,0]:=1; g[1,1]:=get(s2+s1)-get(s1)-get(s2);
      g[2,0]:=1; g[2,1]:=get(s1+s2)-get(s1)-get(s2);
    end;

procedure solve;
    var
      i,midtype,p1,p2,p3:longint;
    begin
      midtype:=1;
      p1:=1; p2:=2; p3:=3;
      f[1,0]:=1; f[1,1]:=get(s1);
      f[2,0]:=1; f[2,1]:=get(s2);
      for i:=now+2 to n do
        begin
          add(f[p1],f[p2],f[p3]);
          add(g[midtype],f[p3],f[p3]);

          if i=n then break;

          p1:=p2; p2:=p3; p3:=6-p1-p2;
          midtype:=3-midtype;
        end;

      print(f[p3]);
    end;

begin
  openF;
  inp;
  modify;
  solve;
  closeF;
end.

Download