Top.Mail.Ru
Мастера DELPHI, Delphi programming community Титульная страница Поиск, карта сайта Написать письмо 
| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL |
| Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

« предыдущая ветвь | форум | следующая ветвь »

Динамическое програмирование. Подпалендром. [D7, WinXP]


Страницы:   1 2 3 4 5 6 7 8 9 10 ... 13 14

rodion ©   (2010-05-07 07:30:00) 

Палиндромом называется строка, которая одинаково читается как слева направо, так и справа налево. Подпалиндромом данной строки называется последовательность символов из данной строки, не обязательно идущих подряд, являющаяся палиндромом. Например, HELOLEH является подпалиндромом строки HTEOLFEOLEH. Напишите программу, находящую в данной строке подпалиндром максимальной длины.

есть код задачи, который нужно исправить, для правильной работы:

program Project6;

{$APPTYPE CONSOLE}

uses
SysUtils;
var
Mat:array[1..100,1..100]of integer;
s:string;
s1:string;
i,j,n,d,j1,k,maxj,maxi:integer;

Function F(i, j : Integer) : Integer;
var Ch : Char; R1, R2 : Integer; k : byte;
begin
if Mat[i, j] = -1 then
BEGIN
k := j;
while s[i] <> s[k] do dec(k);
R1 := F(i + 1, j);
if i <> k then R2 := F(i + 1, k - 1) + 2 else R2 := 1;
if R1 > R2 then Mat[i, j] := R1 else Mat[i, j] := R2
END;
F := Mat[i, j]
end;

begin
try
{ TODO -oUser -cConsole Main : Insert code here }
except
on E:Exception do
Writeln(E.Classname, ': ', E.Message);
end;
readln(s);
for I:=1 to length(s) do
for j := 1 to length(s) do
if i=j then Mat[i,j]:=1
else if i>j then Mat[i,j]:=0
else mat[i,j]:=-1;
maxi:=0;maxj:=0;
for i:=1 to length(s) do
for j:=1 to length(s) do
begin
Mat[i,j]:=f(i,j);
if (j-i+1>maxj-maxi+1)and(j-i+1=Mat[i,j]) then
begin
maxi:=i;
maxj:=j;
end;
end;
writeln(maxj-maxi+1);
writeln(copy(s,maxi,maxj-maxi+1));
readln;
end.

Заранее спасибо!


Sha   (2010-05-13 16:15:00) [1]

В выкушенном коде MatrixDP на Mat забыл заменить во втором случае


Sha   (2010-05-13 16:13:00) [2]

> Родион   (13.05.10 16:00) [276]
> а как на сччет
>  //тут твои 15 строчек

Ну, выкуси код из [271]

w:=Mat[1,Length(s)];
SetLength(t,w);
i:=1; j:=Length(s); k:=1;
while w>0 do begin;
  while (i<j) and (MatrixDP[i+1,j]=w) do inc(i);
  t[k]:=s[i];
  t[Length(t)+1-k]:=s[i];
  inc(k);
  while s[i]<>s[j] do dec(j);
  dec(j);
  w:=w-2;
  end;


добавь вывод результата

 WriteLn(t);


и объявления

var
i, j, k, w: integer;
s, t: string;


только это не "два биолога", а обычное ДП


Родион   (2010-05-13 16:00:00) [3]


> Но ты сказалЮ что тебе нужен другой алгоритм (2х биологов)

нельзя ли по этому алгоритму решить задачу?

кодировки [268] и [271] слишком сложные, хоть может и правильно работают. но у меня вылазят слишком много ошибок.

а как на сччет

program MaxPalendrom2;
{$APPTYPE CONSOLE}
uses SysUtils;

const max = 100;
var Mat: array[1..max, 1..max] of integer;

procedure FillPalMatrix(const s: string);
var
 i, j, t, count, found: integer;
begin
 for j:= 1 to n do begin
   Mat[j, j]:= 1;
   for i:= j - 1 downto 1 do begin
     count:= Mat[i + 1, j];
     t:=j;
     while s[t] <> s[i] do dec(t);
     found:= t - i + 1;
     if t >= i + 2 then found:= Mat[i + 1, t - 1] + 2;
     if count < found then count:= found;
     Mat[i, j]:= count;
   end;
 end;
end;

var
 s: string;
begin
 readln(s);
 FillPalMatrix(s);
 / /тут твои 15 строчек
end.


turbouser   (2010-05-13 15:09:00) [4]


> Родион   (13.05.10 15:03) [274]
>
> удалить всю процедуру или только строчку?
>

строчку


Родион   (2010-05-13 15:03:00) [5]

удалить всю процедуру или только строчку?


Sha   (2010-05-13 09:25:00) [6]

Наверно, 99% приложений для Windows - оконные, да и отлаживаться обычно удобнее в оконном приложении, поэтому в исходниках ты видишь формы, едиты, мемы и разные кнопки :)

В твоем случае просто удали

procedure TForm1.Button2Click(Sender: TObject);

а для ввода/вывода используй ReadLn/WriteLn


Родион   (2010-05-13 09:10:00) [7]


> procedure TForm1.Button2Click(Sender: TObject);

что за кнопка? выдает ошибку в процедуре на TForm1, если {$APPTYPE CONSOLE}.


> > Я за такую фигню денег не беру,> но если считаешь, что
> сайт тебе был чем-то полезен можешь > оказать помошь сайту.
> +1 http://www.delphimaster.ru/donate.html

уже видел, правила читал :) обязательно положу, только в пределах разумного)


Sha   (2010-05-13 03:02:00) [8]


//Палиндромом называется последовательность символов, которая одинаково
//читается слева направо и справа налево. Требуется найти в данной строке
//подпоследовательность-палиндром макcимальной длины, используя алгоритм
//динамического программирования.

//Решим эту задачу для палиндромов двух типов:
//палиндромов-подпоследовательностей, когда пропуск символов исходной строки разрешается,
//и палиндромов-подстрок, когда пропуск запрещен.

const
 MaxStrLen= 256;
type
 TMatrixDP= array[1..MaxStrLen,1..MaxStrLen] of integer;
var
 MatrixDP: TMatrixDP;

//FillMatrixDP заполняет матрицу длинами палиндромов, так что
//элемент MatrixDP[i,j] содержит длину наибольшего палиндрома, образованного некоторыми
//символами подстроки s[i..j], идущими в том же порядке, что и в строке s.
//Очевидно, MatrixDP[i,i]=1. Другие значения вычисляются рекурсивно.
//Подстроку s[i..j] (i<j) можно получить приписыванием символа s[i]
//к подстроке s[i+1..j]. Если при этом не образуется максимального палиндрома, то
//полагаем MatrixDP[i,j]=MatrixDP[i+1,j]. Если образуется, то в подстроке s[i..j],
//перебирая символы, начиная с позиции j, находим ему пару.
//Если пара находится в позиции i, то MatrixDP[i,j]=1,
//если в позиции i+1, то MatrixDP[i,j]=2,
//если в позиции t (i+2<=t<=j), то MatrixDP[i,j]=MatrixDP[i+1,t-1] + 2.
procedure FillMatrixDP(const s: string);
var
 i, j, t, count, found: integer;
begin;
 for j:=1 to length(s) do begin;
   MatrixDP[j,j]:=1;
   for i:=j-1 downto 1 do begin;
     count:=MatrixDP[i+1,j];
     t:=j;
     while s[t]<>s[i] do dec(t);
     found:=t-i+1;
     if t>=i+2 then found:=MatrixDP[i+1, t-1]+2;
     if count<found then count:=found;
     MatrixDP[i,j]:=count;
     end;
   end;
 end;

procedure TForm1.Button2Click(Sender: TObject);
var
 i, j, maxi, maxj, k, w: integer;
 s, t: string;
begin;
 //Вводим исходную строку и строим матрицу длин палиндромов
 s:=Edit1.Text;
 if Length(s)>MaxStrLen then exit;
 FillMatrixDP(s);

 //Найдем палиндром-подпоследовательность (пропуски символов исходной строки допустимы)
 w:=MatrixDP[1,Length(s)];
 SetLength(t,w);
 i:=1; j:=Length(s); k:=1;
 while w>0 do begin;
   while (i<j) and (MatrixDP[i+1,j]=w) do inc(i);
   t[k]:=s[i];
   t[Length(t)+1-k]:=s[i];
   inc(k);
   while s[i]<>s[j] do dec(j);
   dec(j);
   w:=w-2;
   end;
 Memo1.Lines.Add(t);

 //Найдем палиндром-подстроку (пропуски символов исходной строки запрещены)
 maxi:=0;
 maxj:=0;
 for j:=1 to length(s) do for i:=j downto 1 do
 //Если длина палиндрома равна количеству символов подстроки,
 //то палиндром является подстрокой
 if (j-i+1>maxj-maxi+1) and (j-i+1=MatrixDP[i,j]) then begin;
   maxi:=i;
   maxj:=j;
   end;
 Memo1.Lines.Add(copy(s,maxi,maxj-maxi+1));
 end;


Германн   (2010-05-13 02:59:00) [9]

Хотя "реализация программы" это только первый этап.


Германн   (2010-05-13 02:37:00) [10]


> Я за такую фигню денег не беру,
> но если считаешь, что сайт тебе был чем-то полезен можешь
> оказать помошь сайту.

+1
http://www.delphimaster.ru/donate.html

Пожалуй сей топик - это первый пример на ДМ, когда новичку (я бы высказался ещё более грубо, но не хочу пока) дали не только пример, но практически полный урок от Мастера по конкретному вопросу.


Sha   (2010-05-13 02:24:00) [11]


//Палиндромом называется последовательность символов, которая одинаково
//читается слева направо и справа налево. Требуется найти в данной строке
//подпоследовательность-палиндром макcимальной длины, используя алгоритм LCS

const
 MaxStrLen= 256;
type
 TMatrixLCS= array[0..MaxStrLen, 0..MaxStrLen] of integer;
var
 MatrixLCS: TMatrixLCS;

//Первая фаза алгоритма LCS. Заполняем матрицу длинами подпоследовательностей.
//Пусть у нас есть строки s1[1..n1] и s2[1..n2].
//Тогда после работы первой стадии алгоритма LCS элемент M[i,j] матрицы будет
//содержать длину наибольшей общей подпоследовательности строк s1[1..i] и s2[1..j].
procedure FillMatrixLCS(const s1, s2: string);
var
 Col, Row, Val: integer;
begin;
 for Col:=0 to Length(s1) do MatrixLCS[0,Col]:=0;
 for Row:=0 to Length(s2) do MatrixLCS[Row,0]:=0;

 for Col:=1 to Length(s1) do
   for Row:=1 to Length(s2) do
     if s2[Row]=s1[Col]
     then MatrixLCS[Row,Col]:=MatrixLCS[Row-1,Col-1] + 1
     else begin;
       Val:=MatrixLCS[Row,Col-1];
       if Val<MatrixLCS[Row-1,Col] then Val:=MatrixLCS[Row-1,Col];
       MatrixLCS[Row,Col]:=Val;
       end;
 end;

//Вторая фаза алгоритма LCS.
//Строим наибольшую общую подпоследовательность строк s1[1..Col] и s2[1..Row].
function GetCellLCS(Col, Row: integer; const s1, s2: string): string;
begin;
 Result:='';
 while (Col>0) and (Row>0) do
   if s1[Col]=s2[Row] then begin;
     Result:=s1[Col] + Result;
     dec(Col);
     dec(Row);
     end
   else if MatrixLCS[Row,Col-1]>MatrixLCS[Row-1,Col]
        then dec(Col)
        else dec(Row);
 end;

procedure TForm1.Button1Click(Sender: TObject);
var
 s1, s2, s3: string;
 Col, Row, MaxCol, MaxRow, Val, MaxVal: integer;
 IsEvenLength, MaxIsOddLength: boolean;
begin;
 //Вводим исходную строку и строим матрицу длин наибольших общих подпоследовательностей
 //для исходной и перевернутой строки при помощи первой фазы алгоритма LCS
 s1:=Edit1.Text;
 if Length(s1)>MaxStrLen then exit;
 s2:=ReverseString(s1);
 FillMatrixLCS(s1, s2);

 //Было бы ошибкой сейчас просто вызвать вторую фазу алгоритма
 //и завершить работу, например, так:
 //Edit2.Text:=GetCellLCS(Length(s1), Length(s2), s1, s2);
 //Вторая фаза вернет наибольшую общую подпоследовательность, которая может
 //оказаться не палиндромом, например, для s1=12312 и s2=21321 может вернуться
 //132 или 231 вместо 121, 131, 212, 232.

 //Пусть длина исходной строки равна L. Мы найдем максимальный палиндром, если
 //будем искать максимальную общую подпоследовательность для L всевозможных
 //пар строк, образованных ее началом длины Y=1..L первернутым хвостом длины
 //X=L+1-Y. Все длины всех таких подпоследовательностей лежат на неглавной
 //диагонали матрицы. Поэтому ищем максимальный элемент на диагонали.
 MaxCol:=0; MaxRow:=0; MaxVal:=0; MaxIsOddLength:=false;
 for Col:=1 to Length(s1) do begin;
   Row:=Length(s1) + 1 - Col;
   Val:=MatrixLCS[Row,Col];
   if MaxVal<=Val then begin;
     //Символ, соответствующий элементу главной диагонали, лежит в центре
     //палиндрома четной длины, если выполняются следующие условия:
     IsEvenLength:=(Col>1)                        //символ не первый
               and (s1[Col]=s2[Row+1])            //предыдущий символ ему равен
               and (Val=MatrixLCS[Row+1,Col-1]);  //длины LCS для них совпадают
     //четный палиндром предпочтительнее при одинаковых значениях элементов
     if (MaxVal<Val) or IsEvenLength then begin;
       MaxVal:=Val;
       MaxIsOddLength:=not IsEvenLength;
       MaxRow:=Row;
       MaxCol:=Col;
       end;
     end;
   end;

 //Вызываем вторую фазу алгоритма LCS, чтобы найти половину палиндрома
 s3:=GetCellLCS(MaxCol, MaxRow, s1, s2);

 //Зеркально отражаем начало в хвост и выводим результат
 SetLength(s3, 2 * Length(s3) - ord(MaxIsOddLength));
 for Col:=1 to Length(s3) div 2 do s3[Length(s3)+1-Col]:=s3[Col];
 Edit2.Text:=s3;
 end;


Sha   (2010-05-12 22:31:00) [12]

Вот пример, про который я говорил, показывающий что твоя училка не права или, точнее, не совсем права.

Возьмем, например, строку    s1=12312,
для нее перевернутая строка s2=21321
Существует 5 LCS длины 3: 121, 131, 132, 231, 232,
из которых только 3 являются палиндромами.

Если восстанавливать LCS из угла, то ты можешь получить любую из них.
Поэтому нельзя просто взять и показать любую LCS, придется заморачиваться с ее проверкой на палиндромность и писать код для выбора следующей LCS без повторений. И вообще надо еще доказать, что среди LCS будет нужный тебе палиндром (хотя, похоже, это на самом деле так).


Sha   (2010-05-12 21:55:00) [13]

> Родион   (12.05.10 18:02) [263]

Перестань рисовать матрицу вверх ногами.


> как заполнить то я его знаю, как это реализовать в коде

тебе, что не понятны формулы в той ссылке?
или ты не можешь в цикле присвоить значения элементам массива?


> Родион   (12.05.10 18:07) [264]
> разве FillPalMatrix так ее заполняет?

Конечно не так.
Она заполняет по первому (самописному алгоритму из [206]
Но ты сказалЮ что тебе нужен другой алгоритм (2х биологов)


> вобщем я так понял, сам я наверно врядли что напишу..

Ну если опустил руки, жди когда причешу свой код.
Но я тебе советую попробовать понять, что и как по описаниям и по этой ветке, иначе код для тебя будет загадкой.


> готов заплатить, за реализацию программы

Я за такую фигню денег не беру,
но если считаешь, что сайт тебе был чем-то полезен можешь оказать помошь сайту.


Родион   (2010-05-12 20:21:00) [14]


> Sha

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


Родион   (2010-05-12 18:07:00) [15]

разве FillPalMatrix так ее заполняет?


Родион   (2010-05-12 18:02:00) [16]

1) 2) 3) 4) 5) 6) 7) 8) 9) 10) 11)
1)   1  2  2  3  4  4   5  5  5   6   7  
2)   1  2  2  3  4  4   5  5  5   6   6  
3)   1  1  2  3  4  4   5  5  5   6   6  
4)   1  1  2  3  4  4   4  5  5   5   5  
5)   1  1  2  3  4  4   4  4  5   5   5  
6)   1  1  2  3  3  4   4  4  4   5   5  
7)   1  1  2  3  3  3   4  4  4   5   5  
8)   1  1  2  3  3  3   3  4  3   3   3  
9)   1  1  2  2  3  3   3  3  3  3   3  
10) 1  1  2  2  2  2   2  2  2   2   2  
11) 1  1  1  1  1  1  1  1  1  1  1

как его заполнить, то есть как заполнить то я его знаю, как это реализовать в коде?


Sha   (2010-05-12 17:55:00) [17]

Биологи рисуют первую строку последней, вторую - предпоследней, и т.д.


Родион   (2010-05-12 17:52:00) [18]

вывести результат и здача решена. вот все что мне сказал препод


Родион   (2010-05-12 17:51:00) [19]

и надо после этого просто спустится от 7 по жирным цифрам. я скопировал, их тут не видно


Родион   (2010-05-12 17:50:00) [20]

если это так и есть то почему у биологов заполнение матрицы:

  1) 2) 3) 4) 5) 6) 7) 8) 9) 10) 11)
1)   1  2  2  3  4  4   5  5  5   6   7  
2)   1  2  2  3  4  4   5  5  5   6   6  
3)   1  1  2  3  4  4   5  5  5   6   6  
4)   1  1  2  3  4  4   4  5  5   5   5  
5)   1  1  2  3  4  4   4  4  5   5   5  
6)   1  1  2  3  3  4   4  4  4   5   5  
7)   1  1  2  3  3  3   4  4  4   5   5  
8)   1  1  2  3  3  3   3  4  3   3   3  
9)   1  1  2  2  3  3   3  3  3  3   3  
10) 1  1  2  2  2  2   2  2  2   2   2  
11) 1  1  1  1  1  1  1  1  1  1  1


Страницы:   1 2 3 4 5 6 7 8 9 10 ... 13 14

Наверх

Титульная страница Поиск, карта сайта Написать письмо