если даны два списка чисел и нужно найти наибольшую одинаковую последовательность чисел, например, если дано:
1 2 3 4 5 6
1 2 6 2 3 4
то должен вывести 234
подскажите пожалуйста, каким алгоритмом тут лучше воспользоваться?

попробовала написать программу для 2х массивов, которая выдаст длину наибольшей общей последовательности, но что-то не совсем получилось

 
var
a: array [1..10] of integer;
a1: array [1..10] of integer;
k,i,j,i1,j1,kmax: integer;

begin
for i:=1 to 10 do
read(a[i]);
for j:=1 to 10 do
read(a1[j]);
i:=1;
while i<= 10 do begin
  for j:= 1 to 10 do begin
  if a[i]=a1[j] then begin
         i1:=i;
         j1:=j;
         while a[i1]=a1[j1] do begin
         k:=k+1;
         i1:=i1+1;
         j1:=j1+1;
         end;
         if k>kmax then kmax:=k;
         k:=0;
         end;
         end;
  i:=i+1;
  end;
writeln(kmax);
end.

 

.

не подскажете где ошибка? или это вообще неудачная идея так решать данную задачу?

Это задача о Наибольшей Общей Подпоследовательности. Динамическое программирование.

Как решать - можно посмотреть здесь: Пример №2

> не подскажете где ошибка?

Ну, например, что происходит, когда i1 и j1 становятся больше 10? Впрочем,

> это вообще неудачная идея так решать данную задачу

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

Надо делать, как по ссылке. Вот только там нет опечатки?
Вот в этом месте:

в другой книге написано в одной строчке по-другому немного:

 else if c[i-1,j] >= c[i,j-1] then ...

а я вообще не могу понять, где что делается(

Добавлено через 5 мин.


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

> в другой книге написано в одной строчке по-другому немного:

А вот если там >= вместо =, то это уже ближе к истине.
Правда, время за O(m*n) всё равно странно. Там вроде можно за O(m+n). Или я это путаю с поиском подстроки...

> а если ввести ограничения, то все равно что-то не то

Ну ввёл.

while (i1<=10) and (j1<=10) and (a[i1]=a1[j1]) do begin

У меня всё работает. Надо граничные условия проверять до сравнения элементов. Чтобы в случае выхода за границы элементы не сравнивались. А вообще, этот алгоритм недостоин того, чтобы его отлаживать.

Добавлено через 11 мин.
Хотя не, то, что по ссылке, тоже неверно. Для abc и bac возвращает 2.
А потому, что если длина НОП для ab и ba равна 1 и следующий добавленный элемент и там и там c, то вовсе не значит, что длина НОП для abc и bac равна 2. С чего этому НОПу быть именно в конце у обоих?

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

алгоритмы, которые я смотрела, считают, что, если заданы строки:
123 и 1523, то наибольшая общая подпоследовательность будет 123 (наверное, это из определения подпоследовательности),
а мне нужно было решить задачу, чтобы выводилось 23.
Поэтому не могу найти алгоритм, который подойдет, а в алгоритме по ссылке что-то разобраться до сих пор не могу, может он тоже ищет подпоследовательность, как в первом случае?(если дано: 123 и 1523, то выдает 123)

> Поэтому не могу найти алгоритм, который подойдет, а в алгоритме по ссылке что-то разобраться до сих пор не могу, может он тоже ищет подпоследовательность, как в первом случае?

Выходит, что так.
Всё, теперь я тоже врубился, почему такой результат. Ну да, тут-то надо подпоследовательность подряд идущих элементов, а тот алгоритм ищет и раскиданную подпоследовательность.
Но тут тоже надо подумать над оптимизацией. Пока что есть O(m*n*min(m,n)), короче кубическая сложность.

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

А, в википедии же есть аналогичный алгоритм, но как раз для подстрок, а не подпоследовательностей, ровно то, что тут надо: http://ru.wikipedia.org/wiki/Наибольшая_общая_подстрока

http://e-maxx.ru/algo/suffix_automata

Тут уже за o(m+n)
Я проверил, слово в слово переписал сишный алгоритм на паскаль, вроде работает.
Впрочем, вряд ли вам задавали суффиксные автоматы, это уже дебри пошли.

Спасибочки большое!!!)))
ну да, это уже все сложно, но ради интереса попробую разобраться)))

Ты обязательно попробуй, но сначала я бы советовал разобраться с тем, что ты сама сделала )). Можно дать несколько советов?

Посмотри - это твой код, немного улучшенный:

const
  n=10;
var
  a,b: array [1..n] of integer;
  i,j,k,kmax: integer;

begin
  for i:=1 to n do read(a[i]);
  for j:=1 to n do read(b[j]);
  kmax:=0;
  for i:=1 to n do
    for j:= 1 to n do begin
      k:=0;
      while a[i+k]=b[j+k] do Inc(k);
      if k>kmax then kmax:=k
    end;
  writeln(kmax)
end.

Далее, в порядке "прихода в голову", а не в порядке важности:

1. Всегда старайся избегать явного указания чисел в программе, заводи константы (у меня - n).

2. Почему у тебя по i цикл while, а по j - for?

3. ВСЕ переменные перед использованием должны быть инициированы (у тебя не инициированы k и kmax).

4. Твои if и while внутри цикла выполняют выполняют одну и ту же функцию - объедини их )).

5. Избегай лишних переменных.

6. Не нужно дважды объявлять один тип там, где это _не_нужно_. Формально твои а и а1 принадлежат к разным типам. Тут это не важно, но в принципе может вызвать проблемы.

7. форматирование кода - не для красоты, оно имеет четкие правила, которых необходимо придерживаться - иначе утонешь в коде большем, чем одна страница.. Возьми за пример мой код, попробуй вывести правила из его формата.

А вообще - +1 за то, что сама решаешь )).

Буду только благодарна!))

 while a[i+k]=b[j+k] do Inc(k);
 

.
не утверждаю, но возможно, тут не хватает еще одного условия?
За алгоритм спасибо, он гораздо лучше моего)


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

Тут было написано для двух массивов, а в задаче 2 динамических списка. Можно ли данный алгоритм преобразовать к этой задаче или проще 2 списка изначально заменить двумя динамическими массивами?


спасибо)

что-то совсем у меня со списками ничего не получается, пыталась изменить ваш алгоритм под свою задачу, но не выходит пока(

 type
	TWordStr = integer;
	PTItem = ^TItem;
	TItem = record
	            Data: TWordStr;
	            next: PTItem;
	end;
	TWordList = record
	first, last, head: PTItem;
	end;
var
kmax,k: integer;
L,L1: TWordList;
p, p1: PTItem;

...
begin
...
p:=L.first;
p1:=L1.first;
while p<>nil do begin
  while p1<>nil do begin
  k:=0;
    while (p<> nil) and (p1<>nil) and (p^.Data = p1^.Data) do
      begin
      k:=k+1;
      p:=p^.next;     
      p1:=p1^.next; 
      end;
      if k>kmax then kmax:=k;
      end;
      end;
    p:=p^.next;  //до этого значение уже было изменено, и теперь тут не то, что нужно
    p1:=p1^.next; //а как исправить?
    end;
     writeln(kmax);
end. 

не могли бы вы помочь разобраться?

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

  p := L.first;
  while p <> nil do
  begin

    p1 := L1.first; { <--- Это по поводу начала внутреннего цикла }
    while p1 <> nil do
    begin
      k := 0;
      pp := p; pp1 := p1; { А это - доп. переменные }
      while (pp <> nil) and (pp1 <> nil) and (pp^.Data = pp1^.Data) do
      begin
        inc(k);
        pp := pp^.next;
        pp1 := pp1^.next;
      end;

      if k > kmax then kmax := k;

      p1 := p1^.next; { продолжаем внутренний цикл }
    end;

    p := p^.next; { Продолжаем цикл внешний }
  end;
  writeln(kmax);

Спасибо большое!!! теперь все стало гораздно понятнее))

А если после того, как нашли эту подстроку, нужно ее удалить, то как это сделать можно? Знаю, как удалить один элемент, а вот как удалить подстроку из списка не понимаю (
Подскажите пожалуйста как поступить, заранее спасибо!)

*оля*, тут возможны 2 варианта...

Первый (я буду удалять подпоследовательность из ПЕРВОГО списка, а не из второго):

{ Чуть-чуть изменяем цикл поиска (нам понадобится еще одна переменная)}
      if k > kmax then 
      begin
        kmax := k; p_del := p; { <--- Запоминаем, откуда начиналась самая длинная послед-ть }
      end;

  { И после окончания циклов: }
  p := p_del; { Запоминаем, где начиналась последовательность. Оно чуть ниже пригодится }

  { Удаляем обычным способом kmax элементов, начиная с запомненного }
  for i := 1 to kmax do
  begin
    pp := p_del;
    p_del := p_del^.next;
    dispose(pp);
  end;

  {
    А теперь проверяем, не равен ли L.first тому, запомненному адресу начала 
    последовательности. Если равен - значит наибольшая последовательность
    была в самом начале списка, тогда все очень просто: началом списка будем
    считать p_del, он теперь содержит адрес элемента, следующего за последним
    удаленным...

    А вот если последовательность начиналась не с начала списка - то чуть
    сложнее, надо найти тот элемент, который _указывает_ на место, где раньше
    была последовательность... То есть, тот, что находился ПЕРЕД ней. Найдем
    его, и его NEXT поменяем на p_del...
  }
  if L.first = p then L.first := p_del
  else begin
    pp := L.first;
    while pp^.next <> p do pp := pp^.next;
    pp^.next := p_del;
  end;

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

Это был первый способ. Второй похож, но немного отличается - не удалять элементы один за одним в цикле, а просто пропускать их (переходить к следующему). Как только дошли до конца нашей последовательности, "обрубаем" список NIL-ом и чуть-чуть подправляем указатели так, чтобы "вырезанный" кусок был отдельно, а то, что было ПЕРЕД и ПОСЛЕ него - склеиваем в одно. Это не так сложно, как кажется, достаточно нарисовать на бумажке список и посмотреть, куда какие связи надо установить...

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

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

volvo, вы как всегда меня спасаете, спасибо большое!!!!

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

сейчас хочу сделать цикл:

repeat 

- найти длину наибольшей общей подстроки;
-удалить найденную подстроку из списков;
- сложить все найденные длины наибольших общих подстрок;
(в общем все то, что вы мне уже помогли реализовать)

until kmax<=10;  <--- но здесь наверняка не хватает  чего-то? или вообще так нельзя будет организовать цикл?

если так и писать цикл, то делает один раз только все.
И нужно ли писать в конце "пока kmax<=10 или количество компонентов списка1 или списка2 равно 0"? я запуталась, помогите пожалуйста)

А что будет делать этот цикл, расскажешь? Чего ты добиться хочешь?

хочу найти наибольшую подстроку в 2х списках - и удалить ее.
в полученных списках снова найти наибольшую подстроку - и снова удалить.
и так до тех пор, пока наибольшая подстрока не будет меньше или равна 10.
а все это для того, чтобы потом получить значение суммы всех найденных kmax.
вот как-то так)

Ну, так и будет, если не ошибаюсь:

sum := 0;
repeat

  kmax : = { тут находишь kmax }
  if kmax > 10 then begin
    sum := sum + kmax;
    { Что там тебе еще надо было? Удалять подпоследовательности? Удаляем здесь }
  end;

until kmax <= 10; { Как только kmax станет меньше 11, цикл закончится }

А что, не работает? Или что-то неправильно делает?

ну вот без цикла делает все как надо, а как пишу цикл, то выдает ошибку:  Ошибка: попытка разыменовать нулевой указатель А почему выдает не понятно...

Полный код (в виде PAS-файла) присоедини, посмотрим почему ошибка возникает...

правда с оформлением проблемы, не умею я пока оформлять(

*оля*, а причина - тривиальна, и Андрей уже говорил о ней: обнулить kmax надо. Если б ты это сделала в программе, то при оборачивании куска программы циклом, задумалась бы, а не надо ли инициализацию переменной делать внутри цикла. А так - нет и нет ее, и ничего не приходит в голову... Все просто:

{ Вот начало твоего цикла }
sum := 0;
repeat

  kmax := 0; { <--- Фокус вот в этом !!! }

  p := L.first;
  { ... }

Добавляешь инициализацию и все работает.

Теперь - почему это НЕ работало без обнуления переменной... Хотя нет. Давай, не я расскажу тебе, почему это не работало, а ты разберешься и расскажешь? Договорились?

Добавлено через 7 мин.
P.S. Если тебе надо удалять подпоследовательность из обоих списков - я бы вынес этот код в отдельную процедуру и вызывал бы ее дважды с разными параметрами. Так будет лучше.

да, действительно работает!)


, просто мы каждый раз искали наибольшую общую подстроку заново, и поэтому на входе kmax должно было ровняться 0, а до исправления ошибки оно в начале цикла ровнялось длине предыдущей подстроки. И следовательно условие k > kmax не может больше выполниться.
Ну вот, наверное, так)

Спасибо большое, я эту ошибку без вашей помощи не нашла бы!)

А между тем, на нее было указано еще в посте №13.. Ты читаешь ответы полностью или так - по диагонали? постарайся обращать внимание на то, что говорят - сэкономишь как свое время, так и чужое..

Обнаружить ошибку подобного рода на самом деле предельно просто - достаточно наконец обратить внимание на то, что пытается тебе сказать компилятор (warning'и). Считай его в некотором роде участником форума.. ))

А, вообще, общее правило таково: ВСЕ переменные должны быть инициированы.

3. ВСЕ переменные перед использованием должны быть инициированы (у тебя не инициированы k и kmax).
Да, вы уже говорили об этом, я все внимательно читаю. Я сделала инициализацию,но не там, где надо. Программа работала, а как появилась необходимость немного изменить задачу, то уже забыла об этом.


спасибо, теперь я о нем точно не забуду)


прошу прощения за невнимательность...