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

Нажмите сюда для просмотра этой темы в обычном формате

Форум «Всё о Паскале» _ Задачи _ помогите с задачей

Автор: Mapa 8.06.2006 1:59

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

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

Код

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 слово сделать максимальным а потом в цикле сравнивать с остольными, но практически не соображу)
ПОМОГИТЕ

Автор: Unknown 8.06.2006 2:49

Вот доделанная программа:

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 8.06.2006 3:20

А что, обязательно добавлять лишний цикл:

  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 4:38

Оптимизированный вариант:

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 21:40

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


  ...                
  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;
  ...

Автор: Гость 8.06.2006 22:21

Большое спасибо