Cod sursa(job #879293)

Utilizator elffikkVasile Ermicioi elffikk Data 15 februarie 2013 10:54:34
Problema Cel mai lung subsir comun Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 0.98 kb
var a:array[0..1024,0..1024]of longint;
    x,y,z:array[1..1024] of longint;
    n,m,k:longint;     
    
procedure init;
var i:longint; f:text;
begin
  assign(f, 'cmlsc.in');
  reset(f);
  readln(f,n,m);
  for i:=1 to n do read(f, x[i]);
  for i:=1 to m do read(f, y[i]);
  close(f);
end;

procedure solve;
var i,j,i1,j1:longint;
begin
  for i:=0 to n do
    for j:=0 to m do
      a[i,j]:=0;
      
  for i:=1 to n do
    for j:=1 to m do
      if x[i]=y[j]
      then a[i,j]:=a[i-1,j-1]+1
      else a[i,j]:=max(a[i-1,j], a[i,j-1]);
  k:= a[n,m];  i1:=n; j1:=m; 
  for i:=k downto 1 do
  begin
    while a[i1-1,j1]=a[i1,j1] do dec(i1);
    while a[i1,j1-1]=a[i1,j1] do dec(j1);
    z[i]:=x[i1];
    dec(i1); dec(j1);
  end;
  
  
end;


procedure finish;
var i:longint; f:text;
begin
  assign(f, 'cmlsc.out');
  rewrite(f);
  writeln(f,k);
  for i:=1 to k do write(f,z[i],' ');    
  close(f);
end;

    
begin
  init;
  solve;
  finish;
end.