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
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
| program Project1;
{$APPTYPE CONSOLE}
uses
SysUtils,
Windows;
const
//Максимальное количество различных слов в тексте.
M = 20;
type
//Сведения о слове.
TWord = record
//Само слово.
SWord : String;
//Количество обнаружений слова в тексте.
Cnt : Integer;
end;
//Хранилище уникальных слов.
TVault = record
//Количество слов в хранилище. - Количество значимых элементов массива.
Len : Integer;
//Массив сведений о словах.
Arr : array[1..M] of TWord;
end;
//Добавляет слово в массив хранилища Vault. При этом, если добавляемое
//слово уже присутствует в массиве, тогда счётчик этого слова увеличивается
//на единицу. Если добавляемое слово пока не присутствует в массиве, тогда
//это слово записывается в массив и его счётчик устанавливается равным единице.
procedure AddToVault(var aVault : TVault; const aWord : String);
var
i : Integer;
b : Boolean;
begin
//Просматриваем массив - проверяем,
//есть ли уже в нём такое слово.
b := False;
for i := 1 to aVault.Len do begin
//Если такое же слово найдено, то увеличиваем
//его счётчик на единицу и выходим из цикла.
if aVault.Arr[i].SWord = aWord then begin
Inc( aVault.Arr[i].Cnt );
b := True;
Break;
end;
end;
//Если в предыдущем цикле слово не найдено, то
//добавляем слово в массив и устанавливаем счётчик этого
//слова равным единице.
if not b then begin
//Так как мы добавляем в массив новое слово, то количество значимых
//элементов массива становится на единицу больше.
Inc(aVault.Len);
//Записываем в массив данные нового элемента (слова).
aVault.Arr[i].SWord := aWord;
aVault.Arr[i].Cnt := 1;
end;
end;
//Проверяет - есть ли в хранилище заданное слово.
//Возвращаемое значение:
//0 - слова нет.
//1.. - индекс найденного слова.
function InVault(const aVault : TVault; aWord : String) : Integer;
var
i, Res : Integer;
begin
Res := 0;
for i := 1 to aVault.Len do begin
if aWord = aVault.Arr[i].SWord then begin
Res := i;
Break;
end;
end;
InVault := Res;
end;
//Удаляет из строки те слова, которые присутствуют в тексте
//только по одному разу.
function ProcStr(const aStr : String) : String;
const
//Разделители слов.
D = ['.', ',', ':', ';', '!', '?', '-', ' ', #9, #10, #13];
var
S, SWord : String;
i, j, Pos1, Len, LenW : Integer;
Vault : TVault;
begin
S := aStr;
Vault.Len := 0;
//Извлекаем слова и добавляем их в хранилище Vault.
Len := Length(S);
Pos1 := 0;
for i := 1 to Len do begin
//Пропускаем разделители.
if S[i] in D then Continue;
//Отслеживаем начало слова.
if (i = 1) or (S[i - 1] in D) then Pos1 := i;
//Отслеживаем конец слова.
if (i = Len) or (S[i + 1] in D) then begin
//Добавляем слово в массив.
LenW := i - Pos1 + 1;
SWord := AnsiUpperCase( Copy(S, Pos1, LenW) );
AddToVault(Vault, SWord);
end;
end;
//Переформировываем массив Vault так, чтобы в нём остались
//только те слова, которые в тексте присутствуют только по одному разу.
j := 0;
for i := 1 to Vault.Len do begin
if Vault.Arr[i].Cnt = 1 then begin
Inc(j);
Vault.Arr[j] := Vault.Arr[i];
end;
end;
Vault.Len := j;
//Удаляем из текста слова, которые присутствуют только по одному разу.
if Vault.Len > 0 then begin
Len := Length(S);
Pos1 := 0;
for i := Len downto 1 do begin
//Пропускаем разделители.
if S[i] in D then Continue;
//Отслеживаем конец слова.
if (i = Len) or (S[i + 1] in D) then Pos1 := i;
//Отслеживаем начало слова.
if (i = 1) or (S[i - 1] in D) then begin
//Удаляем искомые слова.
LenW := Pos1 - i + 1;
SWord := AnsiUpperCase( Copy(S, i, LenW) );
j := InVault(Vault, SWord);
if j > 0 then begin
Delete(S, i, LenW);
Dec(Vault.Len);
if Vault.Len = 0 then Break;
end;
end;
end;
end;
Result := S;
end;
var
S : String;
begin
//Переключение консоли на кодовую страницу CP1251 (Win-1251).
//Если после переключения русские буквы показываются неверно, следует
//открыть системное меню консольного окна - слева вверху окна консоли.
//И выбрать: Свойства - закладка "Шрифт" - выбрать шрифт: "Lucida Console".
SetConsoleCP(1251);
SetConsoleOutputCP(1251);
repeat
Writeln('Введите текст:');
Readln(S);
S := ProcStr(S);
Writeln('Строка после обработки:');
Writeln(S);
Writeln('Повторить - Enter. Выход - любой символ + Enter.');
Readln(S);
until S <> '';
end. |
(
