Если в тексте есть слово, в котором есть две одинаковые согласные буквы, то удалить из слов текста звонкие согласные

Дана строка, содержащая русский текст. Если в тексте есть слово, в котором есть две одинаковые согласные буквы, то удалить из слов текста звонкие согласные, в противном случае продублировать в словах, содержащих не менее 3-х гласных, гласные буквы. Полученные слова вывести в алфавитном порядке. (Звонкие согласные: бвгжздйлмнр)

code: #pascal
program PascalGuru;
 
uses crt;
const k=100;
type mas=array[1..k] of string;
var tmas:mas;
i,j,n,l:integer;
p:boolean;
letters,sogl,glas,zsogl: set of char;
Procedure Masslov(var tmas:mas; var n:integer);
var j:integer;
s,s1,w:string;
begin
writeln('введите строку');
readln(s);
s:=s+' ';
w:=''; n:=0;
for j:=1 to length(s) do
if s[j] in Letters then w:=w+s[j]
else if w<>'' then
                     begin
                     n:=n+1;
                     tmas[n]:=w;
                      w:='';  
                     end
end;
 
function proverka(var tmas:mas; n:integer):boolean;
var i,j:integer;
mn:set of char;
begin
proverka:=false;
 
for j:=1 to n do
begin
mn:=[];
for i:=1 to length(tmas[j]) do
if (tmas[j][i] in sogl) then
                  if tmas[j][i] in mn then
 
                                proverka:=true
                  else
                  mn:=mn+[tmas[j][i]];
end;
end;
 
procedure del(var tmas:mas; n:integer);
var i,j:integer;
s:string;
begin
for i:=1 to n do
              begin
              s:='';
              for j:=1 to length(tmas[i]) do
              if not (tmas[i][j] in zsogl) then s:=s+tmas[i][j];
              if s<>'' then tmas[i]:=s;
              end;
end;
 
function kolglas(s:string):integer;
var i,j:integer;
begin
j:=0;
for i:=1 to length(s) do
if (s[i] in glas) then j:=j+1;
kolglas:=j;
end;
 
procedure doub(var s:string);
var i:integer;
begin
i:=1;
while i<=length(s) do
begin
if s[i] in glas then
begin
insert(s[i],s,i);
i:=i+1;
end;
i:=i+1;
end;
end;
 
procedure sort(var tmas:mas; n:integer);
var i,j:integer;
obm:string;
begin
for i:=1 to n-1 do
 for j:=i+1 to n do
 if tmas[i] >tmas[j] then
                     begin
                     obm:=tmas[i];
                     tmas[i]:=tmas[j];
                     tmas[j]:=obm;
                     end;
end;
 
begin
letters:=['А'..'я'];
glas:=['у','е','ы','о','э','я','и','ю','а'];
sogl:=['к','й','н','г','ш','щ','з','х','ф','в','п','р','л','д','ж','ч','с','м','т','б'];
zsogl:=['б','в','г','ж','з','д','й','л','м','н','р'];
masslov(tmas,n);
writeln('Результат');
if proverka(tmas,n)=true then del(tmas,n)
                         else
                         for i:=1 to n do
                                       begin
                                       if kolglas(tmas[i])=3 then doub(tmas[i]);
                                       end;
sort(tmas,n);
for i:=1 to n do writeln(tmas[i]);
readln;
end.      
Поделиться:

Похожие статьи: