const gluh=['к','п','с','т','ф','х','ц','щ']; {Все глухие}
type wrds=array[1..256] of string; {новый тип- массив словес}
var l:string; {строчечго}
ww:wrds; {словеса}
len,ii:integer; {числеца - len кол-во слов ii счётчик}
procedure fromstringtwords; {строчечго --> словеса}
var i,j:integer; { no comments}
cs:string; {cs- current string - кусок слова}
begin {---}
i:=1; {---}
j:=1; {---}
cs:=''; {}
while l<>'.' do {пока символ l <> '.'}
begin {---}
if l=',' then {если он "," }
begin {---}
ww[j]:=cs; {словесо = сs}
cs:=''; {кусок слова пустой}
inc(j); {следующее словесо }
end else cs:=cs+l; {иначе кусок слова + символ из строчечго}
inc(i);
end;
ww[j]:=cs; {последнее словесо}
len:=j; {кол-во словес}
end;
function ninchet(s:char):boolean; {символ s не содержится в 1 чёт.]
var i,j:integer;
k:boolean;
begin
i:=0;
k:=true; {к = содержится}
while (i<=len) and k do
begin
inc(i,2);
j:=1;
while (j<=length(ww))and(ww[j]<>s) do inc(j);
if j<=length(ww) then {если всё-таки не содержится}
begin
k:=false; {то так и быть}
end;
end;
ninchet:=i>len; {возврат}
end;
function inallnechet(s:char):boolean; {во всех нечет. есть s}
var i,j:integer;
k:boolean;
begin
k:=true; {k= оно во всех}
i:=-1;
while (i<=len) and k do { если не во всех- ПАКА}
begin
inc(i,2);
j:=1;
while (j<=length(ww)) and (ww[j]<>s) do inc(j);
k:=j>length(ww); {k:= во всех ли?}
end;
inallnechet:=i<len;
end;
begin
fillchar(ww,sizeof(ww),0); {забить словеса пустотой}
read(l); {строчечго!}
fromstringtwords;{строчечго --> словеса}
for ii:=40 to 256 do {все символы, в кот. может содержаться глух. (можно упростить)}
if chr(ii) in gluh then {если символ глухой}
begin
if ninchet(chr(ii)) and inallnechet(chr(ii)) then write(chr(ii),' '); { и соотв. условию - вывести}
end;
end. {всё}
Теперь ОК?
