Cod sursa(job #505715)

Utilizator lianaliana tucar liana Data 3 decembrie 2010 18:25:09
Problema Subsir Scor 90
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.89 kb
program subsir;
var f, g:text;
    max, rez, i, j, n, m, modulo:longint;
    c:char;
    a, b:widestring; {!}
    dra, drb:array[0..500,'a'..'z'] of longint;
    nr, lg:array[0..500,0..500] of longint;
    gasit:boolean;

procedure citire;
  begin
    while not seekeoln(f) do
      begin
        read(f,c);
        a:=a+c;
        n:=n+1;
      end;
    readln(f);
    while not seekeoln(f) do
      begin
        read(f,c);
        b:=b+c;
        m:=m+1;
      end;
  end;


procedure initializare;
  begin
    for i:=n downto 0 do
      begin
        dra[i]:=dra[i+1];
        if i<n then
          dra[i,a[i+1]]:=i+1;
      end;
    for i:=m downto 0 do
      begin
        drb[i]:=drb[i+1];
        if i<m then
          drb[i,b[i+1]]:=i+1;
      end;
  end;

procedure rezolvare;
  begin
    for i:=n downto 1 do
      for j:=m downto 1 do
        begin
          if a[i]=b[j] then
            lg[i,j]:=lg[i+1,j+1]+1
           else
             begin
               lg[i,j]:=lg[i,j+1];
               if lg[i+1,j]>lg[i,j] then
                 lg[i,j]:=lg[i+1,j];
             end;
          if a[i]=b[j] then
            begin
              for c:='a' to 'z' do
                if lg[dra[i,c],drb[j,c]]=lg[i,j]-1 then
                  nr[i,j]:=(nr[i,j]+nr[dra[i,c],drb[j,c]]) mod modulo;
              if nr[i,j]=0 then
                nr[i,j]:=1;
              if lg[i,j]>max then
                max:=lg[i,j];
            end;
        end;
  end;

procedure adunare;
  begin
    rez:=0;
    for c:='a' to 'z' do
      if lg[dra[0,c],drb[0,c]]=max then
        rez:=(rez+nr[dra[0,c],drb[0,c]]) mod modulo;
  end;

  begin
    assign(f,'subsir.in'); reset(f);
    assign(g,'subsir.out'); rewrite(g);
    citire;
    modulo:=666013;
    initializare;
    rezolvare;
    adunare;
    writeln(g,rez);
    close(f);
    close(g);
  end.