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
| implementation
{$R *.dfm}
{Условие задачи:
Дан файл, содержащий текст на русском языке. Найти слова, встречающиеся
в каждом предложении, или сообщить, что таких слов нет.}
{Решение:
Мы заведём 2 массива - ArrW и ArrR, которые будут представлять множества слов.
ArrW - множество слов, которые мы обнаружили в текущем предложении.
ArrR - множество слов, которые присутствуют в каждом предложении. - Это то самое
множество, которое является решением нашей задачи.
Действовать будем так:
- Вычленяем очередное предложение, уникальные слова этого предложения помещаем
в массив (множество) ArrW.
- Если это первое предложение, то переписываем содержимое из ArrW в ArrR.
- Если это не первое предложение, то вычисляем пересечение множеств:
ArrR := ArrR * ArrW - в результате получим множество, которое содержит те слова,
которые присутствуют во всех обработанных на данный момент предложениях.
- Перед обработкой следующего предложения обнуляем массив (множество) ArrW.
- Обработав таким образом все предложения текста, мы составим множество ArrR,
которое содержит только те слова, которые присутствуют во всех предложениях.
- Причём, если при обработке очередного предложения окажется, что множество
ArrR оказалось пустым, то значит ответ уже известен - нет таких слов, которые
присутствовали бы в каждом предложении текста. В этом случае прерываем обработку.}
type
TArr = array of String;
{Функция вычисляет пересечение множеств: A1 * A2. Результатом пересечения является множество,
которое содержит только те элементы, которые присутствуют одновременно в A1 и в A2.}
function Intersect(const A1, A2 : TArr) : TArr;
var
i, j : Integer;
begin
Result := nil;
//Проверяем каждый элемент массива (множества) A1 - если такой же элемент
//присутсвует в A2, то добавляем такой элемент в результирующий массив (множество).
for i := 0 to High(A1) do
begin
j := High(A2);
while (j >= 0) and (A2[j] <> A1[i]) do
Dec(j);
if j >= 0 then
begin
SetLength(Result, Length(Result) + 1);
Result[High(Result)] := A1[i];
end;
end;
end;
//Загрузка текста из файла в Memo1.
procedure TForm1.Button1Click(Sender: TObject);
var
Od : TOpenDialog;
begin
Od := OpenDialog1; //OpenDialog1 уже должен быть на форме.
if Od.InitialDir = '' then
Od.InitialDir := ExtractFilePath( ParamStr(0) );
if not Od.Execute then
Exit;
if not FileExists(Od.FileName) then
begin
MessageBox(Handle, 'Файл с заданным именем не найден. Действие отменено.',
'Файл не найден', MB_OK + MB_ICONEXCLAMATION + MB_APPLMODAL);
Exit;
end;
Memo1.Lines.LoadFromFile(Od.FileName);
end;
//Решение задачи.
procedure TForm1.Button2Click(Sender: TObject);
const
//Множество разделителей слов.
Dw = [' ', '.', ',', ':', ';', '!', '?', '-', #9, #10, #13];
//Множество разделителей предложений.
Df = ['.', '!', '?'];
var
S, Sw : String;
ArrW, ArrR : TArr;
i, j, Len, LenW, CntOff : Integer;
begin
S := AnsiUpperCase(Memo1.Text); //Исходный текст в верхнем регистре.
//Решение.
Len := Length(S);
LenW := 0; //Длина очередного слова.
CntOff := 0; //Счётчик предложений.
ArrW := nil; //Массив уникальных слов, обнаруженных в текущем предложении.
ArrR := nil; //Массив уникальных слов, которые присутствуют в каждом предложении.
for i := 1 to Len do //Перебор всех символов исходного текста.
begin
//Блок обработки слов.
if not (S[i] in Dw) then //Если символ принедлежит слову.
begin
Inc(LenW); //Учитываем очередной символ в длине слова.
if (i = Len) or (S[i + 1] in Dw) then //Отслеживаем конец слова.
begin
Sw := Copy(S, i - LenW + 1, LenW); //Вычленяем слово.
//Проверяем - есть ли уже такое же слово в массиве.
j := High(ArrW);
while (j >= 0) and (ArrW[j] <> Sw) do
Dec(j);
//Если слово в массиве не обнаружено, то добавляем его в массив.
if j < 0 then
begin
SetLength(ArrW, Length(ArrW) + 1); //Увеличиваем размер массива на 1.
ArrW[High(ArrW)] := Copy(S, i - LenW + 1, LenW); //Добавляем слово в массив.
end;
LenW := 0;
end;
end;
//Блок обработки предложений.
if not (S[i] in Df) and ((i = Len) or (S[i + 1] in Df)) then //Отслеживаем конец предложения.
begin
Inc(CntOff); //Счётчик предложений увеличиваем на 1.
if CntOff = 1 then //Если это первое предложение в тексте.
ArrR := Copy(ArrW, 0, Length(ArrW))
else //Если это не первое предложение в тексте (2, 3, 4, ...).
ArrR := Intersect(ArrR, ArrW);
ArrW := nil; //Очищаем массив слов текущего предложения.
//Если результирующее множество оказалось пустым, то ответ уже известен
//и нет смысла продолжать обработку текста.
if Length(ArrR) = 0 then
Break;
end;
end;
//Ответ.
if Length(ArrR) = 0 then
Memo2.Text := 'В тексте нет ни одного слова, которое бы присутствовало в каждом предложении.'
else
begin
Memo2.Text := 'Перечень слов, которые присутствуют в каждом предложении:';
for i := 0 to High(ArrR) do
Memo2.Lines.Add(ArrR[i]);
end;
end;
end. |
(
Сообщение было отмечено Ganz1846 как решение
