Сравнение последовательности чисел с часть самой себя

[Tolyman]

Мы берем подпоследовательность длины k значит мы должны найти похожую подпоследовательность в которую входят все k элементов в нужном порядке. Критерий похожести состоит в том, чтобы были все k элементов последовательности, в том же порядке, и между элементами не было мусора более чем по 2. И даже если после каждого успешного элемента будет стоять 2 мусора, и мусора получится 2k-4, то все равно такая последовательность будет похожей. Конечно, желательно, чтобы можно было изменять критерий похожести - 0 мусора между элементами, 1,2...

[veniside]

ну наконец-то, вытащили из вас клещами описание задачи )

program
  SubSeq;

{$APPTYPE CONSOLE}

const
  N  = 100000;     // total seq length
  //
  K  = 8;         // subsequence length (from 1 to N/2)
  B  = 0;          // subsequence start index (from 0 to N - 2*K)
  //
  M  = 3;          // max number of bad emelments we can tolerate in between of other elements (from 0 to N-K)

var
  seq: pIntegerArray;

// --  --
procedure printSeq(s, l: Integer; const title: string);
var
  i: Integer;
begin
  writeln(title);
  write('@', s, ', len=', l, ' [ ');
  for i := s to s + l - 2 do
    write(seq[i], ', ');
  //
  writeln(seq[s + l - 1], ']');
  writeln;
end;

// --  see if we can make up a subsequence starting from this index --
function tryThis(index: Integer; var len: Integer): Boolean;
var
  c, t, o1: Integer;
begin
  c := 1;
  o1 := 1;
  result := true;
  //
  while (result and (index + o1 < N) and (c < K)) do begin
    //
    if (seq[index + o1] = seq[B + c]) then begin
      //
      inc(c);
      inc(o1);
    end
    else begin
      //
      t := 1;
      while (t <= M) do begin
        //
        if (seq[index + o1 + t] = seq[B + c]) then
          break
        else
          inc(t);
      end;
      //
      if (t > M) then begin
        //
        // too much trash
        result := false;
        break;
      end
      else begin
        //
        inc(c);
        inc(o1, t + 1);
      end;
    end;
  end;
  //
  len := o1;
end;

// -- main --

var
  i, j, l: Integer;
  bestIndex, bestLen: Integer;
begin
  writeLn('N  = ', N, ';   B = ', B, ';   K = ', K, ';   M = ', M);
  //
  bestIndex := -1;
  bestLen := MaxInt;
  //
  Randomize();
  GetMem(seq, sizeof(Integer) * N);
  try
    for i := 0 to N - 1 do
      seq[i] := 5 - Random(10);
    //
    printSeq(B, K, 'Source subseqence:');
    //
    j := 0;
    while (j < N - K) do begin
      //
      if ((j < B) or (j > B + K)) and (seq[j] = seq[B]) then begin
        //
        if (tryThis(j, l)) then begin
          //
          printSeq(j, l, 'Found some:');
          if (l < bestLen) then begin
            //
            bestIndex := j;
            bestLen := l;
          end;
        end;
      end;
      //
      inc(j);
    end;
    //
  finally
    FreeMem(seq);
  end;
  //
  if (bestIndex >= 0) then
    writeLn('Best sub-sequence found at ', bestIndex, '; length=', bestLen)
  else
    writeLn('No luck');
end.

как-то так, комменты по коду я разбросал

[Tolyman]

Спасибо. Дома попробую разобраться.

[Tolyman]

Извини за необразованность но последний вопрос: в какой среде скомпилировать твою программу?

[veniside]

желательно в Delphi, можно и под free pascal/Lazarus
а можно и в Борланд Паскале под ДОС (с небольшими изменениями)
тут даже не сколько важно скомпилировать, а просто понять, что и как она делает.

1) формируется массив seq из N случайных чисел

2) индекс j пробегает от 0 до N - K, и если j не попадает внутрь самой подпоследовательности (в диапазон от B до B + K - 1), и если первая цифра подпоследовательности (seq[B]) совпадает с seq[j], то вызывается процедура tryThis(j)

3) tryThis уже по переданному ей индексу пытается проверить, можно ли построить начиная с этого индекса подпоследовательность, учитывая, что могут быть от 0 до M "леывх" элементов между каждым подходящим.

4) если построить удалось, tryThis возвращает True и заодно длину получившейся подпоследовательности (включая мусор). Длина затем сравнивается с "лучшей" длиной (bestLen) и если она короче, то bestLen обновляется (вместе с bestIndex).

5) в конце выдается индекс "лучшей" по длине подпоследовательности, или "No luck", если ничё не нашлось.

[Tolyman]

В структуре программы я разобрался, она просто прелесть. Просто БП не знает например что такое pIntegerArray, try - finally(а это не знает фри паскаль), Делфи матюкнулся на то что не описан type. И еще где нужно описать result? Я вроде как попробывал переделать под ТП, но еще не успел проверить. Я его описал как булин в самой функции возле этих
var
c, t, o1: Integer;

[Utkin]

Это биологические алгоритмы, направлены на поиск цепочек ДНК. Советую копать в том направлении . Возможно тама есть и более оптимальные алгоритмы.

[veniside]

pIntegerArray можно заменить на

seq: array[0..N-1] of Integer;

тогда GetMem/FreeMem равно как и try/finally можно убрать.

Да, result можно описать как локальную boolean переменную, в конце не забыть tryThis := result;

И да, алгоритм не то, что не оптимальный, он просто в лоб. Если N, К или М будут на несколько порядков больше, нужно что-то думать. Или если B (начало подпоследовательности) заранее неизвестно (т.е. предполагается, что его будут подбирать), тут всё немного сложнее (если хочется оптимально).

[Serge_Bliznykov]

ну и сразу добавлю.

в случае:

const
  N  = 100000; 
...
var
seq: array[0..N-1] of Integer;

можете забыть про Turbo Pascal.
там общий размер всех переменных не может превышать 64 кб
поэтому такой код не откомпилируется.

Надо брать Delphi (рекомендую), ну или FreePascal...

вот код консольной программы под Delphi (и под FreePascal после правильного импорта скорее всего тоже откомпилируется!)

program
  SubSeq;

{$APPTYPE CONSOLE}

const
  N = 100000; // total seq length
  //
  K = 8; // subsequence length (from 1 to N/2)
  B = 0; // subsequence start index (from 0 to N - 2*K)
  //
  M = 3; // max number of bad emelments we can tolerate in between of other elements (from 0 to N-K)

var
  seq: array[0..N - 1] of Integer;

// --  --

procedure printSeq(s, l: Integer; const title: string);
var
  i: Integer;
begin
  writeln(title);
  write('@', s, ', len=', l, ' [ ');
  for i := s to s + l - 2 do
    write(seq[i], ', ');
  //
  writeln(seq[s + l - 1], ']');
  writeln;
end;

// --  see if we can make up a subsequence starting from this index --

function tryThis(index: Integer; var len: Integer): Boolean;
var
  c, t, o1: Integer;
begin
  c := 1;
  o1 := 1;
  result := true;
  //
  while (result and (index + o1 < N) and (c < K)) do begin
    //
    if (seq[index + o1] = seq[B + c]) then begin
      //
      inc(c);
      inc(o1);
    end
    else begin
      //
      t := 1;
      while (t <= M) do begin
        //
        if (seq[index + o1 + t] = seq[B + c]) then
          break
        else
          inc(t);
      end;
      //
      if (t > M) then begin
        //
        // too much trash
        result := false;
        break;
      end
      else begin
        //
        inc(c);
        inc(o1, t + 1);
      end;
    end;
  end;
  //
  len := o1;
end;

// -- main --

var
  i, j, l: Integer;
  bestIndex, bestLen: Integer;
begin
  writeLn('N  = ', N, ';   B = ', B, ';   K = ', K, ';   M = ', M);
  //
  bestIndex := -1;
  bestLen := MaxInt;
  //
  Randomize();
  for i := 0 to N - 1 do
    seq[i] := 5 - Random(10);
    //
  printSeq(B, K, 'Source subseqence:');
    //
  j := 0;
  while (j < N - K) do begin
      //
    if ((j < B) or (j > B + K)) and (seq[j] = seq[B]) then begin
        //
      if (tryThis(j, l)) then begin
          //
        printSeq(j, l, 'Found some:');
        if (l < bestLen) then begin
            //
          bestIndex := j;
          bestLen := l;
        end;
      end;
    end;
      //
    inc(j);
  end;
  if (bestIndex >= 0) then
    writeLn('Best sub-sequence found at ', bestIndex, '; length=', bestLen)
  else
    writeLn('No luck');
  readln;
end.

[Tolyman]

Я сразу N уменьшил до 10000. И запустил на ТП. Все нормально. Теперь нужно сделать, чтобы брало данные из файла, а потом записывало в файл, но надеюсь это я смогу сделать. Спасибо Вам всем.