Помощь - Поиск - Пользователи - Календарь
Полная версия: Удаление слов
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
-Марина-
Помогите! Нужна процедура, которая бы удаляла из текста слова, содержащие две или более разные гласные буквы.
P.S. Текст файлового типа и слова в нём уже разделены пробелами.
-Марина-
мне никто не поможет?
klem4
вот тебе пример для одной строки:

uses crt;

function CheckWord(const word: string): boolean;
const
volwes = 'eyuioa';
var
i, p: byte;
ok: boolean;
begin
i := 1;
ok := true;

while (i <= 6) and ok do begin
p := pos(volwes[i], word);

if p > 0 then
ok := pos(volwes[i], copy(word, p + 1, 255)) = 0;

if ok then inc(i);
end;

CheckWord := i > 6;
end;

procedure ReformString(var s: string);
var
i, start: byte;
begin
i := 1;
while i <= length(s) do begin

while (i <= length(s)) and (s[i] = ' ') do
inc(i);

if i <= length(s) then begin

start := i;
while (i <= length(s)) and (s[i] <> ' ') do
inc(i);

if not CheckWord(copy(s, start, i - start)) then begin
delete(s, start, i - start + 1);
i := start;
end;

end;
end;
end;

var
s: string;

begin
clrscr;
s := 'qwerty eqqqe fio fioi eyuioa!';
writeln('"' + s, '"');
ReformString(s);
writeln('"' + s, '"');
readln;
end.
-Марина-
[quote]ok := pos(volwes[i], copy(word, p + 1, 255)) = 0;

Где volwes[i] паскаль пишет, что Invalid qualifier. Что делать?
klem4
const
volwes: string = 'eyuioa';
-Марина-
А как применить эту прогрмамму ко всему тексту, а не только к одной строке?
klem4
Читаешь входной файл построчно, применяешь к очередной прочитанной строке процедуру ReformString и пишешь измененную строку в выходной файл.
volvo
Может быть выгоднее читать посимвольно из файла, и уже во время составления слова подсчитывать число разных гласных в нем:

const
vowels = ['A','a', 'E','e', 'I','i', 'O','o', 'U','u'];

var
fin, fout: text;

one_word: string;
ch: char;
count: integer;
already: set of char;


begin
assign(fin, 'in.txt'); reset(fin);
assign(fout, 'out.txt'); rewrite(fout);

while not eof(fin) do begin

one_word := '';
count := 0; already := [];

repeat
read(fin, ch);

if ch = ' ' then begin

if count < 2 then write(fout, one_word + ch);

one_word := '';
count := 0; already := [];

end
else begin
one_word := one_word + ch;
if (ch in vowels) and not (ch in already) then begin
include(already, ch);
inc(count);
end;
end;

until eoln(fin);

if (one_word <> '') and (count < 2) then
write(fout, one_word);

writeln(fout);
readln(fin);

end;

close(fout);
close(fin);
end.
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.