Паскаль, расстояние Левенштейна, сравнивание строк

[Lizoveta]

Добрый вечер!
Вообще, это программа должна была найти количество строк, которые можно составить из двух символов '0' и '1', длина строки=8 и все строки в данном списке должны отличаться между собой как минимум на 5 символов. Т.е. расстояние Левенштейна между любыми двумя такими строками должно быть >5. Первая строка состоит из одних нулей.
Вывести я хотела именно сами строки, для наглядности.
Но я явно сделала что-то неправильно, т.к. моя программа вообще ничего не выводит, и массив, по-моему, даже не получает никакого значения.
Помогите, пожалуйста, исправить программу, найти ошибку или понять, как это можно было сделать иначе
Буду очень благодарна!

const n=256; m=8;
var a: array[1..n] of string[8];
    i,j,k,razn,l: integer;
    s: string[2];
    str: string[8];
    kon: boolean;
begin
randomize;
     for j:=1 to m do a[1,j]:='0';
repeat
     repeat
     k:=0;
           for j:=1 to m do begin
               s:='01';
               str[j]:=s[random(2)+1];
               if str[j]='1' then k:=k+1;
           end;
     until k>=5;
     i:=1;
     l:=1;
     repeat
         razn:=0;
         kon:=false;
         for j:=1 to m do begin
             if str[j]<>a[i,j] then razn:=razn+1;
         end;
         if razn>=5 then begin
            l:=l+1;
            a[l]:=str;
            kon:=true;
         end;
         i:=i+1;
     until (i>=l) or (kon=true);
until (l>=4);
for i:=1 to l do writeln(a[i]);
writeln;
end.

[GetMax]

for j:=1 to m do a[1,j]:='0';

У вас массив объявлен одномерным, а вы обращаетесь к нему как к двумерному.

str[j]:=s[random(2)+1];

Используйте конкатенацию строк.

str := str + s[random(2)+1]

Да и вообще str это встроенная паскалевская процедура. Используйте другое имя для переменной.

until (l>=4);

Здесь у Вас происходит зацикливание, т.к. условие никогда не выполняется.

[min@y™]

Нужно найти список строк, каждая из этих строк имеет длину 8 символов, состоит из символов "0" и "1" и отличается от каждой строки списка минимум на 5 символов? Я правильно понял?

[Lizoveta]

Спасибо! Я все исправила Теперь, если сделать в конце, например,until l>=2 она выдает действительно строку, правда всего одну, без первой. Но это уже хоть что-то!

Сообщение от GetMax

until (l>=4);

Здесь у Вас происходит зацикливание, т.к. условие никогда не выполняется.

Почему же оно никогда не выполнится? Я просто не знаю, сколько там может получится строк, но я примерно предположила, что всяко больше 4...Неужели их будет меньше?

[Lizoveta]

Сообщение от min@y™

Нужно найти список строк, каждая из этих строк имеет длину 8 символов, состоит из символов "0" и "1" и отличается от каждой строки списка минимум на 5 символов? Я правильно понял?

Да, Вы все правильно поняли При этом список заведомо начинается со строки "00000000".

[min@y™]

Я написал тестовую программу. Она мне выдала список строк, соответствующих критериям:

- каждая из этих строк имеет длину 8 символов,
- состоит из символов "0" и "1",
- отличается от каждой строки списка минимум 5-ю символами

Вот этот список:

    00000000
    00011111
    11100011
    11111100

Каждая строка списка имеет минимум 5 отличий по отношению к любой из остальных строк списка при условии, что 1-я строка списка содержит только нули, а поиск вёлся последовательно от 00000001 до 11111111.

Это правильный ответ? Если нет, то приведи пример правильно сформированного списка.

[Lizoveta]

Сообщение от min@y™

Я написал тестовую программу. Она мне выдала список строк, соответствующих критериям:

Вот этот список:

    00000000
    00011111
    11100011
    11111100

Каждая строка списка имеет минимум 5 отличий по отношению к любой из остальных строк списка при условии, что 1-я строка списка содержит только нули, а поиск вёлся последовательно от 00000001 до 11111111.

Это правильный ответ? Если нет, то приведи пример правильно сформированного списка.

Мне кажется, да. Здесь точно все подходят и вроде как больше ничего к нему не добавишь. Не можете подсказать, пожалуйста, как Вы организовали поиск всех вариантов именно последовательно от 00000001 до 11111111, а не как я рандомно?

[min@y™]

Не можете подсказать, пожалуйста, как Вы организовали поиск всех вариантов именно последовательно от 00000001 до 11111111, а не как я рандомно?

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

[Lizoveta]

Сообщение от min@y™

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

Вы понимаете, в чем проблема...Мне как бы правильный ответ то и надо было с помощью программы выяснить Так я на 100% утверждать не могу, но вроде в ручную я проверяла: все правильно.
Пирожки - это хорошо, а тёщины тем более. Надеюсь, доброту за день не растеряли?

[min@y™]

Надеюсь, доброту за день не растеряли?

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

program p265982;

{$ifdef WIN32}
{$APPTYPE CONSOLE}
{$endif}

(*
  Для компиляции в турбо-паскале заменить все комментарии вида
  // текст комментария
  на комментарии вида
  { текст комментария }
*)

// перевод в строку 8-битного числа
function Byte2Bin(X: Byte): string;
var
  bit: Integer;
begin
  Result:= '00000000';
  bit:= 8;

  while X <> 0 do
    begin
      Inc(Result[bit], X and 1);
      Dec(bit);
      X:= X shr 1;
    end;
end;

// вычисление расстояния Левенштейна между двумя 8-битными числами
function LevenDistance(const A, B: Byte): Integer;
var
  Sum: Byte;
begin
  Sum:= A xor B; // различающиеся разряды (ключевое место всей программы)
  Result:= 0;

  // подсчёт кол-ва этих разрядов (оно и есть
  // то самое расстояние умного еврея Левенштейна)
  while Sum <> 0 do
    begin
      Inc(Result, Sum and 1); 
      Sum:= Sum shr 1;
    end;
end;

const                           
  Limit = 5;                    // начальное условие

var
  X: Byte;                      // 8-битное число для последовательного поиска
  Found: array[0..$FF] of Byte; // список найденных вариантов
  Index, Total: Integer;        // индексы
  LD: Integer;                  // для просмотра в отладчике (можно выкинуть)

begin
  Total:= 1;      // начальное условие
  Found[0]:= $00; // начальное условие

  // цикл поиска
  for X:= 1 to $FF do
    begin
      // проход по массиву найденных элементов и поиск в нём элемента,
      // расстояние которого относительно Х меньше Limit.
      // Если такой элемент в массиве не найден, значит добавит Х
      // в массив найденных элементов.
      Index:= 0;
      while Index < Total do
        begin
          LD:= LevenDistance(X, Found[Index]);
          if LD < Limit
            then Break; // не подходит - на выход

          Inc(Index);
        end;

      if Index = Total // подошло
        then begin
               Found[Total]:= X;
               Inc(Total); // кол-во найденных +1
             end;

    end;

  // вывод списка найденных на консоль
  for Index:= 0 to Total - 1 do
    WriteLn('    ', Byte2Bin(Found[Index]));
  WriteLn(' Total: ', Total);

  Write(' Press ENTER to exit... ');
  ReadLn;
end.