Правила форума
Прочтите прежде чем задавать вопрос!
type
razd=set of char;
sogl=set of char;
var
sl,str:string;
m,kl,i,j,kol,n,k:integer;
prf,a,prl,text:boolean;
t2:array[1..10] of string;
const
raz:razd=[' ', '!' , '?' , '.' , ',' , '_'];
s:sogl=['b','c','d','f','h','j','g','k','l','m','n','p','q','r','s','t','w','x','z'];
function suds(sl:string): boolean;
var
ch:integer;
begin
suds:=false;
for ch:=1 to (length(sl)-2) do
begin
suds:=false;
if ((ch=1) and (sl[1]in s) and (sl[1]=sl[2]) and (sl[1]<>sl[3])) then
suds:=true
ELSE if ((ch<>1) and (sl[ch]in s) and (sl[ch]=sl[ch+1]) and (sl[ch]<>sl[ch+2])and(sl[j]<>sl[ch-1])) then
suds:=true;
end;
end;
begin
writeln('IIPOra');
writeln('tolko 10');
writeln('vedite text');
kol:=0;
text:=false;
repeat
readln(str);
sl:='';
n:=0;
k:=0;
prf:=false;
prl:=false;
if (str[1]<>'$') then
begin
text:=true;
for j:=1 to length(str) do
begin
if ((prf=false) and (prl=false) and (j=1) and (not(str[j] in raz))) then
begin
prf:=true;
n:=j;
end;
if ((prf=false) and (prl=false) and (j<>1) and (not(str[j] in raz) and (str[j-1] in raz))) then
begin
prf:=true;
n:=j;
end;
if (((prf=true) and (prl=false) and (j=length(str)) and (not(str[j] in raz)))) then
begin
prl:=true;
k:=j;
end;
if (((prf=true) and (prl=false) and (j<>length(str)) and (not(str[j] in raz)and(str[j+1] in raz)))) then
begin
prl:=true;
k:=j;
end;
end;
if (n<k) then
begin
for j:=n to k do
sl:=sl+str[j];
if suds(sl) and (kol<=10) then
begin
kol:=kol+1;
t2[kol]:=sl;
end;
end;
end;
until (str[1]='$');
if text=false then
writeln('текст пуст');
if (kol=0) and (text=true) then
writeln('слова отсутствуют');
if (text=true) and (kol<>0) then
begin
writeln('слова с удв согл: ');
for kl:=1 to kol do
writeln(t2[kl]);
end;
readln;
end.
такой вопрос, в цикле вывода результата
if (text=true) and (kol<>0) then
begin
writeln('слова с удв согл: ');
for kl:=1 to kol do
writeln(t2[kl]);
end;
выводит слова даже не удовл условию..
хотя из функции
function suds(sl:string): boolean;
var
ch:integer;
begin
suds:=false;
for ch:=1 to (length(sl)-2) do
begin
suds:=false;
if ((ch=1) and (sl[1]in s) and (sl[1]=sl[2]) and (sl[1]<>sl[3])) then
suds:=true
ELSE if ((ch<>1) and (sl[ch]in s) and (sl[ch]=sl[ch+1]) and (sl[ch]<>sl[ch+2])and(sl[j]<>sl[ch-1])) then
suds:=true;
end;
end;
видно что все верно..
функция возвращает значение ТРУ,если:
-если при переборе сивол слова первый,и первый символ - согласная,1ый и 2ой одинаковы, 1ый и 2ой не одинковы с 3ьим..
-если не первый символ слоа, он согласная,предыдущий символ равен ему,следующий равен текущему,и через один символ не раавен текующему..
зы: ввод текст заканчивается вводом $ первым висмоло строки
.