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

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

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

> Найти палиндромы
sqrt
сообщение 12.01.2005 7:44
Сообщение #1





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

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


Есть такая задача:
Имеется большой словарь русских слов. Найти в нём слова-палиндромы и фразы палиндромы ("перевёртыши"), одинаково читающиеся как слева направо, так и справа налево, например, АННА, ШАЛАШ, "А роза упала на лапу азора".
Помогите, плиз, её решить.

P.S. прошу прощения у модераторов: я случайно не туда запостил тему. Переместите, пжлст, в задачи...

Сообщение отредактировано: sqrt - 12.01.2005 7:47
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
 
 Ответить  Открыть новую тему 
Ответов(1 - 1)
xds
сообщение 12.01.2005 8:45
Сообщение #2


N337
****

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

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


Код
program Palind;

{ Перевод символа в кодировке "Codepage 866" (DOS) в верхний регистр }
function UpCase866(c: Char): Char;
begin
 case c of
 #0..#127:
   c := UpCase(c);
 #160..#175:
   Dec(c, 32);
 #224..#239:
   Dec(c, 80);
 'ё':
   c := 'Ё';
 end;
 UpCase866 := c;
end;

{ Проверка, является ли слово палиндромом }
function IsPalindrome(const Word: String): Boolean;
var
 i: Integer;
begin
 for i := 1 to Length(Word) div 2 do
   if Word[i] <> Word[Length(Word) - i + 1] then
     begin
       IsPalindrome := False;
       Exit;
     end;
 IsPalindrome := True;
end;

var
 f: Text;
 s, sn: String;
 i: Integer;

begin
 Assign(f, 'dict.txt');
 Reset(f);
 while not Eof(f) do
   begin
     Readln(f, s);
     sn := '';
     for i := 1 to Length(s) do
       if (s[i] <> ' ') and (s[i] <> #9) then
         sn := sn + UpCase866(s[i]);
     if IsPalindrome(sn) then
       Writeln(s);
   end;
 Close(f);
end.


--------------------
The idiots are winning.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

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

 



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