Столкнулся с такой задачей: как в двух строках найти наибольшую общую подстроку.
Например:
Вход:

abcdef
bbcdm

Выход:
bcd

Пытался написать программу, но у меня получалась проблема в тех строках, у которых несколько одинаковых букв

Общие подстроки должны быть на техже местах или могут быть на разных:

abcdef

fdbcd34

выход:

bcd

?

function compare(S1,S2:string):string;
var
i,j,L1,L2,max:Integer;
Tmp:String;
begin
L1:=Length(S1);
L2:=Length(S2);
if L1<L2 then
begin
Result:='';
j:=0;
max:=0;
Tmp:='';
for i:=1 to L1 do
begin
if S1[i]=S2[i] then
begin
inc(j);
Tmp:=Tmp+S1[i];
if j>max then
begin
Result:=Tmp;
max:=j;
end;
end
else
begin
j:=0;
Tmp:='';
end;
end;
end
else
Result:=compare(S2,S1);
end;

или:
repeat
begin
a:=copy(s1,i,1);
b:=copy(s2,i,1);
if a=b then
begin
a1:=copy(s1,i+1,1);
b1:=copy(s2,i+1,1);
if a1=b1 then...
until i<=Length(s1);

Долго, много писать, но тоже способ

starmaster, поясни задание... Я тоже непонял этого...

Цитата(VIY @ 3.11.2004, 08:54)

Общие подстроки должны быть на техже местах или могут быть на разных:

Если они могут быть на разных то будет много гемора, а если наибольшие общие строки имеют одну нумерацию символов, то легко.

Это сообщение отредактировал(а) Zero - 9.12.2004, 19:16

У меня вроде бы работает вот такой код.

function TForm1.Cross(const S1, S2: string): string;
Var
Sb,Sm,Ss,Sr:string;
i,j:integer;
begin
if length(S1)>length(S2) then
begin
Sb:=S1;
Sm:=S2;
end else
begin
Sm:=S1;
Sb:=S2;
end;

Sr:='';
for i:=1 to length(Sm) do
for j:=1 to length(Sm)-i+1 do
begin
ss:=copy(Sm,i,j);
if (pos(ss,Sb)>0) and (length(ss)>length(Sr)) then Sr:=ss;
end;
Result:=Sr;
end;

На самом деле - стандартный алгоритм динамического программирования LCS - Longest Common Subsequence

Код

program LCS;  {Longest Common Subsequence} var s1,s2,s:string; i,j,n1,n2:word; L:array[0..100,0..100] of word; fin,fout:text; function max(d1,d2:word):word; var max1:word; begin  max1:=d1;  if d2>max1 then max1:=d2;  max:=max1; end; begin assign(fin,'LCS.dat');reset(fin); readln(fin,s1); readln(fin,s2); close(fin); n1:=length(s1); n2:=length(s2); {===============================} for i:=0 to n1 do  for j:=0 to n2 do   L[i,j]:=0; {===============================} for i:=1 to n1 do  for j:=1 to n2 do begin   if i*j = 0 then L[i,j]:=0 else   if s1[i] = s2[j] then L[i,j]:=L[i-1,j-1] +1 else   L[i,j]:=max(L[i,j-1],L[i-1,j]);                    end; {===============================} i:=n1; j:=n2; while i*j<>0 do begin  if s1[i] = s2[j] then begin s:=s1[i] + s; i:=i-1; j:=j-1; end else  if L[i,j-1] >L[i-1,j] then j:=j-1 else i:=i-1;                 end; {===============================} assign(fout,'LCS.sol');rewrite(fout); writeln(fout,L[n1,n2]); writeln(fout,s); close(fout); end.

Добавлено @ 13:26
З.Ы. Код на пакале, так что если нужно в Делфи, измени ввод-вывод строк