Подстроки как сортировщики строк файла

@kayslu · Регистрация: 25.03.2009

Студворк — интернет-сервис помощи студентам

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

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

@bormant · 17.02.2014, 12:31

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
type
  PString=^string;
  PNode=^TNode;
  TNode=record
    next: PNode;
    ps: PString;
  end;
 
function FindPS(p: PNode; s: string): boolean;
begin
  FindPS:=True;
  while p<>nil do begin
    if Pos(p^.ps^, s) <> 0 then Exit;
    p:=p^.next;
  end;
  FindPS:=False;
end;
 
var
  stk, p: PNode;
  s: string;
  f, fy, fn: Text;
begin
  stk:=nil;
  Assign(f, 'podstrok.txt'); Reset(f);
  while not EOF(f) do begin
    ReadLn(f, s);
    if s<>'' then begin
      New(p);
      p^.next:=stk; stk:=p;
      GetMem(p^.ps, Length(s)+1);
      p^.ps^:=s;
    end;
  end;
  Close(f);
  Assign(f, 'strok.txt'); Reset(f);
  Assign(fy, 'stroky.txt'); Rewrite(fy);
  Assign(fn, 'strokn.txt'); Rewrite(fn);
  while not EOF(f) do begin
    ReadLn(f, s);
    if FindPS(stk, s) then WriteLn(fy, s) else WriteLn(fn, s);
  end;
  Close(f); Close(fy); Close(fn);
  while stk<>nil do begin
    p:=stk;
    stk:=stk^.next;
    FreeMem(p^.ps, Length(p^.ps^)+1);
    Dispose(p);
  end;
end.

Добавлено через 3 минуты
strok.txt:

Code
1
2
test yes
test no

podstrok.txt

Code
1
yes

После прогона:
stroky.txt

Code
1
test yes

strokn.txt

Code
1
test no

@kayslu · 17.02.2014, 14:00 **[ТС]**

В Pascal ABC ошибка в 4-й с конца строке "Неверное количество фактических параметров",
в ABCNET - ошибка во 2- строке " Указатели на ссылочные типы недопустимы".

@bormant · 17.02.2014, 14:45

Да пример был под короткие строки Turbo Pascal.

Для PascalABC, судя по ошибке, строку нужно поменять на FreeMem(p^.ps);

Для ABCNET со ссылками на строки можно попробовать так:

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
type
  PNode=^TNode;
  TNode=record
    next: PNode;
    ps: String;
  end;
 
function FindPS(p: PNode; s: string): boolean;
begin
  FindPS:=True;
  while p<>nil do begin
    if Pos(p^.ps, s) <> 0 then Exit;
    p:=p^.next;
  end;
  FindPS:=False;
end;
 
var
  stk, p: PNode;
  s: string;
  f, fy, fn: Text;
begin
  stk:=nil;
  Assign(f, 'podstrok.txt'); Reset(f);
  while not EOF(f) do begin
    ReadLn(f, s);
    if s<>'' then begin
      New(p);
      p^.next:=stk; stk:=p;
      p^.ps:=s;
    end;
  end;
  Close(f);
  Assign(f, 'strok.txt'); Reset(f);
  Assign(fy, 'stroky.txt'); Rewrite(fy);
  Assign(fn, 'strokn.txt'); Rewrite(fn);
  while not EOF(f) do begin
    ReadLn(f, s);
    if FindPS(stk, s) then WriteLn(fy, s) else WriteLn(fn, s);
  end;
  Close(f); Close(fy); Close(fn);
  while stk<>nil do begin
    p:=stk;
    stk:=stk^.next;
    Dispose(p);
  end;
end.

Ни тем, ни другим не пользуюсь, проверить негде.

@kayslu · 17.02.2014, 15:22 **[ТС]**

В 28-й строке ABCNET ошибка " Нельзя вызвать New, так как невозможно вычислить размер записи".
Но Вам большое спасибо

@bormant · 17.02.2014, 16:27

Полагаю, про особенности ABCNET применительно к данному случаю можно попробовать спросить в соответствующем подфоруме PascalABS.NET.

Добавлено через 42 минуты
Если воспользоваться для хранения строк не списком-стеком, а динамическими массивами (которых нет в TurboPascal), можно попробовать так:

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
function FindPS(a: array of string; s: string): boolean;
var
  i: integer;
begin
  FindPS:=True;
  for i:=Length(a)-1 downto 0 do
    if Pos(a[i], s) <> 0 then Exit;
  FindPS:=False;
end;
 
var
  a: array of string;
  s: string;
  i: integer;
  f, fy, fn: Text;
begin
  Assign(f, 'podstrok.txt'); Reset(f);
  while not EOF(f) do begin
    ReadLn(f, s);
    if s<>'' then begin
      i:=Length(a);
      SetLength(a, i+1);
      a[i]:=s;
    end;
  end;
  Close(f);
  Assign(f, 'strok.txt'); Reset(f);
  Assign(fy, 'stroky.txt'); Rewrite(fy);
  Assign(fn, 'strokn.txt'); Rewrite(fn);
  while not EOF(f) do begin
    ReadLn(f, s);
    if FindPS(a, s) then WriteLn(fy, s) else WriteLn(fn, s);
  end;
  Close(f); Close(fy); Close(fn);
end.

@kayslu · 18.02.2014, 18:07 **[ТС]**

bormant, последняя редакция работает хорошо. Спасибо

Новые блоги и статьи Все статьи Все блоги /
Знаешь почему 90% людей редко бывают счастливыми? kumehtar 14.04.2026 Потому что они ждут. Ждут выходных, ждут отпуска, ждут удачного момента. . . а удачный момент так и не приходит.	Фиксация колонок в отчете СКД Maks 14.04.2026 Фиксация колонок в СКД отчета типа Таблица. Задача: зафиксировать три левых колонки в отчете. Процедура ПриКомпоновкеРезультата(ДокументРезультат, ДанныеРасшифровки, СтандартнаяОбработка) / / . . .	Настройки VS Code Loafer 13.04.2026 { "cmake. configureOnOpen": false, "diffEditor. ignoreTrimWhitespace": true, "editor. guides. bracketPairs": "active", "extensions. ignoreRecommendations": true, . . .	Оптимизация кода на разграничение прав доступа к элементам формы Maks 13.04.2026 Алгоритм из решения ниже реализован на нетиповом документе, разработанного в конфигурации КА2. Задачи, как таковой, поставлено не было, проделанное ниже исключительно моя инициатива. Было так:. . .
Контроль заполнения и очистка дат в зависимости от значения перечислений Maks 12.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа "ПланированиеПерсонала", разработанного в конфигурации КА2. Задача: реализовать контроль корректности заполнения дат назначения. . .	Архитектура слоя интернета для сервера-слоя. Hrethgir 11.04.2026 В продолжение https:/ / www. cyberforum. ru/ blogs/ 223907/ 10860. html Знаешь что я подумал? Раз мы все источники пишем в голове ветки, то ничего не мешает добавить в голову такой источник, который сам. . .	Подстановка значения реквизита справочника в табличную часть документа Maks 10.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа "ПланированиеПерсонала", разработанного в конфигурации КА2. Задача: при выборе сотрудника (справочник Сотрудники) в ТЧ документа. . .	Очистка реквизитов документа при копировании Maks 09.04.2026 Алгоритм из решения ниже применим как для типовых, так и для нетиповых документов на самых различных конфигурациях. Задача: при копировании документа очищать определенные реквизиты и табличную. . .

Подстроки как сортировщики строк файла

Решение

Решение

@kayslu 19 / 19 / 7 Регистрация: 25.03.2009 Сообщений: 222

	Подстроки как сортировщики строк файла 16.02.2014, 17:04. Показов 1217. Ответов 6 Метки нет (Все метки) Сравнение строк двух файлов с сортировкой / Pascal ABC. Даны два текстовых файла Strok.txt (длинные строки) и PodStrok.txt (короткие строки). Рассортировать файл Strok.txt на два выходных файла по признаку: включают ли строки из Strok.txt в качестве подстрок строки из Podstrok.txt. Если включают - переписать строки из strok.txt в отдельный выходной файл, если нет - соответственно, в другой. 0

@kayslu 19 / 19 / 7 Регистрация: 25.03.2009 Сообщений: 222
	17.02.2014, 14:00 [ТС]
	В Pascal ABC ошибка в 4-й с конца строке "Неверное количество фактических параметров", в ABCNET - ошибка во 2- строке " Указатели на ссылочные типы недопустимы". 0

@kayslu 19 / 19 / 7 Регистрация: 25.03.2009 Сообщений: 222
	17.02.2014, 15:22 [ТС]
	В 28-й строке ABCNET ошибка " Нельзя вызвать New, так как невозможно вычислить размер записи". Но Вам большое спасибо 1

@kayslu 19 / 19 / 7 Регистрация: 25.03.2009 Сообщений: 222
	18.02.2014, 18:07 [ТС]
	bormant, последняя редакция работает хорошо. Спасибо 0