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

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

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

> помогите с задачей
Mapa
сообщение 7.06.2006 21:59
Сообщение #1





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

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


задача такова
найти самое длинное симметричное слово

есть код где находятся все симметричные слова в тексте

Код

uses crt;
var
   b,a,k,max: string;
   i,j,q: longint;
   c: array[1..30] of string;
begin
  clrscr;   {othisaem displei}
  write('vvedite tekst razdelennii probelami: ');
  readln(a); {thtenie vvedennogo teksta}
  b:='';  {inichializachiya peremennih}
  j:=1;
  k:='';
    for i:=1 to length(a) do
       if (a[i]=' ') then
                  begin  {isem probeli v tekstah}
            c[j]:=b; {esli est ' ', to }
                      inc(j);  { zapominaem slovo }
             b:='';
                  end
       else b:=b+a[i]; c[j]:=b;
          for i:=1 to j do
             begin {proveryaem, yavlyaetcya li slovo palindromom}
                     b:=c[i];
                     k:='';
                 for q:=1 to length(b) do
                  k:=b[q]+k;
                  if b=k then
                    begin
                 writeln(b);  {sravnenie i vivod rezyltata}
                    end;
             end;
            write('nazmite lybyu klavisy...'); readln;
end.

вопрос
как найти среди них самое длинное, (теоретически понятно взять 1 слово сделать максимальным а потом в цикле сравнивать с остольными, но практически не соображу)
ПОМОГИТЕ
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
 
 Ответить  Открыть новую тему 
Ответов(1 - 5)
Unknown
сообщение 7.06.2006 22:49
Сообщение #2


Пионер
**

Группа: Пользователи
Сообщений: 104
Пол: Мужской
Реальное имя: Евгений

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


Вот доделанная программа:
uses crt;
var
   b,a,k,max: string;
   i,j,q,n: longint;
   c: array[1..30] of string;
begin
  clrscr;   {othisaem displei}
  write('vvedite tekst razdelennii probelami: ');
  readln(a); {thtenie vvedennogo teksta}
  b:='';  {inichializachiya peremennih}
  j:=1;
  n:=1;
  k:='';
    for i:=1 to length(a) do
       if (a[i]=' ') then
                  begin  {isem probeli v tekstah}
            c[j]:=b; {esli est ' ', to }
                      inc(j);  { zapominaem slovo }
             b:='';
                  end
       else b:=b+a[i]; c[j]:=b;
          for i:=1 to j do
             begin {proveryaem, yavlyaetcya li slovo palindromom}
                     b:=c[i];
                     k:='';
                 for q:=1 to length(b) do
                  k:=b[q]+k;
                  if b=k then
                    begin
                 c[n]:=b;     {теперь в массиве с (от 1 до n-1) содержатся все полиндромы или как их там...}
                 inc(n);
                 writeln(b);  {sravnenie i vivod rezyltata}
                    end;
             end;
  max:=b;
  for i:=1 to n-1 do
      if length(c[i])>length(max) then max:=c[i];
  writeln;
  writeln('Наибольшую длину среди полиндромов имеет слово: ',max);
  writeln;
  write('nazmite lybyu klavisy...'); readln;
end.


Добавил одну переменную и конец изменил, хотя, на мой взгляд, ее стоит всю слегка упростить (многовато переменных используется...).

Сообщение отредактировано: volvo - 3.11.2006 20:28


--------------------
go ask Alice
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
volvo
сообщение 7.06.2006 23:20
Сообщение #3


Гость






А что, обязательно добавлять лишний цикл:
  for i:=1 to n-1 do
      if length(c[i])>length(max) then max:=c[i];

?

Как только нашли палиндром, нельзя СРАЗУ проверить его на макс. длину? После строки
c[n]:=b;

, например?

excl.gif P.S. В следующий раз тема с таким названием будет закрыта немедленно...
 К началу страницы 
+ Ответить 
volvo
сообщение 8.06.2006 0:38
Сообщение #4


Гость






Оптимизированный вариант:
uses crt;
var
   s, _word, max: string;
   i, j: integer;
   palindrom: boolean;
begin
  clrscr;   {othisaem displei}
  write('vvedite tekst razdelennii probelami: ');
  readln(s); {thtenie vvedennogo teksta}

  _word := '';  {inichializachiya peremennih}
  max := '';
  s := s + ' ';
  for i := 1 to length(s) do
    if s[i] = ' ' then begin { isem probeli v tekstah }

      palindrom := true;
      for j := 1 to length(_word) div 2 do
        palindrom := palindrom and (_word[j] = _word[length(_word) - j + 1]);

      if palindrom and (length(max) < length(_word)) then max := _word;

      _word := '';
    end
    else _word := _word + s[i];

  writeln('max palindrom = ', max);
  writeln;
  write('nazmite lybyu klavisy...'); readln;
end.
 К началу страницы 
+ Ответить 
Unknown
сообщение 8.06.2006 17:40
Сообщение #5


Пионер
**

Группа: Пользователи
Сообщений: 104
Пол: Мужской
Реальное имя: Евгений

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


угу, исправил:


  ...                
  for q:=1 to length(b) do
       k:=b[q]+k;
       if b=k then
                 begin
                 c[n]:=b;     {теперь в массиве с (от 1 до n-1) содержатся все полиндромы или как их там...}
                 if length(c[n])>length(max) then max:=c[n];
                 inc(n);
                 writeln(b);  {sravnenie i vivod rezyltata}
                 end;
  ...


Сообщение отредактировано: volvo - 3.11.2006 20:29


--------------------
go ask Alice
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
Гость
сообщение 8.06.2006 18:21
Сообщение #6


Гость






Большое спасибо
 К началу страницы 
+ Ответить 

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

 

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