Задача по проверке слов в предложении., Проблема в выделении слова из текста. Опции

[kost85]

Здравсвуйте.
Есть такая задача.
Вводится строка. Требуется в ней перебрать все слова и проверить их на что-то. Другими словами вычленить слова из строки.
Сначала забивал все слова из строчки в (array [1..n] of string) - все было отлично. Теперь препод хочет что бы я забивал каждое слово в другую строку и проверял ее. Вот не пойму, как сразу в цикле перебора строки получать слово , записывать его в перем. типа string , затем проверять(ну это все под контр-ем), а затем сбрасывать и снова записывать очередное слово...
Может кто сталкивался.
Заранее огромное спасибо.

[Алена]

Ты бы вот тут посмотрел: Разбиение на слова. Все способы. (особенно завершающий способ)

[T i m e]

Какая разница? Всё точно также делается, только очередное слово в тексте записывается не в массив, а в какую то переменную. После этого проверяем слово "на что-то"... И всё. Далее при повторе цикла, в нашу перемнную запишется другое полученное из текста слово и т.д. Просто мы сразу будем делать непосредственно проверку при получение каждого слова, а не работать после с массивом.

[kost85]

  
 i:=1;
 m:=length(s);

   for j:=1 to m do
     if s[j]<>' '  then begin
       word[i]:=s[j];
       inc(i);
     end;
     word[0]:=chr(i-1);
     writeln(word);
      if not ispalindrome(word) then
        if not iseven(word) then
          writeln('false')
        else
          writeln('true');

в результате если исх строка состоит из 2 слов - то он в word записывает эти два слова - и соответственно проверка не идет....

[Артемий]

Вот тебе цикл разбиения и записи в переменную...Надеюсь ты это имел ввиду!

var
a: array [1..10] of string;
s,s1,locs: string;
i,o,p,kj: Integer;
ch: Char;
begin
writeln('Vvedite predlogenie: ');
readln(s);
kj:=0;
p:=1;
s1:=s;
for i:=1 to 10 do begin
  ch := s[i];
  if (ch in [' ',';','/','\',':','-','=',',','.','!','?','(',')']) or (i = 10) then
   begin
    if i = 10 then
    a[p] := Copy(s1,kj+1,i-kj)
    else
    a[p] := Copy(s1,kj+1,i-kj-1);
    kj := i;
    p:=p+1;
 end;
end;
for i:=1 to 10 do begin
 locs:=a[i];
 {Сдесь производи нужные действия и проверки над locs}
end;
readln

Добавлено через 1 мин.
(может способ немного "насилованный" )

[kost85]

var S,word:string;
    i,j: integer;
begin
  clrscr;
  write('Sentence>> : ');
  readln(S);
  i := 1;
  for j := 1 to length(S) do begin
    if S[j]<>' ' then begin
      word[i]:=s[j];
      i:=i+1;
      word[0]:=chr(i-1);
   end;
      if not isPalindrome(word) then
        writeln('Asimmetrical word is  ', word, ' - ', IsEven(word))
      else
        writeln('''',word,'''',' - is a palindrome');

To Time:
Не пойму в какой кусок цикла проверку делать. Вот в этом коде он в word пишет столько слов, сколько было в предложении...

[T i m e]

Вот примерно так это должно выглядить (один из вариантов):

Код

var S,word:string;
    i,j: integer;
begin
clrscr;
write('Sentence>> : ');
readln(S);
repeat
  repeat
   if s[1] = ' ' then delete(s,1,1);
  until s[1] <> ' ';
if s <> '' then
    if pos(' ',s) > 0 then word := copy(s,1,pos(' ',s)-1)
     else word := s;
{вот мы получили наше слово и далее здесь же можем делать
  с ним чё хочешь, любые условия ставить и т.д}  
  {При повторение цикла на этом этапе мы будем получать очередное слово в предложение}
until S = '';
end;

Ну, если у тебя предложение со знаками припинания, то этот факт тоже учитывать надо будет...

[Артемий]

Теперь препод хочет что бы я забивал каждое слово в другую строку и проверял ее. Вот не пойму, как сразу в цикле перебора строки получать слово , записывать его в перем. типа string , затем проверять(ну это все под контр-ем), а затем сбрасывать и снова записывать очередное слово...

Давай посмотрим что у тебя..
Ты используешь алгоритм repeat .. until. Теперь посмотри, что у тебя получилось:

var S,word:string;
    i,j: integer;
begin
clrscr;
write('Sentence>> : ');
readln(S);
repeat
  repeat
   if s[1] = ' ' then delete(s,1,1);{<<---Зачем? Ведь ты не чистил строку!}
  until s[1] <> ' ';
if s <> '' then 
    if pos(' ',s) > 0 then word := copy(s,1,pos(' ',s)-1)    {<<---Допустим..Но получается бесконечный цикл, ведь строка не отчищается!Он берет ближайший пробел!}
     else word := s; {<<---И тут тоже..Досюда в твоем и не дойдет..}                                                      
{вот мы получили наше слово и далее здесь же можем делать 
  с ним чё хочешь, любые условия ставить и т.д}  
  {При повторение цикла на этом этапе мы будем получать очередное слово в предложение} {<<---Да ну?}
until S = ''; {<<----И когда она по-твоему становится пустой?}
end;

Раз взялся драть s так и делай:

var S,word:string;
    i,j: integer;
begin
write('Sentence>> : ');
readln(S);
repeat
  repeat
   if s[1] = ' ' then delete(s,1,1);
  until s[1] <> ' ';
if s <> '' then begin
    if pos(' ',s) > 0 then begin
     word := copy(s,1,pos(' ',s)-1);
     delete(s,1,pos(' ',s)-1);
     end;
     if pos(' ',s) = 0 then begin
     word := s; s:='';
     end;
    end;
{вот мы получили наше слово и далее здесь же можем делать
  с ним чё хочешь, любые условия ставить и т.д}
  {При повторение цикла на этом этапе мы будем получать очередное слово в предложение}
until S = '';
readln

[T i m e]

if s[1] = ' ' then delete(s,1,1);{<<---Зачем? Ведь ты не чистил строку!}

Это удаление впереди стоящих пробелов.

if pos(' ',s) > 0 then word := copy(s,1,pos(' ',s)-1) {<<---Допустим..Но получается бесконечный цикл, ведь строка не отчищается!Он берет ближайший пробел!}
else word := s; {<<---И тут тоже..Досюда в твоем и не дойдет..}

Извините, ошибся просто... конечно там ещё в этом месте надо удалять очередное слово: delete(s,1,pos(' ',s))
Просто быстро писал... не заметил...

if s <> '' then begin

Ну тогда и это здесь уже не нужно проверять.
Он никогда ведь не пойдёт в это условие с пустой строкой...

Сообщение отредактировано: T i m e - 1.03.2007 20:15

[Артемий]

Да и зачем лишнии переменные Integer...

[T i m e]

Да и зачем лишнии переменные Integer...

Ладно уж... совсем мою прогу унизил...
Это у меня просто от другой программы наверно скопировалось просто...
Конечно никаких i и j не надо здесь!

[volvo]

Для этого и существует:

7. Проверяйте программы перед тем, как разместить их на форуме!!!

... Здесь Форум, а не Формула 1, чтобы "быстро печатать"... "Поспешишь - людей насмешишь" (С), что и произошло...

[T i m e]

"Поспешишь - людей насмешишь" (С), что и произошло...

Никто никого не смешил вроде... Просто ошибся немного... Чего ж сразу убивать за это? Я ведь просто помочь хочу...