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

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

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

> задача на текст, посик слов с удвоенной согласной..
krasnblj
сообщение 30.05.2008 23:21
Сообщение #1


Новичок
*

Группа: Пользователи
Сообщений: 20
Пол: Мужской

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


код

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ьим..
-если не первый символ слоа, он согласная,предыдущий символ равен ему,следующий равен текущему,и через один символ не раавен текующему..

зы: ввод текст заканчивается вводом $ первым висмоло строки
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

Сообщений в этой теме


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

 

- Текстовая версия 27.07.2025 12:58
Хостинг предоставлен компанией "Веб Сервис Центр" при поддержке компании "ДокЛаб"