IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

 
 Ответить  Открыть новую тему 
> Удаление слов, нужно удалить слова
сообщение
Сообщение #1


Гость






Помогите! Нужна процедура, которая бы удаляла из текста слова, содержащие две или более разные гласные буквы.
P.S. Текст файлового типа и слова в нём уже разделены пробелами.
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Гость






мне никто не поможет?
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


Perl. Just code it!
******

Группа: Пользователи
Сообщений: 4 100
Пол: Мужской
Реальное имя: Андрей

Репутация: -  44  +


вот тебе пример для одной строки:

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.


--------------------
perl -e 'print for (map{chr(hex)}("4861707079204E6577205965617221"=~/(.{2})/g)), "\n";'
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4


Гость






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

Где volwes[i] паскаль пишет, что Invalid qualifier. Что делать?
 К началу страницы 
+ Ответить 
сообщение
Сообщение #5


Perl. Just code it!
******

Группа: Пользователи
Сообщений: 4 100
Пол: Мужской
Реальное имя: Андрей

Репутация: -  44  +


const
volwes: string = 'eyuioa';


Сообщение отредактировано: klem4 -


--------------------
perl -e 'print for (map{chr(hex)}("4861707079204E6577205965617221"=~/(.{2})/g)), "\n";'
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #6


Гость






А как применить эту прогрмамму ко всему тексту, а не только к одной строке?
 К началу страницы 
+ Ответить 
сообщение
Сообщение #7


Perl. Just code it!
******

Группа: Пользователи
Сообщений: 4 100
Пол: Мужской
Реальное имя: Андрей

Репутация: -  44  +


Читаешь входной файл построчно, применяешь к очередной прочитанной строке процедуру ReformString и пишешь измененную строку в выходной файл.


--------------------
perl -e 'print for (map{chr(hex)}("4861707079204E6577205965617221"=~/(.{2})/g)), "\n";'
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #8


Гость






Может быть выгоднее читать посимвольно из файла, и уже во время составления слова подсчитывать число разных гласных в нем:

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.
 К началу страницы 
+ Ответить 

 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 24.01.2021 15:50
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name