Cod sursa(job #974256)

Utilizator t.g.g.tt.g.g.t t.g.g.t Data 16 iulie 2013 18:05:15
Problema Subsir Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.61 kb
const cst=666013;

var cmlsc:array[0..500,0..500]of integer;
    sol:array[0..500,0..500]of longint;
    u1,u2:array[0..500,'a'..'z']of integer;
    s1,s2:array[1..500]of char;
    n,m,i,j:integer;
    c:char;
    z:byte;
    solf:longint;

begin
  assign(input,'subsir.in'); reset(input);
  i:=0;
  while not(eoln(input)) do begin inc(i); read(s1[i]) end; n:=i; readln;
  i:=0;
  while not(eoln(input)) do begin inc(i); read(s2[i]); end; m:=i;
  for i:=1 to n do
    for c:='a' to 'z' do
      if s1[i]=c then u1[i,c]:=i else u1[i,c]:=u1[i-1,c];
  for i:=1 to m do
    for c:='a' to 'z' do
      if s2[i]=c then u2[i,c]:=i else u2[i,c]:=u2[i-1,c];
  for i:=1 to n do
    for j:=1 to m do
      begin
        if s1[i]=s2[j] then cmlsc[i,j]:=cmlsc[i-1,j-1]+1;
        if cmlsc[i-1,j]>cmlsc[i,j] then cmlsc[i,j]:=cmlsc[i-1,j];
        if cmlsc[i,j-1]>cmlsc[i,j] then cmlsc[i,j]:=cmlsc[i,j-1];
      end;
  for i:=1 to n do
    for j:=1 to m do
      begin
        if s1[i]=s2[j] then
          begin
            z:=0;
            for c:='a' to 'z' do
              begin
                if (u1[i-1,c]>0) and (u2[j-1,c]>0) then
                  begin
                    if cmlsc[u1[i-1,c],u2[j-1,c]]=cmlsc[i,j]-1 then begin z:=1; sol[i,j]:=(sol[i,j]+sol[u1[i-1,c],u2[j-1,c]])mod cst; end;
                  end;
              end;
            if z=0 then sol[i,j]:=1;
            if cmlsc[n,m]=cmlsc[i,j] then if (u1[n,s1[i]]=i) and (u2[m,s2[j]]=j) then solf:=(solf+sol[i,j])mod cst;
          end;
      end;
  assign(output,'subsir.out'); rewrite(output);
  writeln(solf);
  close(output);
end.