TREEPATH - Đường đi trên cây

Tác giả: RR

Ngôn ngữ: Pascal

//Written by RR
{$Mode objfpc}
{$R-,Q-}
uses math;
const
  FINP		=	'';
  FOUT		=	'';
  MAXN		=	2000;
  scs		=	255;
  base		=	100000000;
  lbase		=	8;

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

var
  res,now,
  sl,tmp	:	big;
  s			:	ansistring;
  f1,f2		:	text;

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

procedure inp;
    begin
      readln(f1,s);
    end;

procedure add(a,b:big; var c:big); inline;
    var
      i,nho:longint;
    begin
      c[0]:=max(a[0],b[0]);
      nho:=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 dec(c[i],base); nho:=1; end;
        end;
      if nho=1 then
        begin
          inc(c[0]);
          c[c[0]]:=nho;
        end;
    end;

procedure mul(a:big; k:longint; var c:big); inline;
    var
      i,nho:longint;
    begin
      c[0]:=a[0];
      nho:=0;
      for i:=1 to c[0] do
        begin
          c[i]:=a[i]*k+nho;
          if c[i]<base then nho:=0
          else begin nho:=c[i] div base; c[i]:=c[i] mod base; end;
        end;
      if nho>0 then
        begin
          inc(c[0]);
          c[c[0]]:=nho;
        end;
    end;

procedure minus(a,b:big; var c:big); inline;
    var
      i,nho:longint;
    begin
      c[0]:=a[0];
      nho:=0;
      for i:=1 to c[0] do
        begin
          c[i]:=a[i]-b[i]-nho;
          if c[i]>=0 then nho:=0
          else begin inc(c[i],base); nho:=1; end;
        end;
      while (c[0]>0) and (c[c[0]]=0) do dec(c[0]);
    end;

procedure print(var a:big);
    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
              inc(cs);
              u:=u div 10;
            end;
          for k:=1 to lbase-cs do
            write(f2,'0');
          write(f2,a[i]);
        end;
      writeln(f2);
    end;

procedure solve;
    var
      i:longint;
    begin
      res[0]:=1; res[1]:=1;
      now:=res; sl:=res;
      for i:=1 to length(s) do
        case s[i] of
          'S': begin end;
          'L': begin
          		mul(now,3,now);
                add(now,res,res);
          	   end;
          'C': begin
          		mul(now,3,now);
                add(now,sl,now);
                add(now,res,res);
          	   end;
          'R': begin
          		mul(now,3,now);
                add(now,sl,now);
                add(now,sl,now);
                add(now,res,res);
          	   end;
          '*': begin
                mul(res,4,res);
                minus(res,now,res);

          		mul(sl,3,tmp);
                mul(sl,4,sl);

                mul(now,10,now);
                add(tmp,now,now);

                add(now,res,res);
          	   end;
        end;
      print(res);
    end;

begin
  openF;
  inp;
  solve;
  closeF;
end.

Download