Сравнение строк двух файлов с сортировкой

[avante]

Помогите, пожалуйста, с задачей:

Даны два текстовых файла Strok.txt (длинные строки) и PodStrok.txt (короткие строки). Рассортировать файл Strok.txt на два выходных файла по признаку: включают ли строки из Strok.txt в качестве подстрок строки из Podstrok.txt. Если включают - переписать строки из strok.txt в отдельный выходной файл, если нет - соответственно, в другой.

[s-andriano]

Помогаю.

Излагаю алгоритм решения задачи:
1. Считать все строки файла PodStrok.txt в массив строк.
2. Открыть файл Strok.txt на чтение и создать два новых файла - на запись (их имена в задании не указаны - придумать самому).
3. В цикле до конца файла читать по одной строке из входного файла. В начале цикла сбрасывать индикатор вхождения подстроки в строку.
4. Вложенный цикл, проверяющий, входит ли хоть одна подстрока из массива в текущую строку. Если входит - установить индикатор.
5. В зависимости от состояния индикатора записать строку в тот или другой файл.
6. Конец внешнего цикла.
7. Закрыть файлы.

[avante]

Спасибо, s-andriano, я попытался сделать, но не получается. Исправьте, пожалуйста, мой код.

var f1, f2, f3, f4: text;
    str, substr: string;
    i: byte; 
    n: Integer;
begin
 Assign(f1, 'str.txt'); ReSet(f1);
 Assign(f2, 'substr.txt'); ReSet(f2);
 Assign(f3, 'f3.txt'); ReWrite(f3);
 Assign(f4, 'f4.txt'); ReWrite(f4);
 n := 0;
 While (not EoF(f2)) do
  begin
   ReadLn(f2, substr); 
   inc(n);
  end; 
 While (not EoF(f1)) do
  begin
   ReadLn(f1, str);
    for i := 1 to Length(str) do
     if pos(substr, str) > 0 then
     WriteLn(f3, str) else WriteLn(f4, str);
   end;
 Close(f1); Close(f2); Close(f3); Close(f4);
end.

[BDA]

Честно говоря, с ограничениями паскаля задача получается не столь тривиальная.
Учтите, что длина строк не должна превышать 255.

var
  f1, f2, f3, f4: text;
  str, substr: string;
  t: boolean;
begin
  Assign(f1, 'str.txt');
  ReSet(f1);
  Assign(f2, 'substr.txt');
  Assign(f3, 'f3.txt');
  ReWrite(f3);
  Assign(f4, 'f4.txt');
  ReWrite(f4);
  While (not EoF(f1)) do
  begin
    ReadLn(f1, str);
    t := true;
    ReSet(f2);
    While (t and (not EoF(f2))) do
    begin
      ReadLn(f2, substr);
      if pos(substr, str) > 0 then
        t := false;
    end; 
    Close(f2);
    if t then
      WriteLn(f4, str)
    else
      WriteLn(f3, str);
  end;
  Сlose(f1);
  Close(f3);
  Close(f4);
end.

[avante]

Спасибо, BDA.
Вопросы: 1)

Учтите, что длина строк не должна превышать 255.

Это ограничение распространяется и на ПаскальАБС и Делфи?

2) Где здесь кнопочка "Поблагодарить"?

[BDA]

Пожалуйста (спасибо s-andriano за алгоритм).
Про ПаскальАБС ничего сказать на могу (не использую).
В Делфи нет такого ограничения, но там программу написать можно более красиво и оптимально.
Кнопочка Весы в левом нижнем углу поста.

[s-andriano]

Я бы стал решать задачу несколько иначе:

const
 MaxSubstrLen = 31; // максимальная длина подстроки - выбирается, исходя из реального содержимого файла substr.txt
 MaxSubstr = 1024; // максимальное количество подстрок - выбирается, исходя из реального содержимого файла substr.txt
var
  f1, f2, f3, f4: text;
  str: string;
  substr: array[0..MaxSubstr-1]of string[MaxSubstrLen];
  t: boolean;
  i,n : integer;
begin
  Assign(f2, 'substr.txt');
  ReSet(f2);
  n := 0;
  while not eof(f2) do begin
    readln(f, substr[n]);
    inc(n);
  end;
  close(f2);
  Assign(f1, 'str.txt');
  ReSet(f1);
  Assign(f3, 'f3.txt');
  ReWrite(f3);
  Assign(f4, 'f4.txt');
  ReWrite(f4);
  While (not EoF(f1)) do
  begin
    ReadLn(f1, str);
    t := true;
    i := 0;
    While (t and (i < n)) do
    begin
      if pos(substr[i], str) > 0 then
        t := false;
      inc(i);
    end; 
    if t then
      WriteLn(f4, str)
    else
      WriteLn(f3, str);
  end;
  Сlose(f1);
  Close(f3);
  Close(f4);
end.

В чем разница?
BDA написал программу универсально, но ужасно неоптимально. Единственное ограничение его программы он упомянул - длина строки не более 255 символов.
В моем варианте ограничений намного больше: к уже упомянутому 255 символов добавляется:
- ограничение на длину подстроки MaxSubstrLen,
- ограничение на количество подстрок MaxSubstr.
Но зато моя программа не выполняет лишних действий, которые могут увеличить время ее выполнения в сотни раз.

PS. Программа писалась прямо здесь и на компилируемость не проверялась.

[BDA]

s-andriano, согласен с Вами.
Я пожертвовал производительностью в угоду универсальности.

[s-andriano]

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

Я пожертвовал производительностью в угоду универсальности.

Это понятно.
Мне довелось работать еще под DOS без кэширования диска.
При 1000 строк в каждом из файлов моя программа выполнила бы работу в таких условиях за 15-20 секунд, а Ваша - около 5 часов.
Но зато, если будут превышены ограничения по длине строки или количеству строк, моя программа либо вообще не будет работать, либо будет работать неправильно.
С учетом уже существующего ограничения в 255 символов, я решил, что на всеобщесть программа претендовать уже не может, а введенные дополнительные ограничения не сильно сузят сферу ее возможного применения.
В конце концов, если у нас количество подстрок не превышает 200 с небольшим, ограничения на длину подстроки можно и не вводить.
А при использовании 32-разрядных компиляторов ограничения вообще можно сделать несущественными.

[avante]

s-andriano --Спасибо

BDA -- Спасибо