Версия для печати темы

Автор: krasnblj 31.05.2008 3:21

код

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

зы: ввод текст заканчивается вводом $ первым висмоло строки

Автор: Lapp 31.05.2008 4:45

В этой фразе, боюсь, ты пропустил приставку "не" к слову "верно" .
Что у тебя там за j появляется вдруг?

Автор: krasnblj 31.05.2008 16:31

ы,хорошо,исправил..
но все равно функция не вычилсяет правильно..
чтобы сравнивать символы:
i-ый символ слова = i+1 символ слова
не нужно никаких операторов? только 'слово[j]=слово[j+1]' ??

Автор: volvo 31.05.2008 16:35

Ты, прежде чем что-то делать, задачу-то формализуй... Что именно ты ищешь, напиши нормальным человеческим языком, а не намеками... А потом уже будешь
1) писать программы
2) находить в них ошибки

Автор: krasnblj 1.06.2008 1:04

дано:
текст={строка}от 1 до строка[1]='$'
где строка={символ[i]} от i:=1 до длина(строка)

требуется:
текст={слово_с_удвоенными_согласными[kl]}от kl=1 до 10(или менее)

зы: а где тут намеки-то?? 0_о

Автор: krasnblj 1.06.2008 4:22

закройте тему..