[Pascal] Нужна помощь в решении задачи "Слова-перевертыши"

[artems67]

Добрый день,

Условие:

Слова-перевертыши
Словом назовем набор символов без пробелов.
Текст содержит набор слов, разделенных пробелами (одним или несколькими). Других знаков препинания в тексте нет. Все символы текста строчные буквы английского алфавита. Необходимо найти и вывести слова-перевертыши (читаются одинаково слева-направо и справа-налево) максимальной длины. Если «перевертышей» максимальной длины несколько, то вывести их все в порядке следования в предложении. Повторяющиеся слова выводятся один раз. Если таких слов нет, то вывести сообщение «no».

Входные данные:

В единственной строке входного файла input.txt записаны символы. Строка состоит не более, чем из 250 символов.

Выходные данные:

В файл output.txt нужно вывести слова-перевертыши. Если «перевертышей» максимальной длины несколько, то вывести их все в порядке следования в предложении, разделив пробелом. Повторяющиеся слова выводятся один раз. Если таких слов нет, то вывести сообщение «no».

Примеры:

№ input.txt
1 tot sos aaatrr
2 ttot sto aaatrr
3 tt diк tt tt rrra

№ output.txt
1 tot sos
2 no
3 tt

Уже 2 день сижу над этой задачей. Но ничего путного не выходит. Нужна помощь в поиске рационального и компактного алгоритма. Больше всего трудностей вызывает у меня поиск правильного алгоритма для отсеивания повторяющихся слов в строке, а так же определения max длины слова перевертыша в строке.

Мой код программы:

Program Slova_Pereverteshi;
uses crt;
var s,s1,s2,ss:string;
    i,j:integer;
    f:text;

begin
clrscr;
assign(f,'input.txt');
reset(f);
read(f,s); {Читаю исходные данные из файла input.txt}
close(f);
s:=s+' '; {Добавил в конец исходной строки ' ' для удобства при отборе слов}
assign(f,'output.txt');
rewrite(f); {Подготвоил файл output.txt для записи}
for i:=1 to length(s) do {Начал перебор символов в исходн. строке с 1 позиции}
  begin
   if s[i] <> ' ' then s1:=s1+s[i] {Заношу символы из исходн. строки до символа ' ' }
   {Если длина строки s1 < длины строки перевертыша s2 или строка s1 = строке перевертышу s2...}
   else if ( length(s1) < length(s2) ) or ( s1 = s2 ) then s1:=''  {обнуляю строку s1}
      {Иначе если в выходной строке ss найдена подстрока s1...}
      else if pos(s1,ss) <> 0 then  s1:='' {обнуляю строку s1}
          else 
            begin
              s2:=''; {обнуляю строку s2}
              {Проверяю является ли строка s1 первертышем, записав s1 в строку s2 в обратном порядке}
              for j:=length(s1) downto 1 do s2:=s2+s1[i];
              {Если строка s1 равна s2, то s1 является словом перевертышем}
              if s1 = s2 then ss:=ss+s2+' '; {заношу слово перевертыш в выходную строку};
              s1:=''; {обнуляю строку s1}
           end;   
    end;  
write(f,ss); {Записываю выходную строку в файл output.txt}    
close(f);
readln;
end.

Проблема в том, что раньше мой код хотя бы компилирвоался. Но на выходе выдавал пустой output.txt файл. Сейчас я ещё больше наколбасил с этими условиями и теперь вылетает ошибка компилятора.

test1.pas(22) : Встречено 'else', а ожидался оператор

И да в моем коде есть ещё 1 недостаток. В конце строки ss будет 1 лишний ' '. Лишнего пробела в конце не должно быть.

Жду помощи

[Аватар]

По поводу ошибки поищи, где лишний ; поставил в коде.

[artems67]

Сообщение от Аватар

По поводу ошибки поищи, где лишний ; поставил в коде.

Спасибо. Нашёл лишний ' ; ' после комментария. Теперь код компилируется, но при запуске программы выводит следующее сообщение:



Я так понял ошибка на 27 строке кода ?

27 строка кода:

for j:=length(s1) downto 1 do s2:=s2+s1[i];

Как тут может индекс за пределы выйти ?


Не понимаю. Всё тут просто тупик. Начинаю костыли пихать, всё либо ещё хуже либо пустой файл output.txt получаю.

[Аватар]

А чего ему не выйти? Цикл по j, а индекс с чего-то i

[artems67]

Аватар, да вы правы, исправил эту нелепость.

Теперь все работает хорошо, за исключением того, что если первым набором символов до пробела окажется слово-перевертыш, то оно будет изначально записываться в файл output.txt, так как строка s2 будет являться пустой а значит length(s1) > length(s2). А надо мне сделать так, чтобы, получается, в строке s2 хранился самый длинный набор символов из исходной строки s, причем этот набор символов должен являть собой слово-перевертыш. Все голова опухла, теперь надо думать как это реализовать и пропихнуть в мой ужас под названием код программы.

[Аватар]

Ну сфокусируйся на той строчке, уже и написал что не так. Ошибка того же рода, как и лишняя точка с запятой. Внимательней нужно быть, не думать о девицах в процессе программирования

[artems67]

Its alive ! its alive !

Чуть доработал код, вставив отдельный цикл для нахождения слова перевертыша-макс длины. Переменной х присвоил length макс. слова-перевертыша. Далее в основном цикле просто через условие сравнивал длины символов до пробела с x . Я понимаю, что поиск max length и наверное основной цикл можно оптимизировать, разгрузив его подпрограммами, может попытаюсь сделать это чуть позже. Дам голове остыть.

Если кому интересен ниже мой "франкинштейн", в назидание как не стоит уродовать свой код громоздкими конструкциями циклов и операторов выбора. Уродливый, но рабочий код.

Program Slova_Pereverteshi;
uses crt;
var s,s1,s2,ss:string;
    i,j,x:integer;
    f:text;

begin
clrscr;
assign(f,'input.txt');
reset(f);
read(f,s); {Читаю исходные данные из файла input.txt}
close(f);
s:=s+' '; {Добавил в конец исходной строки ' ' для удобства при отборе слов}
assign(f,'output.txt');
rewrite(f); {Подготвоил файл output.txt для записи}
for i:=1 to length(s) do {Поиск набора символов до ' ', образующих слово-певертыш max длины}
  begin
    if s[i] <> ' ' then s1:=s1+s[i]
    else if length(s1) > length(s2)  then
      begin
        s2:='';
        for j:=length(s1) downto 1 do s2:=s2+s1[j];
        if s1 = s2 then x:=length(s2);
        s1:='';
      end
      else s1:='';  
  end;   
s1:='';  
s2:='';
for i:=1 to length(s) do {Начал перебор символов в исходн. строке с 1 позиции}
  begin
   if s[i] <> ' ' then s1:=s1+s[i] {Заношу символы из исходн. строки до символа ' ' }
   {Если длина строки s1 < длины строки перевертыша s2 или строка s1 = строке перевертышу s2...}
   else if ( length(s1) < x ) or ( s1 = s2 ) then s1:=''  {обнуляю строку s1}
      {Иначе если в выходной строке ss найдена подстрока s1...}
      else if pos(s1,ss) <> 0 then  s1:='' {обнуляю строку s1}
          else 
            begin
              s2:=''; {обнуляю строку s2}
              {Проверяю является ли строка s1 первертышем, записав s1 в строку s2 в обратном порядке}
              for j:=length(s1) downto 1 do s2:=s2+s1[j];
              {Если строка s1 равна s2, то s1 является словом перевертышем}
              if s1 = s2 then ss:=ss+s2+' '; {заношу слово перевертыш в выходную строку};
              s1:=''; {обнуляю строку s1}
           end;   
    end;  
delete(ss,length(ss),1); 
if ss = '' then write(f,'no')  
 else write(f,ss); {Записываю выходную строку в файл output.txt}    
close(f);
readln;
end.

[Aleksandr H.]

Сообщение от artems67

Дам голове остыть.

На досуге посмотри еще такой вариант

var
   finp,fout:text;
   sl: array [1..170] of string;
   i,j,k:integer;
   dubl:boolean;
   palCount:byte;
   s:string;
   s1:string;
   sPal:string;
BEGIN
  assign(finp,'input.txt');reset(finp);
  readln(finp,s);
  close(finp);
  i:=1;
  s:=s+' ';
  while (i<=length(s)) do
   begin
     if s[i]=' ' then
        begin
             if(s1 = sPal) then {palindrom}
                   begin
                    {bolshoi palindrom, ochistit spisok}
                     if length(s1)>length(sl[1]) then
                      begin
                        sl[1]:=s1;
                        palCount:=1;
                      end
                     else if length(s1)=length(sl[1]) then
                     {takoi ze dlinny}
                      begin
                       dubl:=false; {est li uze takoe slovo v spiske}
                       for k:=1 to palCount do if sl[k]=s1 then dubl:=true;
                       {slovo "original"}
                       if not dubl then
                       begin
                        inc(palCount);
                        sl[palCount]:=s1;
                        end;
                      end;
                   end;
             s1:='';sPal:='';
             inc(i);
        end;
     s1:=s1+s[i];
     sPal:=s[i]+sPal;
     inc(i);
   end;
   assign(fout,'output.txt');rewrite(fout);
   if palCount = 0 then writeln(fout,'NO')
   else
    for i:=1 to palCount do
        write(fout,sl[i],' ');
  close(fout);
END.

[artems67]

Aleksandr H.,

Ошибка при запуске вашего кода: Индекс находился вне границ массива
строка 45

[Aleksandr H.]

Может быть. А на каких входных?