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
| program Project1;
{$APPTYPE CONSOLE}
uses
SysUtils, Windows;
type
{Основные данные элемента стека.}
TData = String;
{Указатель на элемент стека.}
TPElem = ^TElem;
{Элемент стека.}
TElem = record
Data : TData; {Основные данные.}
PNext : TPElem; {Указатель на следующий элемент стека.}
end;
{Для стека отдельный тип можно не создавать. Стек будет представлен в виде
указателя на элемент, расположенный на вершине стека. Поэтому, переменная,
представляющая стек, будет иметь тип TPElem.}
{Добавление элемента на вершину стека.}
procedure Push(var aPStack : TPElem; const aData : TData);
var
PElem : TPElem;
begin
New(PElem);
PElem^.Data := aData;
PElem^.PNext := aPStack;
aPStack := PElem;
end;
{Изъятие элемента с вершины стека.
Если стек не пуст, то с вершины стека изымается элемент и его значение
(основные данные) возвращается через параметр aData. В этом случае, функция
возвращает значение True. Если стек пуст, то операция отменяется, а функция
возвращает значение False.}
function Pop(var aPStack : TPElem; var aData : TData) : Boolean;
var
PElem : TPElem;
begin
Pop := False;
if aPStack = nil then Exit;
PElem := aPStack;
aPStack := PElem^.PNext;
aData := PElem^.Data;
Dispose(PElem);
Pop := True;
end;
{Освобождение памяти, занятой стеком (очистка стека).}
procedure Free(var aPStack : TPElem);
var
Data : TData;
begin
while Pop(aPStack, Data) do;
end;
const
{Множество разделителей слов.}
D = ['.', ',', ':', ';', '!', '?', '-', ' ', #9, #10, #13];
var
PSt1, PSt2 : TPElem;
Data1, Data2 : TData;
S : String;
Cnt : Integer;
B : Boolean;
begin
{Переключение окна консоли на кодовую страницу CP1251 (Win-1251).
Если после переключения русские буквы показываются неверно,
следует открыть системное меню консольного окна - щелчком мыши в левом
верхнем углу окна консоли и выбрать:
Свойства - закладка "Шрифт" - выбрать шрифт: "Lucida Console".}
SetConsoleCP(1251);
SetConsoleOutputCP(1251);
{Начальная инициализация стеков.}
PSt1 := nil;
PSt2 := nil;
repeat
Writeln('Задайте слова.');
Writeln('Для завершения ввода оставьте пустую строку и нажмите Enter.');
repeat
Write('Слово: ');
Readln(Data1);
if Data1 <> '' then
Push(PSt1, Data1)
else
Writeln('Ввод завершён.');
until Data1 = '';
{Решение задачи.}
{Количество слов, для которых были найдены совпадения.}
Cnt := 0;
{Извлекаем слова из первого стека.}
while Pop(PSt1, Data1) do begin
{Поиск совпадений. Слова, которые совпадают с текущим - удаляем.
Несовпадающие слова записываем во второй стек.}
B := False;
while Pop(PSt1, Data2) do
if Data1 = Data2 then
B := True
else
Push(PSt2, Data2);
if B then Inc(Cnt);
PSt1 := PSt2;
PSt2 := nil;
end;
Writeln('Количество совпадающих слов: ', Cnt);
{Освобождаем память, занятую для стеков. Сейчас стеки и так пусты,
но грамотно построенный код должен содержать код освобождения памяти.
Это повышает надёжность кода.}
Free(PSt1);
Free(PSt1);
Writeln('Память, выделенная для стеков, освобождена.');
Writeln;
Writeln('Повторить - Enter. Выход - любой символ + Enter.');
Readln(S);
until S <> '';
end. |
(
Сообщение было отмечено anreisorsk как решение
