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
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
| uses crt, strings;
type
pstring = ^string;
list = ^node;
node = record
data : pointer;
next : list;
end;
procedure Append(var F, L : list; item : pointer);
var p: list;
begin
new(p);
p^.data := item; p^.next := nil;
if F = nil then F := p
else L^.next := p;
L := p
end;
procedure PrintWords(L: list);
begin
while L <> nil do
begin
write(PString(L^.data)^, ' ');
L := L^.next;
end;
end;
procedure PrintStrings(L: list);
begin
while L <> nil do
begin
PrintWords(L^.data);
writeln;
L := L^.next
end;
end;
function Proc(const F : List) : List;
var
L, Lw, Lw1, LwrF, LwrL : list;
Isf : Boolean;
begin
Proc := nil;
if F = nil then Exit;
//Начальная инициализация итогового списка.
LwrF := nil;
LwrL := nil;
//Перебор слов первой строки.
Lw1 := F^.data;
while Lw1 <> nil do begin
//True - предположим, что слово присутствует во всех строках.
Isf := True;
//Перебор строк, начиная со второй.
L := F^.next;
while L <> nil do begin
//False - предположим, что слово в текущей строке не присутствует.
Isf := False;
//Перебор слов в очередной строке.
Lw := L^.data;
while Lw <> nil do begin
//Если слово найдено, то дальше просматривать строку нет смысла.
if PString(Lw^.data)^ = PString(Lw1^.data)^ then begin
Isf := True;
Break;
end;
Lw := Lw^.next; //Следующее слово в текущей строке.
end;
//Если слово в текущей строке не надено, то просматривать
//остальные строки нет смысла.
if not Isf then Break;
L := L^.next; //Следующая строка.
end;
//Если слово присутствует во всех строках, то добавляем в итоговый список
//указатель на это слово.
if Isf then Append(LwrF, LwrL, Lw1^.data);
Lw1 := Lw1^.next; //Следующее слово в первой строке.
end;
Proc := LwrF;
end;
const D = [' ', ',', '.', '!', '?', #13, #10]; { Разделители }
var
LFirst, LLast : list; { это начало/конец списка строк }
WFirst, WLast : list; { это - начало/конец списка слов в текущей строке файла }
f : text;
ch : char;
s : string;
ps : pstring;
begin
clrscr;
LFirst := nil; LLast := nil;
assign(f, 'file.txt');
reset(f);
s := '';
WFirst := nil; WLast := nil;
while not eof(f) do
begin
read(f, ch);
if not (ch in D) then
s := s + ch
else
begin
if s <> '' then
begin
new(ps); ps^ := s;
Append(WFirst, WLast, ps);
s := '';
end;
if ch in [#13] then
begin
Append(LFirst, LLast, WFirst);
WFirst := nil; WLast := nil;
end
end;
end;
PrintStrings(LFirst);
//Решение задачи.
WFirst := Proc(LFirst);
if WFirst = nil then
Writeln('Нет ни одного слова, которое присутствовало бы во всех строках.')
else begin
Writeln('Перечень слов, которые присутствуют во всех строках:');
PrintWords(WFirst);
end;
readln;
end. |
(
