Cod sursa(job #2394335)

Utilizator Mihai.PreguzaMihai Preguza Mihai.Preguza Data 1 aprilie 2019 15:57:39
Problema Cel mai lung subsir comun Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.98 kb
program lcs;
uses crt;
var i,j,k,max,a,b,aux:integer;
    s1,s2:string;
    t:array[0..1001,0..1001] of integer;
    ts1,ts2,tsir:array[0..1001] of char;
BEGIN
clrscr;
readln(s1);
readln(s2);
max:=0;

for i:=0 to length(s1)+1 do
        for j:=0 to length(s2) do
                t[i,j]:=0;

for i:=1 to length(s1) do ts1[i]:=s1[i];

for j:=1 to length(s2) do ts2[j]:=s2[j];

for i:=1 to length(s1) do
        for j:=1 to length(s2) do
                begin
                if ts1[i]=ts2[j] then
                        t[i,j]:=t[i-1,j-1]+1 else
                                if j=1 then t[i,j]:=t[i-1,j];

                if ts1[i]<>ts2[j] then
                        begin
                        if ts1[i-1]=ts2[j-1] then t[i,j]:=t[i-1,j];
                        if ts1[i-1]>ts2[j-1] then t[i,j]:=t[i-1,j];
                        if ts1[i-1]<ts2[j-1] then t[i,j]:=t[i,j-1];
                        end;

                if t[i,j]>max then max:=t[i,j];
                end;
aux:=max;
for i:=1 to length(s1) do
        for j:=1 to length(s2) do
                if t[i,j]=aux then
                        begin

                        a:=i;
                        b:=j;

                        repeat
                        if ts1[a]=ts2[b] then
                                begin
                                tsir[aux]:=ts1[a];
                                aux:=aux-1;
                                a:=a-1;
                                b:=b-1;
                                end      else

                        if ts1[a]<>ts2[b] then
                                begin

                                if t[a-1,b]>t[a,b-1] then
                                        a:=a-1;

                                if t[a-1,b]<t[a,b-1] then
                                        b:=b-1;
                                end;
                        until aux=0;
                        end;
for i:=1 to max do
        write(tsir[i]);
END.