Форум программистов [Powered by Invision Power Board]

Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате

Форум программистов > Delphi: Общие вопросы > Строки

Автор: starmaster 1.11.2004, 19:04

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

abcdef
bbcdm

Выход:
bcd

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

Автор: VIY 3.11.2004, 08:54

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

abcdef

fdbcd34

выход:

bcd

?

Автор: VIY 3.11.2004, 09:12

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;

Автор: Vladimir13 9.12.2004, 13:07

или:
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);

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

Автор: Zero 9.12.2004, 19:15

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

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

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

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

Автор: Bes 11.12.2004, 13:22

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

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;

Автор: Fedor 11.12.2004, 13:24

На самом деле - стандартный алгоритм динамического программирования 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
З.Ы. Код на пакале, так что если нужно в Делфи, измени ввод-вывод строк