Cod sursa(job #43277)

Utilizator andrewgPestele cel Mare andrewg Data 29 martie 2007 22:47:33
Problema Subsir Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.71 kb
const maxn=501;
type sir = array[1..maxn]of char;
var f:text;
    a,b:sir;
    c:array[0..maxn,0..maxn]of integer;
    d:array[0..maxn,0..maxn]of sir;
    sol:array[1..1000000]of sir;
    ok:boolean;
    n,m,i,j,max,nr,k:longint;

procedure readdata;
begin
  assign(f,'subsir.in');
  reset(f);
  i:=0;
  while not eoln(f) do
  begin
    inc(i);
    read(f,a[i]);
  end;
  m:=i;
  readln(f);
  i:=0;
  while not eoln(f) do
  begin
    inc(i);
    read(f,b[i]);
  end;
  n:=i;
  close(f);
end;

procedure solve;
begin
  for i:=1 to m do
  begin
    c[i,0]:=0;
  end;
  for i:=1 to n do
  begin
    c[0,i]:=0;
  end;
  max:=0;
  for i:=1 to m do
  begin
    for j:=1 to n do
    begin
      if a[i]=b[j] then
      begin
        c[i,j]:=c[i-1,j-1]+1;
        d[i,j]:=d[i-1,j-1];
        d[i,j,c[i,j]]:=a[i];
        if c[i,j]>max then
        begin
          max:=c[i,j];
          nr:=0;
        end;
        if c[i,j]=max then
        begin
          ok:=false;
          for k:=1 to nr do
          begin
            if sol[k]=d[i,j] then
            begin
              ok:=true;
            end;
          end;
          if ok=false then
          begin
            inc(nr);
            sol[nr]:=d[i,j];
          end;
        end;
      end
                   else
      begin
        if c[i-1,j]>=c[i,j-1] then
        begin
          c[i,j]:=c[i-1,j];
          d[i,j]:=d[i-1,j];
        end
                              else
        begin
          c[i,j]:=c[i,j-1];
          d[i,j]:=d[i,j-1];
        end;
      end;
    end;
  end;
  for i:=1 to m do
  begin
    for j:=1 to n do
    begin
      if a[i]=b[j] then
      begin
        c[i,j]:=c[i-1,j-1]+1;
        d[i,j]:=d[i-1,j-1];
        d[i,j,c[i,j]]:=a[i];
        if c[i,j]>max then
        begin
          max:=c[i,j];
          nr:=0;
        end;
        if c[i,j]=max then
        begin
          ok:=false;
          for k:=1 to nr do
          begin
            if sol[k]=d[i,j] then
            begin
              ok:=true;
            end;
          end;
          if ok=false then
          begin
            inc(nr);
            sol[nr]:=d[i,j];
          end;
        end;
      end
                   else
      begin
        if c[i-1,j]>c[i,j-1] then
        begin
          c[i,j]:=c[i-1,j];
          d[i,j]:=d[i-1,j];
        end
                              else
        begin
          c[i,j]:=c[i,j-1];
          d[i,j]:=d[i,j-1];
        end;
      end;
    end;
  end;
end;

procedure writedata;
begin
  assign(f,'subsir.out');
  rewrite(f);
  writeln(f,nr mod 666013);
  close(f);
end;

begin
  readdata;
  solve;
  writedata;
end.